diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/.gdbinit | 20 | ||||
-rw-r--r-- | src/.lldbinit | 33 | ||||
-rw-r--r-- | src/Makefile.in | 129 | ||||
-rw-r--r-- | src/alloc.c | 860 | ||||
-rw-r--r-- | src/atimer.c | 82 | ||||
-rw-r--r-- | src/bidi.c | 90 | ||||
-rw-r--r-- | src/bignum.c | 102 | ||||
-rw-r--r-- | src/bignum.h | 1 | ||||
-rw-r--r-- | src/buffer.c | 194 | ||||
-rw-r--r-- | src/bytecode.c | 657 | ||||
-rw-r--r-- | src/callint.c | 49 | ||||
-rw-r--r-- | src/callproc.c | 54 | ||||
-rw-r--r-- | src/casefiddle.c | 57 | ||||
-rw-r--r-- | src/ccl.c | 6 | ||||
-rw-r--r-- | src/character.c | 81 | ||||
-rw-r--r-- | src/character.h | 5 | ||||
-rw-r--r-- | src/charset.c | 4 | ||||
-rw-r--r-- | src/coding.c | 65 | ||||
-rw-r--r-- | src/comp.c | 469 | ||||
-rw-r--r-- | src/comp.h | 4 | ||||
-rw-r--r-- | src/composite.c | 92 | ||||
-rw-r--r-- | src/conf_post.h | 54 | ||||
-rw-r--r-- | src/cygw32.c | 8 | ||||
-rw-r--r-- | src/data.c | 368 | ||||
-rw-r--r-- | src/dbusbind.c | 41 | ||||
-rw-r--r-- | src/decompress.c | 12 | ||||
-rw-r--r-- | src/deps.mk | 2 | ||||
-rw-r--r-- | src/dired.c | 71 | ||||
-rw-r--r-- | src/dispextern.h | 102 | ||||
-rw-r--r-- | src/dispnew.c | 133 | ||||
-rw-r--r-- | src/doc.c | 81 | ||||
-rw-r--r-- | src/dynlib.c | 16 | ||||
-rw-r--r-- | src/dynlib.h | 2 | ||||
-rw-r--r-- | src/editfns.c | 24 | ||||
-rw-r--r-- | src/emacs-module.c | 14 | ||||
-rw-r--r-- | src/emacs-module.h.in | 13 | ||||
-rw-r--r-- | src/emacs.c | 441 | ||||
-rw-r--r-- | src/emacsgtkfixed.c | 143 | ||||
-rw-r--r-- | src/emacsgtkfixed.h | 9 | ||||
-rw-r--r-- | src/eval.c | 1085 | ||||
-rw-r--r-- | src/fileio.c | 143 | ||||
-rw-r--r-- | src/filelock.c | 88 | ||||
-rw-r--r-- | src/floatfns.c | 37 | ||||
-rw-r--r-- | src/fns.c | 1229 | ||||
-rw-r--r-- | src/font.c | 124 | ||||
-rw-r--r-- | src/font.h | 9 | ||||
-rw-r--r-- | src/frame.c | 277 | ||||
-rw-r--r-- | src/frame.h | 59 | ||||
-rw-r--r-- | src/fringe.c | 27 | ||||
-rw-r--r-- | src/ftcrfont.c | 126 | ||||
-rw-r--r-- | src/ftfont.c | 57 | ||||
-rw-r--r-- | src/ftfont.h | 7 | ||||
-rw-r--r-- | src/gnutls.c | 38 | ||||
-rw-r--r-- | src/gnutls.h | 1 | ||||
-rw-r--r-- | src/gtkutil.c | 1616 | ||||
-rw-r--r-- | src/gtkutil.h | 38 | ||||
-rw-r--r-- | src/haiku.c | 286 | ||||
-rw-r--r-- | src/haiku_draw_support.cc | 536 | ||||
-rw-r--r-- | src/haiku_font_support.cc | 941 | ||||
-rw-r--r-- | src/haiku_io.c | 213 | ||||
-rw-r--r-- | src/haiku_select.cc | 519 | ||||
-rw-r--r-- | src/haiku_support.cc | 5422 | ||||
-rw-r--r-- | src/haiku_support.h | 741 | ||||
-rw-r--r-- | src/haikufns.c | 3220 | ||||
-rw-r--r-- | src/haikufont.c | 1357 | ||||
-rw-r--r-- | src/haikugui.h | 203 | ||||
-rw-r--r-- | src/haikuimage.c | 116 | ||||
-rw-r--r-- | src/haikumenu.c | 843 | ||||
-rw-r--r-- | src/haikuselect.c | 1149 | ||||
-rw-r--r-- | src/haikuselect.h | 79 | ||||
-rw-r--r-- | src/haikuterm.c | 4672 | ||||
-rw-r--r-- | src/haikuterm.h | 362 | ||||
-rw-r--r-- | src/image.c | 1931 | ||||
-rw-r--r-- | src/indent.c | 74 | ||||
-rw-r--r-- | src/inotify.c | 2 | ||||
-rw-r--r-- | src/insdel.c | 6 | ||||
-rw-r--r-- | src/intervals.c | 27 | ||||
-rw-r--r-- | src/intervals.h | 2 | ||||
-rw-r--r-- | src/json.c | 18 | ||||
-rw-r--r-- | src/keyboard.c | 973 | ||||
-rw-r--r-- | src/keyboard.h | 22 | ||||
-rw-r--r-- | src/keymap.c | 295 | ||||
-rw-r--r-- | src/kqueue.c | 4 | ||||
-rw-r--r-- | src/lisp.h | 759 | ||||
-rw-r--r-- | src/lread.c | 2464 | ||||
-rw-r--r-- | src/macfont.m | 72 | ||||
-rw-r--r-- | src/macros.c | 14 | ||||
-rw-r--r-- | src/menu.c | 61 | ||||
-rw-r--r-- | src/menu.h | 6 | ||||
-rw-r--r-- | src/minibuf.c | 293 | ||||
-rw-r--r-- | src/module-env-29.h | 3 | ||||
-rw-r--r-- | src/msdos.c | 5 | ||||
-rw-r--r-- | src/nsfns.m | 950 | ||||
-rw-r--r-- | src/nsfont.m | 1221 | ||||
-rw-r--r-- | src/nsgui.h | 3 | ||||
-rw-r--r-- | src/nsimage.m | 4 | ||||
-rw-r--r-- | src/nsmenu.m | 521 | ||||
-rw-r--r-- | src/nsselect.m | 321 | ||||
-rw-r--r-- | src/nsterm.h | 210 | ||||
-rw-r--r-- | src/nsterm.m | 2548 | ||||
-rw-r--r-- | src/nsxwidget.m | 3 | ||||
-rw-r--r-- | src/pdumper.c | 61 | ||||
-rw-r--r-- | src/pdumper.h | 5 | ||||
-rw-r--r-- | src/pgtkfns.c | 3941 | ||||
-rw-r--r-- | src/pgtkgui.h | 119 | ||||
-rw-r--r-- | src/pgtkim.c | 313 | ||||
-rw-r--r-- | src/pgtkmenu.c | 1126 | ||||
-rw-r--r-- | src/pgtkselect.c | 1960 | ||||
-rw-r--r-- | src/pgtkterm.c | 7303 | ||||
-rw-r--r-- | src/pgtkterm.h | 648 | ||||
-rw-r--r-- | src/print.c | 1220 | ||||
-rw-r--r-- | src/process.c | 397 | ||||
-rw-r--r-- | src/profiler.c | 4 | ||||
-rw-r--r-- | src/regex-emacs.c | 53 | ||||
-rw-r--r-- | src/search.c | 149 | ||||
-rw-r--r-- | src/sheap.h | 2 | ||||
-rw-r--r-- | src/sort.c | 974 | ||||
-rw-r--r-- | src/sound.c | 34 | ||||
-rw-r--r-- | src/sqlite.c | 784 | ||||
-rw-r--r-- | src/syntax.c | 16 | ||||
-rw-r--r-- | src/syntax.h | 4 | ||||
-rw-r--r-- | src/sysdep.c | 401 | ||||
-rw-r--r-- | src/syssignal.h | 2 | ||||
-rw-r--r-- | src/sysstdio.h | 7 | ||||
-rw-r--r-- | src/systhread.h | 2 | ||||
-rw-r--r-- | src/systime.h | 8 | ||||
-rw-r--r-- | src/term.c | 38 | ||||
-rw-r--r-- | src/termhooks.h | 120 | ||||
-rw-r--r-- | src/terminal.c | 10 | ||||
-rw-r--r-- | src/textprop.c | 41 | ||||
-rw-r--r-- | src/thread.c | 39 | ||||
-rw-r--r-- | src/thread.h | 23 | ||||
-rw-r--r-- | src/timefns.c | 231 | ||||
-rw-r--r-- | src/tparam.h | 7 | ||||
-rw-r--r-- | src/undo.c | 4 | ||||
-rw-r--r-- | src/verbose.mk.in | 51 | ||||
-rw-r--r-- | src/w16select.c | 2 | ||||
-rw-r--r-- | src/w32.c | 287 | ||||
-rw-r--r-- | src/w32.h | 9 | ||||
-rw-r--r-- | src/w32console.c | 12 | ||||
-rw-r--r-- | src/w32fns.c | 340 | ||||
-rw-r--r-- | src/w32font.c | 61 | ||||
-rw-r--r-- | src/w32image.c | 5 | ||||
-rw-r--r-- | src/w32inevt.c | 14 | ||||
-rw-r--r-- | src/w32menu.c | 21 | ||||
-rw-r--r-- | src/w32notify.c | 30 | ||||
-rw-r--r-- | src/w32proc.c | 38 | ||||
-rw-r--r-- | src/w32select.c | 2 | ||||
-rw-r--r-- | src/w32term.c | 420 | ||||
-rw-r--r-- | src/w32term.h | 23 | ||||
-rw-r--r-- | src/w32xfns.c | 78 | ||||
-rw-r--r-- | src/widget.c | 71 | ||||
-rw-r--r-- | src/widget.h | 2 | ||||
-rw-r--r-- | src/window.c | 324 | ||||
-rw-r--r-- | src/window.h | 16 | ||||
-rw-r--r-- | src/xdisp.c | 1710 | ||||
-rw-r--r-- | src/xfaces.c | 471 | ||||
-rw-r--r-- | src/xfns.c | 2460 | ||||
-rw-r--r-- | src/xfont.c | 28 | ||||
-rw-r--r-- | src/xftfont.c | 190 | ||||
-rw-r--r-- | src/xgselect.c | 91 | ||||
-rw-r--r-- | src/xgselect.h | 7 | ||||
-rw-r--r-- | src/xmenu.c | 495 | ||||
-rw-r--r-- | src/xrdb.c | 65 | ||||
-rw-r--r-- | src/xselect.c | 791 | ||||
-rw-r--r-- | src/xsettings.c | 256 | ||||
-rw-r--r-- | src/xsettings.h | 19 | ||||
-rw-r--r-- | src/xsmfns.c | 2 | ||||
-rw-r--r-- | src/xterm.c | 16954 | ||||
-rw-r--r-- | src/xterm.h | 556 | ||||
-rw-r--r-- | src/xwidget.c | 3314 | ||||
-rw-r--r-- | src/xwidget.h | 70 |
172 files changed, 81427 insertions, 10924 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/.lldbinit b/src/.lldbinit new file mode 100644 index 00000000000..358cea5f8b6 --- /dev/null +++ b/src/.lldbinit @@ -0,0 +1,33 @@ +# -*- mode: shell-script -*- +# 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, 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/>. +# +# Use 'lldb --local-init' or add to your ~/.lldbinit the line +# +# settings set target.load-cwd-lldbinit true +# +# Emacs-specific commands start with 'x'. Type 'help' to see all +# commands. Type 'help <command>' to see help for a command +# <command>. + +# Make Python find our files +script -- sys.path.append('../etc') + +# Load our Python files +command script import emacs_lldb + +# end. 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..f115a3cebaa 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 @@ -489,7 +475,7 @@ enum mem_type static bool deadp (Lisp_Object x) { - return EQ (x, dead_object ()); + return BASE_EQ (x, dead_object ()); } #ifdef GC_MALLOC_CHECK @@ -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; @@ -1047,9 +1032,12 @@ lisp_free (void *block) return; MALLOC_BLOCK_INPUT; +#ifndef GC_MALLOC_CHECK + struct mem_node *m = mem_find (block); +#endif free (block); #ifndef GC_MALLOC_CHECK - mem_delete (mem_find (block)); + mem_delete (m); #endif MALLOC_UNBLOCK_INPUT; } @@ -1330,16 +1318,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 +1345,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 +1359,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 +1374,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 +1841,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 +1856,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 +1956,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 +2472,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 +2502,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 +3527,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 +3613,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 +3682,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 +3879,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 +3917,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 +4913,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 +4985,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 +4998,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 +5140,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 +5241,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 +5667,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 +5732,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 +6088,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 +6097,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 +6105,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); @@ -6133,18 +6180,34 @@ garbage_collect (void) mark_pinned_objects (); mark_pinned_symbols (); + mark_lread (); 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 + +#ifdef HAVE_NS + mark_nsterm (); +#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 +6238,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 +6268,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); } @@ -6242,7 +6307,7 @@ where each entry has the form (NAME SIZE USED FREE), where: to return them to the OS). However, if there was overflow in pure space, and Emacs was dumped -using the 'unexec' method, `garbage-collect' returns nil, because +using the \"unexec\" method, `garbage-collect' returns nil, because real GC can't be done. Note that calling this function does not guarantee that absolutely all @@ -6256,7 +6321,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 +6413,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 +6473,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 +6485,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 +6637,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 +6799,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->intspec.native); + 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 +7020,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 +7072,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 +7472,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 @@ -7334,10 +7487,41 @@ arenas. */) } #endif +#ifdef HAVE_MALLOC_TRIM +DEFUN ("malloc-trim", Fmalloc_trim, Smalloc_trim, 0, 1, "", + doc: /* Release free heap memory to the OS. +This function asks libc to return unused heap memory back to the operating +system. This function isn't guaranteed to do anything, and is mainly +meant as a debugging tool. + +If LEAVE_PADDING is given, ask the system to leave that much unused +space in the heap of the Emacs process. This should be an integer, and if +not given, it defaults to 0. + +This function returns nil if no memory could be returned to the +system, and non-nil if some memory could be returned. */) + (Lisp_Object leave_padding) +{ + int pad = 0; + + if (! NILP (leave_padding)) + { + CHECK_FIXNAT (leave_padding); + pad = XFIXNUM (leave_padding); + } + + /* 1 means that memory was released to the system. */ + if (malloc_trim (pad) == 1) + return Qt; + else + return Qnil; +} +#endif + 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 +7540,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,9 +7864,14 @@ 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 +#ifdef HAVE_MALLOC_TRIM + defsubr (&Smalloc_trim); +#endif defsubr (&Ssuspicious_object); Lisp_Object watcher; @@ -7690,14 +7879,14 @@ N should be nonnegative. */); static union Aligned_Lisp_Subr Swatch_gc_cons_threshold = {{{ PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) }, { .a4 = watch_gc_cons_threshold }, - 4, 4, "watch_gc_cons_threshold", {0}, 0}}; + 4, 4, "watch_gc_cons_threshold", {0}, lisp_h_Qnil}}; XSETSUBR (watcher, &Swatch_gc_cons_threshold.s); Fadd_variable_watcher (Qgc_cons_threshold, watcher); static union Aligned_Lisp_Subr Swatch_gc_cons_percentage = {{{ PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) }, { .a4 = watch_gc_cons_percentage }, - 4, 4, "watch_gc_cons_percentage", {0}, 0}}; + 4, 4, "watch_gc_cons_percentage", {0}, lisp_h_Qnil}}; XSETSUBR (watcher, &Swatch_gc_cons_percentage.s); Fadd_variable_watcher (Qgc_cons_percentage, watcher); } @@ -7708,6 +7897,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 +7922,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..18301120ffe 100644 --- a/src/atimer.c +++ b/src/atimer.c @@ -18,6 +18,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <config.h> +#ifdef WINDOWSNT +#define raise(s) w32_raise(s) +#endif + #include "lisp.h" #include "keyboard.h" #include "syssignal.h" @@ -297,45 +301,59 @@ set_alarm (void) { if (atimers) { -#ifdef HAVE_SETITIMER - struct itimerval it; -#endif - struct timespec now, interval; - #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 - /* Determine interval till the next timer is ripe. - Don't set the interval to 0; this disables the timer. */ - now = current_timespec (); - interval = (timespec_cmp (atimers->expiration, now) <= 0 - ? make_timespec (0, 1000 * 1000) - : timespec_sub (atimers->expiration, now)); + /* Determine interval till the next timer is ripe. */ + struct timespec now = current_timespec (); + if (timespec_cmp (atimers->expiration, now) <= 0) + { + /* Timer is (over)due -- just trigger the signal right way. */ + raise (SIGALRM); + } + else + { + struct timespec interval = timespec_sub (atimers->expiration, now); #ifdef HAVE_SETITIMER - - 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 */ + struct itimerval it = {.it_value = make_timeval (interval)}; + setitimer (ITIMER_REAL, &it, 0); +#else + alarm (max (interval.tv_sec, 1)); +#endif + } } } @@ -583,15 +601,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..c4d04136e9e 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -1277,6 +1277,12 @@ bidi_fetch_char (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t *disp_pos, SET_TEXT_POS (pos, charpos, bytepos); *disp_pos = compute_display_string_pos (&pos, string, w, frame_window_p, disp_prop); + /* The factor of 100 below is a heuristic that needs to be + tuned. It means we consider 100 buffer positions examined by + the above call roughly equivalent to the display engine + iterating over a single buffer position. */ + if (max_redisplay_ticks > 0 && *disp_pos > charpos) + update_redisplay_ticks ((*disp_pos - charpos) / 100 + 1, w); } /* Fetch the character at BYTEPOS. */ @@ -1385,6 +1391,8 @@ bidi_fetch_char (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t *disp_pos, SET_TEXT_POS (pos, charpos + *nchars, bytepos + *ch_len); *disp_pos = compute_display_string_pos (&pos, string, w, frame_window_p, disp_prop); + if (max_redisplay_ticks > 0 && *disp_pos > charpos + *nchars) + update_redisplay_ticks ((*disp_pos - charpos - *nchars) / 100 + 1, w); } return ch; @@ -1462,7 +1470,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 +1560,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 @@ -1583,6 +1591,9 @@ bidi_find_paragraph_start (ptrdiff_t pos, ptrdiff_t pos_byte) return pos_byte; } +/* This tracks how far we needed to search for first strong character. */ +static ptrdiff_t nsearch_for_strong; + /* On a 3.4 GHz machine, searching forward for a strong directional character in a long paragraph full of weaks or neutrals takes about 1 ms for each 20K characters. The number below limits each call to @@ -1652,6 +1663,8 @@ find_first_strong_char (ptrdiff_t pos, ptrdiff_t bytepos, ptrdiff_t end, pos += *nchars; bytepos += *ch_len; } + + nsearch_for_strong += pos - pos1; return type; } @@ -1681,6 +1694,9 @@ bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it, bool no_default_p) calls to BYTE_TO_CHAR and its ilk. */ ptrdiff_t begbyte = string_p ? 0 : BEGV_BYTE; ptrdiff_t end = string_p ? bidi_it->string.schars : ZV; + ptrdiff_t pos = bidi_it->charpos; + + nsearch_for_strong = 0; /* Special case for an empty buffer. */ if (bytepos == begbyte && bidi_it->charpos == end) @@ -1702,7 +1718,7 @@ bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it, bool no_default_p) else if (dir == NEUTRAL_DIR) /* P2 */ { ptrdiff_t ch_len, nchars; - ptrdiff_t pos, disp_pos = -1; + ptrdiff_t disp_pos = -1; int disp_prop = 0; bidi_type_t type; const unsigned char *s; @@ -1800,6 +1816,14 @@ bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it, bool no_default_p) bidi_it->level_stack[0].level = 0; bidi_line_init (bidi_it); + + /* The factor of 50 below is a heuristic that needs to be tuned. It + means we consider 50 buffer positions examined by this function + roughly equivalent to the display engine iterating over a single + buffer position. */ + ptrdiff_t nexamined = bidi_it->charpos - pos + nsearch_for_strong; + if (max_redisplay_ticks > 0 && nexamined > 0) + update_redisplay_ticks (nexamined / 50, bidi_it->w); } @@ -2566,6 +2590,7 @@ bidi_find_bracket_pairs (struct bidi_it *bidi_it) bidi_bracket_type_t btype; bidi_type_t type = bidi_it->type; bool retval = false; + ptrdiff_t n = 0; /* When scanning backwards, we don't expect any unresolved bidi bracket characters. */ @@ -2695,6 +2720,7 @@ bidi_find_bracket_pairs (struct bidi_it *bidi_it) } old_sidx = bidi_it->stack_idx; type = bidi_resolve_weak (bidi_it); + n++; /* Skip level runs excluded from this isolating run sequence. */ new_sidx = bidi_it->stack_idx; if (bidi_it->level_stack[new_sidx].level > current_level @@ -2718,6 +2744,7 @@ bidi_find_bracket_pairs (struct bidi_it *bidi_it) goto give_up; } type = bidi_resolve_weak (bidi_it); + n++; } } if (type == NEUTRAL_B @@ -2794,6 +2821,12 @@ bidi_find_bracket_pairs (struct bidi_it *bidi_it) } give_up: + /* The factor of 20 below is a heuristic that needs to be tuned. It + means we consider 20 buffer positions examined by this function + roughly equivalent to the display engine iterating over a single + buffer position. */ + if (max_redisplay_ticks > 0 && n > 0) + update_redisplay_ticks (n / 20 + 1, bidi_it->w); return retval; } @@ -2927,8 +2960,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: @@ -3360,6 +3396,7 @@ bidi_find_other_level_edge (struct bidi_it *bidi_it, int level, bool end_flag) else { int new_level; + ptrdiff_t pos0 = bidi_it->charpos; /* If we are at end of level, its edges must be cached. */ if (end_flag) @@ -3395,6 +3432,12 @@ bidi_find_other_level_edge (struct bidi_it *bidi_it, int level, bool end_flag) bidi_cache_iterator_state (bidi_it, 1, 1); } } while (new_level >= level); + /* The factor of 50 below is a heuristic that needs to be + tuned. It means we consider 50 buffer positions examined by + the above call roughly equivalent to the display engine + iterating over a single buffer position. */ + if (max_redisplay_ticks > 0 && bidi_it->charpos > pos0) + update_redisplay_ticks ((bidi_it->charpos - pos0) / 50 + 1, bidi_it->w); } } @@ -3566,11 +3609,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 +3631,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..e5fa09a9789 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -911,7 +911,12 @@ does not run the hooks `kill-buffer-hook', set_buffer_internal_1 (b); Fset (intern ("buffer-save-without-query"), Qnil); Fset (intern ("buffer-file-number"), Qnil); - Fset (intern ("buffer-stale-function"), Qnil); + if (!NILP (Flocal_variable_p (Qbuffer_stale_function, base_buffer))) + Fkill_local_variable (Qbuffer_stale_function); + /* 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); } @@ -1061,7 +1066,7 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too) eassert (XSYMBOL (sym)->u.s.redirect == SYMBOL_LOCALIZED); /* Need not do anything if some other buffer's binding is now cached. */ - if (EQ (SYMBOL_BLV (XSYMBOL (sym))->where, buffer)) + if (BASE_EQ (SYMBOL_BLV (XSYMBOL (sym))->where, buffer)) { /* Symbol is set up for this buffer's old local value: swap it out! */ @@ -1155,11 +1160,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))) @@ -1216,7 +1219,7 @@ is the default binding of the variable. */) { register Lisp_Object result = buffer_local_value (variable, buffer); - if (EQ (result, Qunbound)) + if (BASE_EQ (result, Qunbound)) xsignal1 (Qvoid_variable, variable); return result; @@ -1247,7 +1250,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) @@ -1311,7 +1314,7 @@ buffer_lisp_local_variables (struct buffer *buf, bool clone) if (buf != current_buffer) val = XCDR (elt); - result = Fcons (!clone && EQ (val, Qunbound) + result = Fcons (!clone && BASE_EQ (val, Qunbound) ? XCAR (elt) : Fcons (XCAR (elt), val), result); @@ -1334,7 +1337,7 @@ buffer_local_variables_1 (struct buffer *buf, int offset, Lisp_Object sym) { sym = NILP (sym) ? PER_BUFFER_SYMBOL (offset) : sym; Lisp_Object val = per_buffer_value (buf, offset); - return EQ (val, Qunbound) ? sym : Fcons (sym, val); + return BASE_EQ (val, Qunbound) ? sym : Fcons (sym, val); } return Qnil; } @@ -1374,12 +1377,23 @@ No argument or nil as argument means use current buffer as BUFFER. */) DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p, 0, 1, 0, - doc: /* Return t if BUFFER was modified since its file was last read or saved. -No argument or nil as argument means use current buffer as BUFFER. */) + doc: /* Return non-nil if BUFFER was modified since its file was last read or saved. +No argument or nil as argument means use current buffer as BUFFER. + +If BUFFER was autosaved since it was last modified, this function +returns the symbol `autosaved'. */) (Lisp_Object buffer) { struct buffer *buf = decode_buffer (buffer); - return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil; + if (BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf)) + { + if (BUF_AUTOSAVE_MODIFF (buf) == BUF_MODIFF (buf)) + return Qautosaved; + else + return Qt; + } + else + return Qnil; } DEFUN ("force-mode-line-update", Fforce_mode_line_update, @@ -1434,6 +1448,11 @@ and `buffer-file-truename' are non-nil. */) DEFUN ("restore-buffer-modified-p", Frestore_buffer_modified_p, Srestore_buffer_modified_p, 1, 1, 0, doc: /* Like `set-buffer-modified-p', but doesn't redisplay buffer's mode line. +A nil FLAG means to mark the buffer as unmodified. A non-nil FLAG +means mark the buffer as modified. A special value of `autosaved' +will mark the buffer as modified and also as autosaved since it was +last modified. + This function also locks or unlocks the file visited by the buffer, if both `buffer-file-truename' and `buffer-file-name' are non-nil. @@ -1473,16 +1492,19 @@ state of the current buffer. Use with care. */) recent-auto-save-p from t to nil. Vice versa, if FLAG is non-nil and SAVE_MODIFF>=auto_save_modified we risk changing recent-auto-save-p from nil to t. */ - SAVE_MODIFF = (NILP (flag) - /* FIXME: This unavoidably sets recent-auto-save-p to nil. */ - ? MODIFF - /* Let's try to preserve recent-auto-save-p. */ - : SAVE_MODIFF < MODIFF ? SAVE_MODIFF - /* If SAVE_MODIFF == auto_save_modified == MODIFF, - we can either decrease SAVE_MODIFF and auto_save_modified - or increase MODIFF. */ - : modiff_incr (&MODIFF)); - + if (NILP (flag)) + /* This unavoidably sets recent-auto-save-p to nil. */ + SAVE_MODIFF = MODIFF; + else + { + /* If SAVE_MODIFF == auto_save_modified == MODIFF, we can either + decrease SAVE_MODIFF and auto_save_modified or increase + MODIFF. */ + if (SAVE_MODIFF >= MODIFF) + SAVE_MODIFF = modiff_incr (&MODIFF); + if (EQ (flag, Qautosaved)) + BUF_AUTOSAVE_MODIFF (b) = MODIFF; + } return flag; } @@ -1497,6 +1519,18 @@ use current buffer as BUFFER. */) return modiff_to_integer (BUF_MODIFF (decode_buffer (buffer))); } +DEFUN ("internal--set-buffer-modified-tick", + Finternal__set_buffer_modified_tick, Sinternal__set_buffer_modified_tick, + 1, 2, 0, + doc: /* Set BUFFER's tick counter to TICK. +No argument or nil as argument means use current buffer as BUFFER. */) + (Lisp_Object tick, Lisp_Object buffer) +{ + CHECK_FIXNUM (tick); + BUF_MODIFF (decode_buffer (buffer)) = XFIXNUM (tick); + return Qnil; +} + DEFUN ("buffer-chars-modified-tick", Fbuffer_chars_modified_tick, Sbuffer_chars_modified_tick, 0, 1, 0, doc: /* Return BUFFER's character-change tick counter. @@ -1552,7 +1586,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 +1596,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); } @@ -1571,7 +1608,7 @@ This does not change the name of the visited file (if any). */) static bool candidate_buffer (Lisp_Object b, Lisp_Object buffer) { - return (BUFFERP (b) && !EQ (b, buffer) + return (BUFFERP (b) && !BASE_EQ (b, buffer) && BUFFER_LIVE_P (XBUFFER (b)) && !BUFFER_HIDDEN_P (XBUFFER (b))); } @@ -1629,16 +1666,7 @@ exists, return the buffer `*scratch*' (creating it if necessary). */) if (!NILP (notsogood)) return notsogood; else - { - AUTO_STRING (scratch, "*scratch*"); - buf = Fget_buffer (scratch); - if (NILP (buf)) - { - buf = Fget_buffer_create (scratch, Qnil); - Fset_buffer_major_mode (buf); - } - return buf; - } + return safe_call (1, Qget_scratch_buffer_create); } /* The following function is a safe variant of Fother_buffer: It doesn't @@ -1654,15 +1682,7 @@ other_buffer_safely (Lisp_Object buffer) if (candidate_buffer (buf, buffer)) return buf; - AUTO_STRING (scratch, "*scratch*"); - buf = Fget_buffer (scratch); - if (NILP (buf)) - { - buf = Fget_buffer_create (scratch, Qnil); - Fset_buffer_major_mode (buf); - } - - return buf; + return safe_call (1, Qget_scratch_buffer_create); } DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo, @@ -1767,7 +1787,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 (); @@ -1790,10 +1810,12 @@ cleaning up all windows currently displaying the buffer to be killed. */) /* Query if the buffer is still modified. */ if (INTERACTIVE && modified) { - AUTO_STRING (format, "Buffer %s modified; kill anyway? "); - tem = do_yes_or_no_p (CALLN (Fformat, format, BVAR (b, name))); - if (NILP (tem)) + /* Ask whether to kill the buffer, and exit if the user says + "no". */ + if (NILP (call1 (Qkill_buffer__possibly_save, buffer))) return unbind_to (count, Qnil); + /* Recheck modified. */ + modified = BUF_MODIFF (b) > BUF_SAVE_MODIFF (b); } /* Delete the autosave file, if requested. */ @@ -1832,7 +1854,7 @@ cleaning up all windows currently displaying the buffer to be killed. */) since anything can happen within do_yes_or_no_p. */ /* Don't kill the minibuffer now current. */ - if (EQ (buffer, XWINDOW (minibuf_window)->contents)) + if (BASE_EQ (buffer, XWINDOW (minibuf_window)->contents)) return Qnil; /* When we kill an ordinary buffer which shares its buffer text @@ -1876,7 +1898,7 @@ cleaning up all windows currently displaying the buffer to be killed. */) is the sole other buffer give up. */ XSETBUFFER (tem, current_buffer); if (EQ (tem, XWINDOW (minibuf_window)->contents) - && EQ (buffer, Fother_buffer (buffer, Qnil, Qnil))) + && BASE_EQ (buffer, Fother_buffer (buffer, Qnil, Qnil))) return Qnil; /* Now there is no question: we can kill the buffer. */ @@ -2090,7 +2112,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 +2134,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. */ @@ -2483,23 +2504,23 @@ results, see Info node `(elisp)Swapping Text'. */) { ws = Fcons (w, ws); if (MARKERP (XWINDOW (w)->pointm) - && (EQ (XWINDOW (w)->contents, buf1) - || EQ (XWINDOW (w)->contents, buf2))) + && (BASE_EQ (XWINDOW (w)->contents, buf1) + || BASE_EQ (XWINDOW (w)->contents, buf2))) Fset_marker (XWINDOW (w)->pointm, make_fixnum (BUF_BEGV (XBUFFER (XWINDOW (w)->contents))), XWINDOW (w)->contents); /* Blindly copied from pointm part. */ if (MARKERP (XWINDOW (w)->old_pointm) - && (EQ (XWINDOW (w)->contents, buf1) - || EQ (XWINDOW (w)->contents, buf2))) + && (BASE_EQ (XWINDOW (w)->contents, buf1) + || BASE_EQ (XWINDOW (w)->contents, buf2))) Fset_marker (XWINDOW (w)->old_pointm, make_fixnum (BUF_BEGV (XBUFFER (XWINDOW (w)->contents))), XWINDOW (w)->contents); if (MARKERP (XWINDOW (w)->start) - && (EQ (XWINDOW (w)->contents, buf1) - || EQ (XWINDOW (w)->contents, buf2))) + && (BASE_EQ (XWINDOW (w)->contents, buf1) + || BASE_EQ (XWINDOW (w)->contents, buf2))) Fset_marker (XWINDOW (w)->start, make_fixnum (XBUFFER (XWINDOW (w)->contents)->last_window_start), @@ -2509,10 +2530,11 @@ results, see Info node `(elisp)Swapping Text'. */) } if (current_buffer->text->intervals) - (eassert (EQ (current_buffer->text->intervals->up.obj, buffer)), + (eassert (BASE_EQ (current_buffer->text->intervals->up.obj, buffer)), XSETBUFFER (current_buffer->text->intervals->up.obj, current_buffer)); if (other_buffer->text->intervals) - (eassert (EQ (other_buffer->text->intervals->up.obj, Fcurrent_buffer ())), + (eassert (BASE_EQ (other_buffer->text->intervals->up.obj, + Fcurrent_buffer ())), XSETBUFFER (other_buffer->text->intervals->up.obj, other_buffer)); return Qnil; @@ -2805,7 +2827,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 +2838,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. */ @@ -3920,9 +3944,9 @@ for the rear of the overlay advance when text is inserted there else CHECK_BUFFER (buffer); - if (MARKERP (beg) && !EQ (Fmarker_buffer (beg), buffer)) + if (MARKERP (beg) && !BASE_EQ (Fmarker_buffer (beg), buffer)) signal_error ("Marker points into wrong buffer", beg); - if (MARKERP (end) && !EQ (Fmarker_buffer (end), buffer)) + if (MARKERP (end) && !BASE_EQ (Fmarker_buffer (end), buffer)) signal_error ("Marker points into wrong buffer", end); CHECK_FIXNUM_COERCE_MARKER (beg); @@ -4026,7 +4050,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; @@ -4040,9 +4064,9 @@ buffer. */) if (NILP (Fbuffer_live_p (buffer))) error ("Attempt to move overlay to a dead buffer"); - if (MARKERP (beg) && !EQ (Fmarker_buffer (beg), buffer)) + if (MARKERP (beg) && !BASE_EQ (Fmarker_buffer (beg), buffer)) signal_error ("Marker points into wrong buffer", beg); - if (MARKERP (end) && !EQ (Fmarker_buffer (end), buffer)) + if (MARKERP (end) && !BASE_EQ (Fmarker_buffer (end), buffer)) signal_error ("Marker points into wrong buffer", end); CHECK_FIXNUM_COERCE_MARKER (beg); @@ -4087,7 +4111,7 @@ buffer. */) n_end = marker_position (OVERLAY_END (overlay)); /* If the overlay has changed buffers, do a thorough redisplay. */ - if (!EQ (buffer, obuffer)) + if (!BASE_EQ (buffer, obuffer)) { /* Redisplay where the overlay was. */ if (ob) @@ -4147,7 +4171,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); @@ -5546,6 +5570,7 @@ syms_of_buffer (void) DEFSYM (Qbefore_change_functions, "before-change-functions"); DEFSYM (Qafter_change_functions, "after-change-functions"); DEFSYM (Qkill_buffer_query_functions, "kill-buffer-query-functions"); + DEFSYM (Qget_scratch_buffer_create, "get-scratch-buffer-create"); DEFSYM (Qvertical_scroll_bar, "vertical-scroll-bar"); Fput (Qvertical_scroll_bar, Qchoice, list4 (Qnil, Qt, Qleft, Qright)); @@ -5564,6 +5589,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, @@ -5575,8 +5602,11 @@ the mode line appears at the bottom. */); &BVAR (current_buffer, header_line_format), Qnil, doc: /* Analogous to `mode-line-format', but controls the header line. -The header line appears, optionally, at the top of a window; -the mode line appears at the bottom. */); +The header line appears, optionally, at the top of a window; the mode +line appears at the bottom. + +Also see `header-line-indent-mode' if `display-line-number-mode' is +used. */); DEFVAR_PER_BUFFER ("mode-line-format", &BVAR (current_buffer, mode_line_format), Qnil, @@ -6387,6 +6417,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); @@ -6403,6 +6440,7 @@ This is the default. If nil, auto-save file deletion is inhibited. */); defsubr (&Sforce_mode_line_update); defsubr (&Sset_buffer_modified_p); defsubr (&Sbuffer_modified_tick); + defsubr (&Sinternal__set_buffer_modified_tick); defsubr (&Sbuffer_chars_modified_tick); defsubr (&Srename_buffer); defsubr (&Sother_buffer); @@ -6437,5 +6475,11 @@ This is the default. If nil, auto-save file deletion is inhibited. */); defsubr (&Soverlay_put); defsubr (&Srestore_buffer_modified_p); + DEFSYM (Qautosaved, "autosaved"); + + DEFSYM (Qkill_buffer__possibly_save, "kill-buffer--possibly-save"); + + DEFSYM (Qbuffer_stale_function, "buffer-stale-function"); + Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt); } diff --git a/src/bytecode.c b/src/bytecode.c index 472992be180..d75767bb0c5 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) @@ -174,8 +176,8 @@ DEFINE (Bmin, 0136) \ DEFINE (Bmult, 0137) \ \ DEFINE (Bpoint, 0140) \ -/* Was Bmark in v17. */ \ -DEFINE (Bsave_current_buffer, 0141) /* Obsolete. */ \ +/* 0141 was Bmark in v17, Bsave_current_buffer in 18-19. */ \ +DEFINE (Bsave_current_buffer_OBSOLETE, 0141) /* Obsolete since 20. */ \ DEFINE (Bgoto_char, 0142) \ DEFINE (Binsert, 0143) \ DEFINE (Bpoint_max, 0144) \ @@ -185,13 +187,15 @@ 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) \ DEFINE (Bbobp, 0157) \ DEFINE (Bcurrent_buffer, 0160) \ DEFINE (Bset_buffer, 0161) \ -DEFINE (Bsave_current_buffer_1, 0162) /* Replacing Bsave_current_buffer. */ \ +DEFINE (Bsave_current_buffer, 0162) \ +/* 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, Qnil, 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 }; @@ -493,7 +627,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object v1 = vectorp[op], v2; if (!SYMBOLP (v1) || XSYMBOL (v1)->u.s.redirect != SYMBOL_PLAINVAL - || (v2 = SYMBOL_VAL (XSYMBOL (v1)), EQ (v2, Qunbound))) + || (v2 = SYMBOL_VAL (XSYMBOL (v1)), BASE_EQ (v2, Qunbound))) v2 = Fsymbol_value (v1); PUSH (v2); NEXT; @@ -560,7 +694,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, /* Inline the most common case. */ if (SYMBOLP (sym) - && !EQ (val, Qunbound) + && !BASE_EQ (val, Qunbound) && XSYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL && !SYMBOL_TRAPPED_WRITE_P (sym)) SET_SYMBOL_VAL (XSYMBOL (sym), val); @@ -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); @@ -742,14 +924,14 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, record_unwind_protect_excursion (); NEXT; - CASE (Bsave_current_buffer): /* Obsolete since ??. */ - CASE (Bsave_current_buffer_1): + CASE (Bsave_current_buffer_OBSOLETE): /* Obsolete since 20. */ + CASE (Bsave_current_buffer): record_unwind_current_buffer (); NEXT; 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. */ @@ -1395,6 +1678,12 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, /* TODO: Perhaps introduce another byte-code for switch when the number of cases is less, which uses a simple vector for linear search as the jump table. */ + + /* TODO: Instead of pushing the table in a separate + Bconstant op, use an immediate argument (maybe separate + switch opcodes for 1-byte and 2-byte constant indices). + This would also get rid of some hacks that assume each + Bswitch to be preceded by a Bconstant. */ Lisp_Object jmp_table = POP; if (BYTE_CODE_SAFE && !HASH_TABLE_P (jmp_table)) emacs_abort (); @@ -1437,16 +1726,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 +1750,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..ffa3b231eb5 100644 --- a/src/callint.c +++ b/src/callint.c @@ -170,7 +170,7 @@ check_mark (bool for_region) of VALUES to do its job. */ static void -fix_command (Lisp_Object input, Lisp_Object values) +fix_command (Lisp_Object input, Lisp_Object function, Lisp_Object values) { /* FIXME: Instead of this ugly hack, we should provide a way for an interactive spec to return an expression/function that will re-build the @@ -230,6 +230,37 @@ fix_command (Lisp_Object input, Lisp_Object values) } } } + + /* If the list contains a bunch of trailing nil values, and they are + optional, remove them from the list. This makes navigating the + history less confusing, since it doesn't contain a lot of + parameters that aren't used. */ + if (CONSP (values)) + { + Lisp_Object arity = Ffunc_arity (function); + /* We don't want to do this simplification if we have an &rest + function, because (cl-defun foo (a &optional (b 'zot)) ..) + etc. */ + if (FIXNUMP (XCAR (arity)) && FIXNUMP (XCDR (arity))) + { + Lisp_Object final = Qnil; + ptrdiff_t final_i = 0, i = 0; + for (Lisp_Object tail = values; + CONSP (tail); + tail = XCDR (tail), ++i) + { + if (!NILP (XCAR (tail))) + { + final = tail; + final_i = i; + } + } + + /* Chop the trailing optional values. */ + if (final_i > 0 && final_i >= XFIXNUM (XCAR (arity)) - 1) + XSETCDR (final, Qnil); + } + } } /* Helper function to call `read-file-name' from C. */ @@ -251,7 +282,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 +310,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; @@ -315,7 +346,7 @@ invoke it (via an `interactive' spec that contains, for instance, an Lisp_Object up_event = Qnil; /* Set SPECS to the interactive form, or barf if not interactive. */ - Lisp_Object form = Finteractive_form (function); + Lisp_Object form = call1 (Qinteractive_form, function); if (! CONSP (form)) wrong_type_argument (Qcommandp, function); Lisp_Object specs = Fcar (XCDR (form)); @@ -340,7 +371,7 @@ invoke it (via an `interactive' spec that contains, for instance, an Make a copy of the list of values, for the command history, and turn them into things we can eval. */ Lisp_Object values = quotify_args (Fcopy_sequence (specs)); - fix_command (input, values); + fix_command (input, function, values); call4 (intern ("add-to-history"), intern ("command-history"), Fcons (function, values), Qnil, Qt); } @@ -408,7 +439,7 @@ invoke it (via an `interactive' spec that contains, for instance, an && (w = XCAR (w), WINDOWP (w))) { if (MINI_WINDOW_P (XWINDOW (w)) - && ! (minibuf_level > 0 && EQ (w, minibuf_window))) + && ! (minibuf_level > 0 && BASE_EQ (w, minibuf_window))) error ("Attempt to select inactive minibuffer window"); /* If the current buffer wants to clean up, let it. */ @@ -478,7 +509,7 @@ invoke it (via an `interactive' spec that contains, for instance, an case 'b': /* Name of existing buffer. */ args[i] = Fcurrent_buffer (); - if (EQ (selected_window, minibuf_window)) + if (BASE_EQ (selected_window, minibuf_window)) args[i] = Fother_buffer (args[i], Qnil, Qnil); args[i] = Fread_buffer (callint_message, args[i], Qt, Qnil); break; @@ -541,7 +572,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 +602,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..1a4f73500a3 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -33,6 +33,12 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "charset.h" #include "ccl.h" #include "coding.h" +#include "keyboard.h" + +/* Avoid GCC 12 bug <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=105784>. */ +#if GNUC_PREREQ (12, 0, 0) +# pragma GCC diagnostic ignored "-Wanalyzer-use-of-uninitialized-value" +#endif /* 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..968daccafa7 100644 --- a/src/character.c +++ b/src/character.c @@ -654,48 +654,38 @@ 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; } -/* Convert unibyte text at STR of BYTES bytes to a multibyte text - that contains the same single-byte characters. It actually - converts all 8-bit characters to multibyte forms. It is assured - that we can use LEN bytes at STR as a work area and that is - enough. */ - +/* Convert unibyte text at SRC of NCHARS chars to a multibyte text + at DST, that contains the same single-byte characters. + Return the number of bytes written at DST. */ ptrdiff_t -str_to_multibyte (unsigned char *str, ptrdiff_t len, ptrdiff_t bytes) +str_to_multibyte (unsigned char *dst, const unsigned char *src, + ptrdiff_t nchars) { - unsigned char *p = str, *endp = str + bytes; - unsigned char *to; - - while (p < endp && *p < 0x80) p++; - if (p == endp) - return bytes; - to = p; - bytes = endp - p; - endp = str + len; - memmove (endp - bytes, p, bytes); - p = endp - bytes; - while (p < endp) + unsigned char *d = dst; + for (ptrdiff_t i = 0; i < nchars; i++) { - int c = *p++; - - if (c >= 0x80) - c = BYTE8_TO_CHAR (c); - to += CHAR_STRING (c, to); + unsigned char c = src[i]; + if (c <= 0x7f) + *d++ = c; + else + { + *d++ = 0xc0 + ((c >> 6) & 1); + *d++ = 0x80 + (c & 0x3f); + } } - return (to - str); + return d - dst; } /* Arrange multibyte text at STR of LEN bytes as a unibyte text. It @@ -735,31 +725,6 @@ str_as_unibyte (unsigned char *str, ptrdiff_t bytes) return (to - str); } -/* Convert eight-bit chars in SRC (in multibyte form) to the - corresponding byte and store in DST. CHARS is the number of - characters in SRC. The value is the number of bytes stored in DST. - Usually, the value is the same as CHARS, but is less than it if SRC - contains a non-ASCII, non-eight-bit character. */ - -ptrdiff_t -str_to_unibyte (const unsigned char *src, unsigned char *dst, ptrdiff_t chars) -{ - ptrdiff_t i; - - for (i = 0; i < chars; i++) - { - int c = string_char_advance (&src); - - if (CHAR_BYTE8_P (c)) - c = CHAR_TO_BYTE8 (c); - else if (! ASCII_CHAR_P (c)) - return i; - *dst++ = c; - } - return i; -} - - static ptrdiff_t string_count_byte8 (Lisp_Object string) { diff --git a/src/character.h b/src/character.h index 6ee6bcab205..6d0f035c2bb 100644 --- a/src/character.h +++ b/src/character.h @@ -567,10 +567,9 @@ extern int translate_char (Lisp_Object, int c); extern ptrdiff_t count_size_as_multibyte (const unsigned char *, ptrdiff_t); extern ptrdiff_t str_as_multibyte (unsigned char *, ptrdiff_t, ptrdiff_t, ptrdiff_t *); -extern ptrdiff_t str_to_multibyte (unsigned char *, ptrdiff_t, ptrdiff_t); +extern ptrdiff_t str_to_multibyte (unsigned char *dst, const unsigned char *src, + ptrdiff_t nchars); extern ptrdiff_t str_as_unibyte (unsigned char *, ptrdiff_t); -extern ptrdiff_t str_to_unibyte (const unsigned char *, unsigned char *, - ptrdiff_t); extern ptrdiff_t strwidth (const char *, ptrdiff_t); extern ptrdiff_t c_string_width (const unsigned char *, ptrdiff_t, int, ptrdiff_t *, ptrdiff_t *); 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..3fb4f148b1c 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); @@ -6534,7 +6528,7 @@ detect_coding (struct coding_system *coding) if (EQ (CODING_ATTR_TYPE (CODING_ID_ATTRS (coding->id)), Qundecided)) { int c, i; - struct coding_detection_info detect_info; + struct coding_detection_info detect_info = {0}; bool null_byte_found = 0, eight_bit_found = 0; bool inhibit_nbd = inhibit_flag (coding->spec.undecided.inhibit_nbd, inhibit_null_byte_detection); @@ -6543,7 +6537,6 @@ detect_coding (struct coding_system *coding) bool prefer_utf_8 = coding->spec.undecided.prefer_utf_8; coding->head_ascii = 0; - detect_info.checked = detect_info.found = detect_info.rejected = 0; for (src = coding->source; src < src_end; src++) { c = *src; @@ -6718,12 +6711,8 @@ detect_coding (struct coding_system *coding) else if (XFIXNUM (CODING_ATTR_CATEGORY (CODING_ID_ATTRS (coding->id))) == coding_category_utf_8_auto) { - Lisp_Object coding_systems; - struct coding_detection_info detect_info; - - coding_systems + Lisp_Object coding_systems = AREF (CODING_ID_ATTRS (coding->id), coding_attr_utf_bom); - detect_info.found = detect_info.rejected = 0; if (check_ascii (coding) == coding->src_bytes) { if (CONSP (coding_systems)) @@ -6731,6 +6720,7 @@ detect_coding (struct coding_system *coding) } else { + struct coding_detection_info detect_info = {0}; if (CONSP (coding_systems) && detect_coding_utf_8 (coding, &detect_info)) { @@ -6744,20 +6734,19 @@ detect_coding (struct coding_system *coding) else if (XFIXNUM (CODING_ATTR_CATEGORY (CODING_ID_ATTRS (coding->id))) == coding_category_utf_16_auto) { - Lisp_Object coding_systems; - struct coding_detection_info detect_info; - - coding_systems + Lisp_Object coding_systems = AREF (CODING_ID_ATTRS (coding->id), coding_attr_utf_bom); - detect_info.found = detect_info.rejected = 0; coding->head_ascii = 0; - if (CONSP (coding_systems) - && detect_coding_utf_16 (coding, &detect_info)) + if (CONSP (coding_systems)) { - if (detect_info.found & CATEGORY_MASK_UTF_16_LE) - found = XCAR (coding_systems); - else if (detect_info.found & CATEGORY_MASK_UTF_16_BE) - found = XCDR (coding_systems); + struct coding_detection_info detect_info = {0}; + if (detect_coding_utf_16 (coding, &detect_info)) + { + if (detect_info.found & CATEGORY_MASK_UTF_16_LE) + found = XCAR (coding_systems); + else if (detect_info.found & CATEGORY_MASK_UTF_16_BE) + found = XCDR (coding_systems); + } } } @@ -7907,7 +7896,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 +8060,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 +8159,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 ())); @@ -8205,7 +8194,7 @@ decode_coding_object (struct coding_system *coding, if (saved_pt >= 0) { /* This is the case of: - (BUFFERP (src_object) && EQ (src_object, dst_object)) + (BUFFERP (src_object) && BASE_EQ (src_object, dst_object)) As we have moved PT while replacing the original buffer contents, we must recover it now. */ set_buffer_internal (XBUFFER (src_object)); @@ -8290,7 +8279,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; @@ -8309,7 +8298,7 @@ encode_coding_object (struct coding_system *coding, attrs = CODING_ID_ATTRS (coding->id); bool same_buffer = false; - if (EQ (src_object, dst_object) && BUFFERP (src_object)) + if (BASE_EQ (src_object, dst_object) && BUFFERP (src_object)) { struct Lisp_Marker *tail; @@ -8390,7 +8379,7 @@ encode_coding_object (struct coding_system *coding, if (BUFFERP (dst_object)) { coding->dst_object = dst_object; - if (EQ (src_object, dst_object)) + if (BASE_EQ (src_object, dst_object)) { coding->dst_pos = from; coding->dst_pos_byte = from_byte; @@ -8445,7 +8434,7 @@ encode_coding_object (struct coding_system *coding, if (saved_pt >= 0) { /* This is the case of: - (BUFFERP (src_object) && EQ (src_object, dst_object)) + (BUFFERP (src_object) && BASE_EQ (src_object, dst_object)) As we have moved PT while replacing the original buffer contents, we must recover it now. */ set_buffer_internal (XBUFFER (src_object)); @@ -8584,7 +8573,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); @@ -8645,7 +8634,7 @@ detect_coding_system (const unsigned char *src, Lisp_Object val = Qnil; struct coding_system coding; ptrdiff_t id; - struct coding_detection_info detect_info; + struct coding_detection_info detect_info = {0}; enum coding_category base_category; bool null_byte_found = 0, eight_bit_found = 0; @@ -8664,8 +8653,6 @@ detect_coding_system (const unsigned char *src, coding.mode |= CODING_MODE_LAST_BLOCK; coding.head_ascii = 0; - detect_info.checked = detect_info.found = detect_info.rejected = 0; - /* At first, detect text-format if necessary. */ base_category = XFIXNUM (CODING_ATTR_CATEGORY (attrs)); if (base_category == coding_category_undecided) @@ -9429,7 +9416,7 @@ code_convert_region (Lisp_Object start, Lisp_Object end, setup_coding_system (coding_system, &coding); coding.mode |= CODING_MODE_LAST_BLOCK; - if (BUFFERP (dst_object) && !EQ (dst_object, src_object)) + if (BUFFERP (dst_object) && !BASE_EQ (dst_object, src_object)) { struct buffer *buf = XBUFFER (dst_object); ptrdiff_t buf_pt = BUF_PT (buf); @@ -10798,7 +10785,7 @@ usage: (find-operation-coding-system OPERATION ARGUMENTS...) */) && ((STRINGP (target) && STRINGP (XCAR (elt)) && fast_string_match (XCAR (elt), target) >= 0) - || (FIXNUMP (target) && EQ (target, XCAR (elt))))) + || (FIXNUMP (target) && BASE_EQ (target, XCAR (elt))))) { val = XCDR (elt); /* Here, if VAL is both a valid coding system and a valid @@ -11512,7 +11499,7 @@ DEFUN ("coding-system-put", Fcoding_system_put, Scoding_system_put, } ASET (attrs, coding_attr_plist, - Fplist_put (CODING_ATTR_PLIST (attrs), prop, val)); + plist_put (CODING_ATTR_PLIST (attrs), prop, val)); return val; } diff --git a/src/comp.c b/src/comp.c index dc0359acdae..81d27299fa4 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, @@ -738,12 +756,12 @@ comp_hash_source_file (Lisp_Object filename) DEFUN ("comp--subr-signature", Fcomp__subr_signature, Scomp__subr_signature, 1, 1, 0, - doc: /* Support function to 'hash_native_abi'. + doc: /* Support function to hash_native_abi. For internal use. */) (Lisp_Object subr) { return concat2 (Fsubr_name (subr), - Fprin1_to_string (Fsubr_arity (subr), Qnil)); + Fprin1_to_string (Fsubr_arity (subr), Qnil, Qnil)); } /* Produce a key hashing Vcomp_subr_list. */ @@ -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"); @@ -1586,7 +1707,7 @@ static gcc_jit_lvalue * emit_lisp_obj_reloc_lval (Lisp_Object obj) { emit_comment (format_string ("l-value for lisp obj: %s", - SSDATA (Fprin1_to_string (obj, Qnil)))); + SSDATA (Fprin1_to_string (obj, Qnil, Qnil)))); imm_reloc_t reloc = obj_to_reloc (obj); return gcc_jit_context_new_array_access (comp.ctxt, @@ -1599,9 +1720,9 @@ static gcc_jit_rvalue * emit_lisp_obj_rval (Lisp_Object obj) { emit_comment (format_string ("const lisp obj: %s", - SSDATA (Fprin1_to_string (obj, Qnil)))); + SSDATA (Fprin1_to_string (obj, Qnil, 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) { @@ -1824,7 +1968,7 @@ emit_mvar_rval (Lisp_Object mvar) SSDATA ( Fprin1_to_string ( NILP (func) ? value : CALL1I (comp-func-c-name, func), - Qnil))); + Qnil, Qnil))); } if (FIXNUMP (value)) { @@ -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)) { @@ -2321,7 +2471,7 @@ emit_limple_insn (Lisp_Object insn) else if (EQ (op, Qsetimm)) { /* Ex: (setimm #s(comp-mvar 9 1 t 3 nil) a). */ - emit_comment (SSDATA (Fprin1_to_string (arg[1], Qnil))); + emit_comment (SSDATA (Fprin1_to_string (arg[1], Qnil, Qnil))); imm_reloc_t reloc = obj_to_reloc (arg[1]); emit_frame_assignment ( arg[0], @@ -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'. */ @@ -2497,7 +2647,7 @@ emit_static_object (const char *name, Lisp_Object obj) specbind (intern_c_string ("print-quoted"), Qt); specbind (intern_c_string ("print-gensym"), Qt); specbind (intern_c_string ("print-circle"), Qt); - Lisp_Object str = Fprin1_to_string (obj, Qnil); + Lisp_Object str = Fprin1_to_string (obj, Qnil, Qnil); unbind_to (count, Qnil); ptrdiff_t len = SBYTES (str); @@ -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[] = @@ -3989,7 +4262,7 @@ compile_function (Lisp_Object func) { Lisp_Object block_name = HASH_KEY (ht, i); if (!EQ (block_name, Qentry) - && !EQ (block_name, Qunbound)) + && !BASE_EQ (block_name, Qunbound)) declare_block (block_name); } @@ -4002,7 +4275,7 @@ compile_function (Lisp_Object func) for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (ht); i++) { Lisp_Object block_name = HASH_KEY (ht, i); - if (!EQ (block_name, Qunbound)) + if (!BASE_EQ (block_name, Qunbound)) { Lisp_Object block = HASH_VALUE (ht, i); Lisp_Object insns = CALL1I (comp-block-insns, block); @@ -4123,8 +4396,8 @@ 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); - if (EQ (match_idx, make_fixnum (0))) + Fstring_match (XCAR (lds_re_tail), filename, Qnil, Qnil); + if (BASE_EQ (match_idx, make_fixnum (0))) { filename = Freplace_match (build_string ("//"), Qt, Qt, filename, Qnil); @@ -4193,7 +4466,7 @@ the latter is supposed to be used by the Emacs build procedure. */) } if (NILP (base_dir)) error ("Cannot find suitable directory for output in " - "`native-comp-eln-load-path'."); + "`comp-native-load-path'."); } if (!file_name_absolute_p (SSDATA (base_dir))) @@ -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 (); @@ -4613,12 +4890,12 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, struct Lisp_Hash_Table *func_h = XHASH_TABLE (CALL1I (comp-ctxt-funcs-h, Vcomp_ctxt)); for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (func_h); i++) - if (!EQ (HASH_VALUE (func_h, i), Qunbound)) + if (!BASE_EQ (HASH_VALUE (func_h, i), Qunbound)) declare_function (HASH_VALUE (func_h, i)); /* Compile all functions. Can't be done before because the relocation structs has to be already defined. */ for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (func_h); i++) - if (!EQ (HASH_VALUE (func_h, i), Qunbound)) + if (!BASE_EQ (HASH_VALUE (func_h, i), Qunbound)) compile_function (HASH_VALUE (func_h, i)); /* Work around bug#46495 (GCC PR99126). */ @@ -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. */ @@ -5073,7 +5342,7 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, are necessary exclusively during the first load. Once these are collected we don't have to maintain them in the heap forever. */ - Lisp_Object volatile data_ephemeral_vec; + Lisp_Object volatile data_ephemeral_vec = Qnil; /* In case another load of the same CU is active on the stack all ephemeral data is hold by that frame. Re-writing 'data_ephemeral_vec' would be not only a waste of cycles but @@ -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; @@ -5170,7 +5439,8 @@ make_subr (Lisp_Object symbol_name, Lisp_Object minarg, Lisp_Object maxarg, x->s.min_args = XFIXNUM (minarg); x->s.max_args = FIXNUMP (maxarg) ? XFIXNUM (maxarg) : MANY; x->s.symbol_name = xstrdup (SSDATA (symbol_name)); - x->s.native_intspec = intspec; + x->s.intspec.native = 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; @@ -5511,7 +5781,7 @@ For internal use. */); DEFVAR_LISP ("native-comp-eln-load-path", Vnative_comp_eln_load_path, doc: /* List of eln cache directories. -If a directory is non absolute is assumed to be relative to +If a directory is non absolute it is assumed to be relative to `invocation-directory'. `comp-native-version-dir' value is used as a sub-folder name inside each eln cache directory. @@ -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..1596e996d6c 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); @@ -688,7 +688,7 @@ composition_gstring_cache_clear_font (Lisp_Object font_object) { Lisp_Object k = HASH_KEY (h, i); - if (!EQ (k, Qunbound)) + if (!BASE_EQ (k, Qunbound)) { Lisp_Object gstring = HASH_VALUE (h, i); @@ -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 @@ -1497,10 +1513,11 @@ struct position_record /* Similar to find_composition, but find an automatic composition instead. This function looks for automatic composition at or near position - POS of OBJECT (a buffer or a string). OBJECT defaults to the - current buffer. It must be assured that POS is not within a static - composition. Also, the current buffer must be displayed in some - window, otherwise the function will return FALSE. + POS of STRING object, either a buffer or a Lisp string. If STRING + is nil, it defaults to the current buffer. It must be assured that + POS is not within a static composition. Also, the current buffer + must be displayed in some window, otherwise the function will + return FALSE. If LIMIT is negative, and there's no composition that includes POS (i.e. starts at or before POS and ends at or after POS), return @@ -1509,8 +1526,8 @@ struct position_record MAX_AUTO_COMPOSITION_LOOKBACK, the maximum number of look-back for automatic compositions (3) -- this is a limitation imposed by composition rules in composition-function-table, which see. If - BACKLIM is negative, it stands for the beginning of OBJECT: BEGV - for a buffer or position zero for a string. + BACKLIM is negative, it stands for the beginning of STRING object: + BEGV for a buffer or position zero for a string. If LIMIT is positive, search for a composition forward (LIMIT > POS) or backward (LIMIT < POS). In this case, LIMIT bounds the @@ -1519,18 +1536,21 @@ struct position_record function can find a composition that starts after POS. BACKLIM limits how far back is the function allowed to look in - OBJECT while trying to find a position where it is safe to start - searching forward for compositions. Such a safe place is generally - the position after a character that can never be composed. + STRING object while trying to find a position where it is safe to + start searching forward for compositions. Such a safe place is + generally the position after a character that can never be + composed. If BACKLIM is negative, that means the first character position of - OBJECT; this is useful when calling the function for the first time - for a given buffer or string, since it is possible that a - composition begins before POS. However, if POS is very far from - the beginning of OBJECT, a negative value of BACKLIM could make the - function slow. Also, in this case the function may return START - and END that do not include POS, something that is not necessarily - wanted, and needs to be explicitly checked by the caller. + STRING object; this is useful when calling the function for the + first time for a given buffer or string, since it is possible that + a composition begins before POS. However, if POS is very far from + the beginning of STRING object, a negative value of BACKLIM could + make the function slow. For that reason, when STRING is a buffer + or nil, we restrict the search back to the first newline before + POS. Also, in this case the function may return START and END that + do not include POS, something that is not necessarily wanted, and + needs to be explicitly checked by the caller. When calling the function in a loop for the same buffer/string, the caller should generally set BACKLIM equal to POS, to avoid costly @@ -1569,7 +1589,15 @@ find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit, ptrdiff_t backlim, cur.pos = pos; if (NILP (string)) { - head = backlim < 0 ? BEGV : backlim, tail = ZV, stop = GPT; + if (backlim < 0) + { + /* This assumes a newline can never be composed. */ + head = find_newline (pos, -1, 0, -1, -1, NULL, NULL, false) + 1; + } + else + head = backlim; + tail = ZV; + stop = GPT; cur.pos_byte = CHAR_TO_BYTE (cur.pos); cur.p = BYTE_POS_ADDR (cur.pos_byte); } @@ -1855,7 +1883,8 @@ should be ignored. */) else { CHECK_STRING (string); - validate_subarray (string, from, to, SCHARS (string), &frompos, &topos); + ptrdiff_t chars = SCHARS (string); + validate_subarray (string, from, to, chars, &frompos, &topos); if (! STRING_MULTIBYTE (string)) { ptrdiff_t i; @@ -1865,9 +1894,10 @@ should be ignored. */) error ("Attempt to shape unibyte text"); /* STRING is a pure-ASCII string, so we can convert it (or, rather, its copy) to multibyte and use that thereafter. */ - Lisp_Object string_copy = Fconcat (1, &string); - STRING_SET_MULTIBYTE (string_copy); - string = string_copy; + /* FIXME: Not clear why we need to do that: AFAICT the rest of + the code should work on an ASCII-only unibyte string just + as well (bug#56347). */ + string = make_multibyte_string (SSDATA (string), chars, chars); } frombyte = string_char_to_byte (string, frompos); } @@ -1961,7 +1991,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..6ecebf36ab9 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 @@ -249,7 +267,7 @@ extern void _DebPrint (const char *fmt, ...); /* Tell regex.c to use a type compatible with Emacs. */ #define RE_TRANSLATE_TYPE Lisp_Object #define RE_TRANSLATE(TBL, C) char_table_translate (TBL, C) -#define RE_TRANSLATE_P(TBL) (!EQ (TBL, make_fixnum (0))) +#define RE_TRANSLATE_P(TBL) (!BASE_EQ (TBL, make_fixnum (0))) #endif /* Tell time_rz.c to use Emacs's getter and setter for TZ. @@ -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..568349ba839 100644 --- a/src/data.c +++ b/src/data.c @@ -211,11 +211,13 @@ for example, (type-of 1) returns `integer'. */) return Qcons; case Lisp_Vectorlike: + /* WARNING!! Keep 'cl--typeof-types' in sync with this code!! */ switch (PSEUDOVECTOR_TYPE (XVECTOR (object))) { 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 +261,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 +320,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) @@ -675,7 +699,7 @@ global value outside of any lexical scope. */) default: emacs_abort (); } - return (EQ (valcontents, Qunbound) ? Qnil : Qt); + return (BASE_EQ (valcontents, Qunbound) ? Qnil : Qt); } /* It has been previously suggested to make this function an alias for @@ -753,11 +777,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 +844,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 +860,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 = plist_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 +948,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); @@ -950,6 +1073,7 @@ Value, if non-nil, is a list (interactive SPEC). */) (Lisp_Object cmd) { Lisp_Object fun = indirect_function (cmd); /* Check cycles. */ + bool genfun = false; if (NILP (fun)) return Qnil; @@ -968,10 +1092,10 @@ Value, if non-nil, is a list (interactive SPEC). */) if (SUBRP (fun)) { - if (SUBR_NATIVE_COMPILEDP (fun) && !NILP (XSUBR (fun)->native_intspec)) - return XSUBR (fun)->native_intspec; + if (SUBR_NATIVE_COMPILEDP (fun) && !NILP (XSUBR (fun)->intspec.native)) + return XSUBR (fun)->intspec.native; - const char *spec = XSUBR (fun)->intspec; + const char *spec = XSUBR (fun)->intspec.string; if (spec) return list2 (Qinteractive, (*spec != '(') ? build_string (spec) : @@ -982,15 +1106,17 @@ Value, if non-nil, is a list (interactive SPEC). */) if (PVSIZE (fun) > COMPILED_INTERACTIVE) { Lisp_Object form = AREF (fun, COMPILED_INTERACTIVE); - if (VECTORP (form)) - /* The vector form is the new form, where the first - element is the interactive spec, and the second is the - command modes. */ - return list2 (Qinteractive, AREF (form, 0)); - else - /* Old form -- just the interactive spec. */ - return list2 (Qinteractive, form); + /* The vector form is the new form, where the first + element is the interactive spec, and the second is the + command modes. */ + return list2 (Qinteractive, VECTORP (form) ? AREF (form, 0) : form); } + else if (PVSIZE (fun) > COMPILED_DOC_STRING) + { + Lisp_Object doc = AREF (fun, COMPILED_DOC_STRING); + /* An invalid "docstring" is a sign that we have an OClosure. */ + genfun = !(NILP (doc) || VALID_DOCSTRING_P (doc)); + } } #ifdef HAVE_MODULES else if (MODULE_FUNCTIONP (fun)) @@ -1013,18 +1139,23 @@ Value, if non-nil, is a list (interactive SPEC). */) if (EQ (funcar, Qclosure)) form = Fcdr (form); Lisp_Object spec = Fassq (Qinteractive, form); - if (NILP (Fcdr (Fcdr (spec)))) + if (NILP (spec) && VALID_DOCSTRING_P (CAR_SAFE (form))) + /* A "docstring" is a sign that we may have an OClosure. */ + genfun = true; + else if (NILP (Fcdr (Fcdr (spec)))) return spec; else return list2 (Qinteractive, Fcar (Fcdr (spec))); } } - return Qnil; + if (genfun + /* Avoid burping during bootstrap. */ + && !NILP (Fsymbol_function (Qoclosure_interactive_form))) + return call1 (Qoclosure_interactive_form, fun); + else + 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 +1179,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; @@ -1411,8 +1546,13 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_ /* Find the value of a symbol, returning Qunbound if it's not bound. This is helpful for code which just wants to get a variable's value if it has one, without signaling an error. - Note that it must not be possible to quit - within this function. Great care is required for this. */ + + This function is very similar to buffer_local_value, but we have + two separate code paths here since find_symbol_value has to be very + efficient, while buffer_local_value doesn't have to be. + + Note that it must not be possible to quit within this function. + Great care is required for this. */ Lisp_Object find_symbol_value (Lisp_Object symbol) @@ -1450,7 +1590,7 @@ global value outside of any lexical scope. */) Lisp_Object val; val = find_symbol_value (symbol); - if (!EQ (val, Qunbound)) + if (!BASE_EQ (val, Qunbound)) return val; xsignal1 (Qvoid_variable, symbol); @@ -1477,7 +1617,7 @@ void set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, enum Set_Internal_Bind bindflag) { - bool voide = EQ (newval, Qunbound); + bool voide = BASE_EQ (newval, Qunbound); /* If restoring in a dead buffer, do nothing. */ /* if (BUFFERP (where) && NILP (XBUFFER (where)->name)) @@ -1718,7 +1858,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); @@ -1804,15 +1944,15 @@ default_value (Lisp_Object symbol) DEFUN ("default-boundp", Fdefault_boundp, Sdefault_boundp, 1, 1, 0, doc: /* Return t if SYMBOL has a non-void default value. -A variable may have a buffer-local or a `let'-bound local value. This -function says whether the variable has a non-void value outside of the -current context. Also see `default-value'. */) +A variable may have a buffer-local value. This function says whether +the variable has a non-void value outside of the current buffer +context. Also see `default-value'. */) (Lisp_Object symbol) { register Lisp_Object value; value = default_value (symbol); - return (EQ (value, Qunbound) ? Qnil : Qt); + return (BASE_EQ (value, Qunbound) ? Qnil : Qt); } DEFUN ("default-value", Fdefault_value, Sdefault_value, 1, 1, 0, @@ -1823,7 +1963,7 @@ local bindings in certain buffers. */) (Lisp_Object symbol) { Lisp_Object value = default_value (symbol); - if (!EQ (value, Qunbound)) + if (!BASE_EQ (value, Qunbound)) return value; xsignal1 (Qvoid_variable, symbol); @@ -2003,7 +2143,7 @@ See also `defvar-local'. */) case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_PLAINVAL: forwarded = 0; valcontents.value = SYMBOL_VAL (sym); - if (EQ (valcontents.value, Qunbound)) + if (BASE_EQ (valcontents.value, Qunbound)) valcontents.value = Qnil; break; case SYMBOL_LOCALIZED: @@ -2104,7 +2244,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 +2324,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, @@ -2195,7 +2335,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) forwarded objects won't work right. */ { Lisp_Object buf; XSETBUFFER (buf, current_buffer); - if (EQ (buf, blv->where)) + if (BASE_EQ (buf, blv->where)) swap_in_global_binding (sym); } @@ -2225,7 +2365,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 +2373,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 +2834,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 +2845,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 +2856,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 +2867,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 +3001,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 +3031,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, @@ -3353,7 +3527,7 @@ In this case, the sign bit is duplicated. */) if (! FIXNUMP (count)) { - if (EQ (value, make_fixnum (0))) + if (BASE_EQ (value, make_fixnum (0))) return value; if (mpz_sgn (*xbignum_val (count)) < 0) { @@ -3398,11 +3572,11 @@ Lisp_Object expt_integer (Lisp_Object x, Lisp_Object y) { /* Special cases for -1 <= x <= 1, which never overflow. */ - if (EQ (x, make_fixnum (1))) + if (BASE_EQ (x, make_fixnum (1))) return x; - if (EQ (x, make_fixnum (0))) - return EQ (x, y) ? make_fixnum (1) : x; - if (EQ (x, make_fixnum (-1))) + if (BASE_EQ (x, make_fixnum (0))) + return BASE_EQ (x, y) ? make_fixnum (1) : x; + if (BASE_EQ (x, make_fixnum (-1))) return ((FIXNUMP (y) ? XFIXNUM (y) & 1 : mpz_odd_p (*xbignum_val (y))) ? x : make_fixnum (1)); @@ -3897,7 +4071,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 +4106,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 +4139,8 @@ 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 (Qoclosure_interactive_form, "oclosure-interactive-form"); DEFSYM (Qsubrp, "subrp"); DEFSYM (Qunevalled, "unevalled"); @@ -4037,12 +4219,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 +4268,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 +4288,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 +4320,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 +4406,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/dbusbind.c b/src/dbusbind.c index 7cfdbbe23cf..943a4aff8e7 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -1690,29 +1690,30 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) value = Fgethash (key, Vdbus_registered_objects_table, Qnil); /* Loop over the registered functions. Construct an event. */ - while (!NILP (value)) + for (; !NILP (value); value = CDR_SAFE (value)) { key = CAR_SAFE (value); + Lisp_Object key_uname = CAR_SAFE (key); /* key has the structure (UNAME SERVICE PATH HANDLER). */ - if (((uname == NULL) - || (NILP (CAR_SAFE (key))) - || (strcmp (uname, SSDATA (CAR_SAFE (key))) == 0)) - && ((path == NULL) - || (NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (key))))) - || (strcmp (path, - SSDATA (CAR_SAFE (CDR_SAFE (CDR_SAFE (key))))) - == 0)) - && (!NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key))))))) - { - EVENT_INIT (event); - event.kind = DBUS_EVENT; - event.frame_or_window = Qnil; - /* Handler. */ - event.arg - = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))), args); - break; - } - value = CDR_SAFE (value); + if (uname && !NILP (key_uname) + && strcmp (uname, SSDATA (key_uname)) != 0) + continue; + Lisp_Object key_service_etc = CDR_SAFE (key); + Lisp_Object key_path_etc = CDR_SAFE (key_service_etc); + Lisp_Object key_path = CAR_SAFE (key_path_etc); + if (path && !NILP (key_path) + && strcmp (path, SSDATA (key_path)) != 0) + continue; + Lisp_Object handler = CAR_SAFE (CDR_SAFE (key_path_etc)); + if (NILP (handler)) + continue; + + /* Construct an event and exit the loop. */ + EVENT_INIT (event); + event.kind = DBUS_EVENT; + event.frame_or_window = Qnil; + event.arg = Fcons (handler, args); + break; } if (NILP (value)) 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..c2c099f0a5f 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 @@ -219,6 +219,13 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, } #endif + if (!NILP (full) && !STRING_MULTIBYTE (directory)) + { /* We will be concatenating 'directory' with local file name. + We always decode local file names, so in order to safely concatenate + them we need 'directory' to be decoded as well (bug#56469). */ + directory = DECODE_FILE (directory); + } + ptrdiff_t directory_nbytes = SBYTES (directory); re_match_object = Qt; @@ -263,9 +270,20 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, ptrdiff_t name_nbytes = SBYTES (name); ptrdiff_t nbytes = directory_nbytes + needsep + name_nbytes; ptrdiff_t nchars = SCHARS (directory) + needsep + SCHARS (name); - finalname = make_uninit_multibyte_string (nchars, nbytes); - if (nchars == nbytes) - STRING_SET_UNIBYTE (finalname); + /* DECODE_FILE may return non-ASCII unibyte strings (e.g. when + file-name-coding-system is 'binary'), so we don't know for sure + that the bytes we have follow our internal utf-8 representation + for multibyte strings. If nchars == nbytes we don't need to + care and just return a unibyte string; and if not, that means + one of 'name' or 'directory' is multibyte, in which case we + presume that the other one would also be multibyte if it + contained non-ASCII. + FIXME: This last presumption is broken when 'directory' is + multibyte (with non-ASCII), and 'name' is unibyte with non-ASCII + (because file-name-coding-system is 'binary'). */ + finalname = (nchars == nbytes) + ? make_uninit_string (nbytes) + : make_uninit_multibyte_string (nchars, nbytes); memcpy (SDATA (finalname), SDATA (directory), directory_nbytes); if (needsep) SSET (finalname, directory_nbytes, DIRECTORY_SEP); @@ -289,7 +307,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 +473,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; @@ -482,8 +500,8 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, decoded names in order to filter false positives, such as "a" falsely matching "a-ring". */ if (!NILP (file_encoding) - && !NILP (Fplist_get (Fcoding_system_plist (file_encoding), - Qdecomposed_characters))) + && !NILP (plist_get (Fcoding_system_plist (file_encoding), + Qdecomposed_characters))) { check_decoded = true; if (STRING_MULTIBYTE (file)) @@ -521,9 +539,9 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, name = DECODE_FILE (name); ptrdiff_t name_blen = SBYTES (name), name_len = SCHARS (name); if (completion_ignore_case - && !EQ (Fcompare_strings (name, zero, file_len, file, zero, file_len, - Qt), - Qt)) + && !BASE_EQ (Fcompare_strings (name, zero, file_len, file, zero, + file_len, Qt), + Qt)) continue; switch (dirent_type (dp)) @@ -603,10 +621,12 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, skip = name_len - elt_len; cmp_len = make_fixnum (elt_len); if (skip < 0 - || !EQ (Fcompare_strings (name, make_fixnum (skip), - Qnil, - elt, zero, cmp_len, Qt), - Qt)) + || !BASE_EQ (Fcompare_strings (name, + make_fixnum (skip), + Qnil, + elt, zero, cmp_len, + Qt), + Qt)) continue; } break; @@ -637,10 +657,12 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, skip = name_len - elt_len; cmp_len = make_fixnum (elt_len); if (skip < 0 - || !EQ (Fcompare_strings (name, make_fixnum (skip), - Qnil, - elt, zero, cmp_len, Qt), - Qt)) + || !BASE_EQ (Fcompare_strings (name, + make_fixnum (skip), + Qnil, + elt, zero, cmp_len, + Qt), + Qt)) continue; } break; @@ -699,7 +721,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, = Fcompare_strings (name, zero, make_fixnum (compare), file, zero, make_fixnum (compare), completion_ignore_case ? Qt : Qnil); - if (!EQ (cmp, Qt)) + if (!BASE_EQ (cmp, Qt)) continue; } @@ -722,7 +744,8 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, = Fcompare_strings (bestmatch, zero, make_fixnum (compare), name, zero, make_fixnum (compare), completion_ignore_case ? Qt : Qnil); - ptrdiff_t matchsize = EQ (cmp, Qt) ? compare : eabs (XFIXNUM (cmp)) - 1; + ptrdiff_t matchsize = BASE_EQ (cmp, Qt) + ? compare : eabs (XFIXNUM (cmp)) - 1; if (completion_ignore_case) { @@ -751,13 +774,13 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, file, zero, Qnil, Qnil), - EQ (Qt, cmp)) + BASE_EQ (Qt, cmp)) && (cmp = Fcompare_strings (bestmatch, zero, make_fixnum (SCHARS (file)), file, zero, Qnil, Qnil), - ! EQ (Qt, cmp)))) + ! BASE_EQ (Qt, cmp)))) bestmatch = name; } bestmatchsize = matchsize; @@ -944,7 +967,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..ca7834dec55 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. */ @@ -1065,6 +1075,9 @@ struct glyph_row right-to-left paragraph. */ bool_bf reversed_p : 1; + /* Whether or not a stipple was drawn in this row at some point. */ + bool_bf stipple_p : 1; + /* Continuation lines width at the start of the row. */ int continuation_lines_width; @@ -1393,6 +1406,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 +1486,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 +1515,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 +1723,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 +1762,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 +1838,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 +2565,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 @@ -2714,11 +2742,11 @@ struct it /* The line number of point's line, or zero if not computed yet. */ ptrdiff_t pt_lnum; - /* Number of pixels to offset tab stops due to width fixup of the - first glyph that crosses first_visible_x. This is only needed on - GUI frames, only when display-line-numbers is in effect, and only - in hscrolled windows. */ - int tab_offset; + /* Number of pixels to adjust tab stops and stretch glyphs due to + width fixup of the first stretch glyph that crosses first_visible_x. + This is only needed on GUI frames, only when display-line-numbers + is in effect, and only in hscrolled windows. */ + int stretch_adjust; /* Left fringe bitmap number (enum fringe_bitmap_type). */ unsigned left_user_fringe_bitmap : FRINGE_ID_BITS; @@ -2739,6 +2767,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 +3045,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 +3084,17 @@ struct image #ifdef HAVE_NTGUI XFORM xform; #endif +#ifdef HAVE_HAIKU + /* The affine transformation to apply to this image. */ + double transform[3][3]; + + /* The original width and height of the image. */ + int original_width, original_height; + + /* Whether or not bilinear filtering should be used to "smooth" the + image. */ + bool use_bilinear_filtering; +#endif /* Colors allocated for this image, if any. Allocated via xmalloc. */ unsigned long *colors; @@ -3162,7 +3207,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 */ @@ -3365,6 +3410,8 @@ int partial_line_height (struct it *it_origin); bool in_display_vector_p (struct it *); int frame_mode_line_height (struct frame *); extern bool redisplaying_p; +extern bool display_working_on_window_p; +extern void unwind_display_working_on_window (void); extern bool help_echo_showing_p; extern Lisp_Object help_echo_string, help_echo_window; extern Lisp_Object help_echo_object, previous_help_echo_string; @@ -3421,11 +3468,14 @@ 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 *, const Emacs_Rectangle *, Emacs_Rectangle *); +extern void gui_consider_frame_title (Lisp_Object); #endif /* HAVE_WINDOW_SYSTEM */ extern void note_mouse_highlight (struct frame *, int, int); @@ -3460,6 +3510,8 @@ extern unsigned row_hash (struct glyph_row *); extern bool buffer_flipping_blocked_p (void); +extern void update_redisplay_ticks (int, struct window *); + /* Defined in image.c */ #ifdef HAVE_WINDOW_SYSTEM @@ -3492,7 +3544,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 @@ -3570,6 +3623,9 @@ void gamma_correct (struct frame *, XColor *); #ifdef HAVE_NTGUI void gamma_correct (struct frame *, COLORREF *); #endif +#ifdef HAVE_HAIKU +void gamma_correct (struct frame *, Emacs_Color *); +#endif #ifdef HAVE_WINDOW_SYSTEM @@ -3725,10 +3781,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 39e5469db05..53a47c4b2f2 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -2732,12 +2732,25 @@ set_frame_matrix_frame (struct frame *f) operations in window matrices of frame_matrix_frame. */ static void -make_current (struct glyph_matrix *desired_matrix, struct glyph_matrix *current_matrix, int row) +make_current (struct glyph_matrix *desired_matrix, + struct glyph_matrix *current_matrix, int row) { struct glyph_row *current_row = MATRIX_ROW (current_matrix, row); struct glyph_row *desired_row = MATRIX_ROW (desired_matrix, row); bool mouse_face_p = current_row->mouse_face_p; + /* If we aborted redisplay of this window, a row in the desired + matrix might not have its hash computed. But update_window + relies on each row having its correct hash, so do it here if + needed. */ + if (!desired_row->hash + /* A glyph row that is not completely empty is unlikely to have + a zero hash value. */ + && !(!desired_row->used[0] + && !desired_row->used[1] + && !desired_row->used[2])) + desired_row->hash = row_hash (desired_row); + /* Do current_row = desired_row. This exchanges glyph pointers between both rows, and does a structure assignment otherwise. */ assign_row (current_row, desired_row); @@ -3874,6 +3887,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)) @@ -3928,7 +3944,8 @@ update_marginal_area (struct window *w, struct glyph_row *updated_row, Value is true if display has changed. */ static bool -update_text_area (struct window *w, struct glyph_row *updated_row, int vpos) +update_text_area (struct window *w, struct glyph_row *updated_row, int vpos, + bool *partial_p) { struct glyph_row *current_row = MATRIX_ROW (w->current_matrix, vpos); struct glyph_row *desired_row = MATRIX_ROW (w->desired_matrix, vpos); @@ -3949,9 +3966,13 @@ update_text_area (struct window *w, struct glyph_row *updated_row, int vpos) However, it causes excessive flickering when mouse is moved across the mode line. Luckily, turning it off for the mode line doesn't seem to hurt anything. -- cyd. - But it is still needed for the header line. -- kfs. */ + But it is still needed for the header line. -- kfs. + The header line vpos is 1 if a tab line is enabled. (18th + Apr 2022) */ || (current_row->mouse_face_p - && !(current_row->mode_line_p && vpos > 0)) + && !(current_row->mode_line_p + && (vpos > (w->current_matrix->tab_line_p + && w->current_matrix->header_line_p)))) || current_row->x != desired_row->x) { output_cursor_to (w, vpos, 0, desired_row->y, desired_row->x); @@ -4030,6 +4051,13 @@ update_text_area (struct window *w, struct glyph_row *updated_row, int vpos) { x += desired_glyph->pixel_width; ++desired_glyph, ++current_glyph, ++i; + + /* Say that only a partial update was performed of + the current row (i.e. not all the glyphs were + drawn). This is used to preserve the stipple_p + flag of the current row inside + update_window_line. */ + *partial_p = true; } /* Consider the case that the current row contains "xxx @@ -4101,9 +4129,15 @@ update_text_area (struct window *w, struct glyph_row *updated_row, int vpos) rif->write_glyphs (w, updated_row, start, TEXT_AREA, i - start_hpos); changed_p = 1; + *partial_p = true; } } + /* This means we will draw from the start, so no partial update + is being performed. */ + if (!i) + *partial_p = false; + /* Write the rest. */ if (i < desired_row->used[TEXT_AREA]) { @@ -4176,7 +4210,9 @@ update_window_line (struct window *w, int vpos, bool *mouse_face_overwritten_p) struct glyph_row *current_row = MATRIX_ROW (w->current_matrix, vpos); struct glyph_row *desired_row = MATRIX_ROW (w->desired_matrix, vpos); struct redisplay_interface *rif = FRAME_RIF (XFRAME (WINDOW_FRAME (w))); - bool changed_p = 0; + + /* partial_p is true if not all of desired_row was drawn. */ + bool changed_p = 0, partial_p = 0, was_stipple; /* A row can be completely invisible in case a desired matrix was built with a vscroll and then make_cursor_line_fully_visible shifts @@ -4200,7 +4236,7 @@ update_window_line (struct window *w, int vpos, bool *mouse_face_overwritten_p) } /* Update the display of the text area. */ - if (update_text_area (w, desired_row, vpos)) + if (update_text_area (w, desired_row, vpos, &partial_p)) { changed_p = 1; if (current_row->mouse_face_p) @@ -4229,7 +4265,17 @@ update_window_line (struct window *w, int vpos, bool *mouse_face_overwritten_p) } /* Update current_row from desired_row. */ + was_stipple = current_row->stipple_p; make_current (w->desired_matrix, w->current_matrix, vpos); + + /* If only a partial update was performed, any stipple already + displayed in MATRIX_ROW (w->current_matrix, vpos) might still be + there, so don't hurry to clear that flag if it's not in + desired_row. */ + + if (partial_p && was_stipple) + current_row->stipple_p = true; + return changed_p; } @@ -4251,11 +4297,11 @@ set_window_cursor_after_update (struct window *w) /* If we are showing a message instead of the mini-buffer, show the cursor for the message instead. */ && XWINDOW (minibuf_window) == w - && EQ (minibuf_window, echo_area_window) + && BASE_EQ (minibuf_window, echo_area_window) /* These cases apply only to the frame that contains the active mini-buffer window. */ && FRAME_HAS_MINIBUF_P (f) - && EQ (FRAME_MINIBUF_WINDOW (f), echo_area_window)) + && BASE_EQ (FRAME_MINIBUF_WINDOW (f), echo_area_window)) { cx = cy = vpos = hpos = 0; @@ -4409,7 +4455,6 @@ add_row_entry (struct glyph_row *row) return entry; } - /* Try to reuse part of the current display of W by scrolling lines. HEADER_LINE_P means W has a header line. @@ -4455,6 +4500,14 @@ scrolling_window (struct window *w, int tab_line_p) struct glyph_row *d = MATRIX_ROW (desired_matrix, i); struct glyph_row *c = MATRIX_ROW (current_matrix, i); + /* If there is a row with a stipple currently on the glass, give + up. Stipples look different depending on where on the + display they are drawn, so scrolling the display will produce + incorrect results. */ + + if (c->stipple_p) + return 0; + if (c->enabled_p && d->enabled_p && !d->redraw_fringe_bitmaps_p @@ -4470,16 +4523,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. */ @@ -4494,6 +4537,16 @@ scrolling_window (struct window *w, int tab_line_p) first_old = first_new = i; + while (i < current_matrix->nrows - 1) + { + /* If there is a stipple after the first change, give up as + well. */ + if (MATRIX_ROW (current_matrix, i)->stipple_p) + return 0; + + ++i; + } + /* Set last_new to the index + 1 of the row that reaches the bottom boundary in the desired matrix. Give up if we find a disabled row before we reach the bottom boundary. */ @@ -4908,13 +4961,13 @@ update_frame_1 (struct frame *f, bool force_p, bool inhibit_id_p, /* If we are showing a message instead of the mini-buffer, show the cursor for the message instead of for the (now hidden) mini-buffer contents. */ - || (EQ (minibuf_window, selected_window) - && EQ (minibuf_window, echo_area_window) + || (BASE_EQ (minibuf_window, selected_window) + && BASE_EQ (minibuf_window, echo_area_window) && !NILP (echo_area_buffer[0]))) /* These cases apply only to the frame that contains the active mini-buffer window. */ && FRAME_HAS_MINIBUF_P (f) - && EQ (FRAME_MINIBUF_WINDOW (f), echo_area_window)) + && BASE_EQ (FRAME_MINIBUF_WINDOW (f), echo_area_window)) { int top = WINDOW_TOP_EDGE_LINE (XWINDOW (FRAME_MINIBUF_WINDOW (f))); int col; @@ -6177,7 +6230,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 @@ -6207,15 +6260,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); @@ -6268,7 +6319,7 @@ pass nil for VARIABLE. */) { if (idx == ASIZE (state)) goto changed; - if (!EQ (AREF (state, idx++), frame)) + if (!BASE_EQ (AREF (state, idx++), frame)) goto changed; if (idx == ASIZE (state)) goto changed; @@ -6283,7 +6334,7 @@ pass nil for VARIABLE. */) continue; if (idx == ASIZE (state)) goto changed; - if (!EQ (AREF (state, idx++), buf)) + if (!BASE_EQ (AREF (state, idx++), buf)) goto changed; if (idx == ASIZE (state)) goto changed; @@ -6484,6 +6535,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"); @@ -6675,6 +6744,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' @@ -6688,6 +6759,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' @@ -6728,6 +6801,10 @@ See `buffer-display-table' for more information. */); beginning of the next redisplay). */ redisplay_dont_pause = true; + DEFVAR_LISP ("x-show-tooltip-timeout", Vx_show_tooltip_timeout, + doc: /* The default timeout (in seconds) for `x-show-tip'. */); + Vx_show_tooltip_timeout = make_fixnum (5); + DEFVAR_LISP ("tab-bar-position", Vtab_bar_position, doc: /* Specify on which side from the tool bar the tab bar shall be. Possible values are t (below the tool bar), nil (above the tool bar). diff --git a/src/doc.c b/src/doc.c index 25c79de56cb..34b80d03aa9 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,60 +341,12 @@ 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). */ - if (EQ (doc, make_fixnum (0))) + if (BASE_EQ (doc, make_fixnum (0))) doc = Qnil; if (FIXNUMP (doc) || CONSP (doc)) { @@ -445,7 +400,7 @@ aren't strings. */) tem = Fget (indirect, prop); } - if (EQ (tem, make_fixnum (0))) + if (BASE_EQ (tem, make_fixnum (0))) tem = Qnil; /* See if we want to look for the string in the DOC file. */ @@ -511,11 +466,17 @@ 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. */ + && VALID_DOCSTRING_P (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 +503,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 +526,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 ***/ @@ -609,6 +569,8 @@ the same file name is found in the `doc-directory'. */) if (p) { end = strchr (p, '\n'); + if (!end) + error ("DOC file invalid at position %"pI"d", pos); /* We used to skip files not in build_files, so that when a function was defined several times in different files @@ -675,7 +637,7 @@ default_to_grave_quoting_style (void) Lisp_Object dv = DISP_CHAR_VECTOR (XCHAR_TABLE (Vstandard_display_table), LEFT_SINGLE_QUOTATION_MARK); return (VECTORP (dv) && ASIZE (dv) == 1 - && EQ (AREF (dv, 0), make_fixnum ('`'))); + && BASE_EQ (AREF (dv, 0), make_fixnum ('`'))); } DEFUN ("text-quoting-style", Ftext_quoting_style, @@ -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..4587b1132b1 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -161,7 +161,7 @@ DEFUN ("byte-to-string", Fbyte_to_string, Sbyte_to_string, 1, 1, 0, if (XFIXNUM (byte) < 0 || XFIXNUM (byte) > 255) error ("Invalid byte"); b = XFIXNUM (byte); - return make_string_from_bytes ((char *) &b, 1, 1); + return make_unibyte_string ((char *) &b, 1); } DEFUN ("string-to-char", Fstring_to_char, Sstring_to_char, 1, 1, 0, @@ -648,7 +648,7 @@ Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */) prev_new = make_fixnum (XFIXNUM (new_pos) - 1); if (NILP (Vinhibit_field_text_motion) - && !EQ (new_pos, old_pos) + && !BASE_EQ (new_pos, old_pos) && (!NILP (Fget_char_property (new_pos, Qfield, Qnil)) || !NILP (Fget_char_property (old_pos, Qfield, Qnil)) /* To recognize field boundaries, we must also look at the @@ -797,7 +797,7 @@ save_excursion_save (union specbinding *pdl) pdl->unwind_excursion.marker = Fpoint_marker (); /* Selected window if current buffer is shown in it, nil otherwise. */ pdl->unwind_excursion.window - = (EQ (XWINDOW (selected_window)->contents, Fcurrent_buffer ()) + = (BASE_EQ (XWINDOW (selected_window)->contents, Fcurrent_buffer ()) ? selected_window : Qnil); } @@ -821,7 +821,7 @@ save_excursion_restore (Lisp_Object marker, Lisp_Object window) /* If buffer was visible in a window, and a different window was selected, and the old selected window is still showing this buffer, restore point in that window. */ - if (WINDOWP (window) && !EQ (window, selected_window)) + if (WINDOWP (window) && !BASE_EQ (window, selected_window)) { /* Set window point if WINDOW is live and shows the current buffer. */ Lisp_Object contents = XWINDOW (window)->contents; @@ -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); @@ -2843,7 +2843,7 @@ otherwise MSGID-PLURAL. */) CHECK_INTEGER (n); /* Placeholder implementation until we get our act together. */ - return EQ (n, make_fixnum (1)) ? msgid : msgid_plural; + return BASE_EQ (n, make_fixnum (1)) ? msgid : msgid_plural; } DEFUN ("message", Fmessage, Smessage, 1, MANY, 0, @@ -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 @@ -3327,7 +3327,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) if (EQ (arg, args[n])) { Lisp_Object noescape = conversion == 'S' ? Qnil : Qt; - spec->argument = arg = Fprin1_to_string (arg, noescape); + spec->argument = arg = Fprin1_to_string (arg, noescape, Qnil); if (STRING_MULTIBYTE (arg) && ! multibyte) { multibyte = true; diff --git a/src/emacs-module.c b/src/emacs-module.c index 392b3ba9659..1c392d65df8 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -411,7 +411,7 @@ module_global_reference_p (emacs_value v, ptrdiff_t *n) reference that's identical to some global reference. */ for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i) { - if (!EQ (HASH_KEY (h, i), Qunbound) + if (!BASE_EQ (HASH_KEY (h, i), Qunbound) && &XMODULE_GLOBAL_REFERENCE (HASH_VALUE (h, i))->value == v) return true; } @@ -955,11 +955,9 @@ single memcpy to convert the magnitude. This way we largely avoid the import/export overhead on most platforms. */ -enum -{ - /* Documented maximum count of magnitude elements. */ - module_bignum_count_max = min (SIZE_MAX, PTRDIFF_MAX) / sizeof (emacs_limb_t) -}; +/* Documented maximum count of magnitude elements. */ +#define module_bignum_count_max \ + ((ptrdiff_t) min (SIZE_MAX, PTRDIFF_MAX) / sizeof (emacs_limb_t)) /* Verify that emacs_limb_t indeed has unique object representations. */ @@ -1137,7 +1135,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 +1164,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 0a90b0913be..3c768412818 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; @@ -150,6 +159,10 @@ Lisp_Object empty_unibyte_string, empty_multibyte_string; #ifdef WINDOWSNT /* Cache for externally loaded libraries. */ Lisp_Object Vlibrary_cache; +/* Original command line string as received from the OS. */ +static char *initial_cmdline; +/* Original working directory when invoked. */ +static const char *initial_wd; #endif struct gflags gflags; @@ -185,8 +198,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 @@ -217,6 +233,7 @@ HANDLE w32_daemon_event; /* Save argv and argc. */ char **initial_argv; int initial_argc; +static char *initial_emacs_executable = NULL; /* The name of the working directory, or NULL if this info is unavailable. */ char const *emacs_wd; @@ -255,11 +272,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 "\ @@ -278,7 +296,10 @@ Initialization options:\n\ -q --no-site-file --no-site-lisp --no-splash\n\ --no-x-resources\n\ --script FILE run FILE as an Emacs Lisp script\n\ ---terminal, -t DEVICE use DEVICE for terminal I/O\n\ +-x to be used in #!/usr/bin/emacs -x\n\ + and has approximately the same meaning\n\ + as -Q --script\n\ +--terminal, -t DEVICE use DEVICE for terminal I/O\n \ --user, -u USER load ~USER/.emacs instead of your own\n\ \n\ ", @@ -414,7 +435,7 @@ terminate_due_to_signal (int sig, int backtrace_limit) don't care about the message stack. */ if (sig == SIGINT && noninteractive) clear_message_stack (); - Fkill_emacs (make_fixnum (sig)); + Fkill_emacs (make_fixnum (sig), Qnil); } shut_down_emacs (sig, Qnil); @@ -447,7 +468,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, "/:"); @@ -697,34 +718,6 @@ argmatch (char **argv, int argc, const char *sstr, const char *lstr, } } -#ifdef HAVE_PDUMPER - -static const char * -dump_error_to_string (int result) -{ - switch (result) - { - case PDUMPER_LOAD_SUCCESS: - return "success"; - case PDUMPER_LOAD_OOM: - return "out of memory"; - case PDUMPER_NOT_LOADED: - return "not loaded"; - case PDUMPER_LOAD_FILE_NOT_FOUND: - return "could not open file"; - case PDUMPER_LOAD_BAD_FILE_TYPE: - return "not a dump file"; - case PDUMPER_LOAD_FAILED_DUMP: - return "dump file is result of failed dump attempt"; - case PDUMPER_LOAD_VERSION_MISMATCH: - return "not built for this Emacs executable"; - default: - return (result <= PDUMPER_LOAD_ERROR - ? "generic error" - : strerror (result - PDUMPER_LOAD_ERROR)); - } -} - /* Find a name (absolute or relative) of the Emacs executable whose name (as passed into this program) is ARGV0. Called early in initialization by portable dumper loading code, so avoid Lisp and @@ -733,7 +726,7 @@ dump_error_to_string (int result) if not found. Store into *CANDIDATE_SIZE a lower bound on the size of any heap allocation. */ static char * -load_pdump_find_executable (char const *argv0, ptrdiff_t *candidate_size) +find_emacs_executable (char const *argv0, ptrdiff_t *candidate_size) { *candidate_size = 0; @@ -824,12 +817,43 @@ load_pdump_find_executable (char const *argv0, ptrdiff_t *candidate_size) #endif /* !WINDOWSNT */ } -static void +#ifdef HAVE_PDUMPER + +static const char * +dump_error_to_string (int result) +{ + switch (result) + { + case PDUMPER_LOAD_SUCCESS: + return "success"; + case PDUMPER_LOAD_OOM: + return "out of memory"; + case PDUMPER_NOT_LOADED: + return "not loaded"; + case PDUMPER_LOAD_FILE_NOT_FOUND: + return "could not open file"; + case PDUMPER_LOAD_BAD_FILE_TYPE: + return "not a dump file"; + case PDUMPER_LOAD_FAILED_DUMP: + return "dump file is result of failed dump attempt"; + case PDUMPER_LOAD_VERSION_MISMATCH: + return "not built for this Emacs executable"; + default: + return (result <= PDUMPER_LOAD_ERROR + ? "generic error" + : strerror (result - PDUMPER_LOAD_ERROR)); + } +} + +/* This function returns the Emacs executable. */ +static char * 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 +891,14 @@ load_pdump (int argc, char **argv) } /* Where's our executable? */ - ptrdiff_t bufsize, exec_bufsize; - emacs_executable = load_pdump_find_executable (argv[0], &bufsize); + ptrdiff_t bufsize; +#ifndef NS_SELF_CONTAINED + ptrdiff_t exec_bufsize; +#endif + emacs_executable = find_emacs_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. */ @@ -883,7 +912,7 @@ load_pdump (int argc, char **argv) if (result != PDUMPER_LOAD_SUCCESS) fatal ("could not load dump file \"%s\": %s", dump_file, dump_error_to_string (result)); - return; + return emacs_executable; } /* Look for a dump file in the same directory as the executable; it @@ -924,12 +953,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 +972,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) if (!(emacs_executable && *emacs_executable)) { @@ -1006,7 +1041,8 @@ load_pdump (int argc, char **argv) out: xfree (dump_file); - xfree (emacs_executable); + + return emacs_executable; } #endif /* HAVE_PDUMPER */ @@ -1297,6 +1333,7 @@ main (int argc, char **argv) } } init_heap (use_dynamic_heap); + initial_cmdline = GetCommandLine (); #endif #if defined WINDOWSNT || defined HAVE_NTGUI /* Set global variables used to detect Windows version. Do this as @@ -1319,7 +1356,10 @@ main (int argc, char **argv) #ifdef HAVE_PDUMPER if (attempt_load_pdump) - load_pdump (argc, argv); + initial_emacs_executable = load_pdump (argc, argv); +#else + ptrdiff_t bufsize; + initial_emacs_executable = find_emacs_executable (argv[0], &bufsize); #endif argc = maybe_disable_address_randomization (argc, argv); @@ -1379,58 +1419,45 @@ main (int argc, char **argv) should be explicitly recognized, ignored, and removed from 'command-line-args-left' in 'command-line-1'. */ + bool only_version = false; sort_args (argc, argv); argc = 0; while (argv[argc]) argc++; skip_args = 0; if (argmatch (argv, argc, "-version", "--version", 3, NULL, &skip_args)) + only_version = true; + +#ifdef HAVE_PDUMPER + if (argmatch (argv, argc, "-fingerprint", "--fingerprint", 4, + NULL, &skip_args) + && !only_version) { - const char *version, *copyright; if (initialized) - { - Lisp_Object tem, tem2; - tem = Fsymbol_value (intern_c_string ("emacs-version")); - tem2 = Fsymbol_value (intern_c_string ("emacs-copyright")); - if (!STRINGP (tem)) - { - fputs ("Invalid value of 'emacs-version'\n", stderr); - exit (1); - } - if (!STRINGP (tem2)) - { - fputs ("Invalid value of 'emacs-copyright'\n", stderr); - exit (1); - } - else - { - version = SSDATA (tem); - copyright = SSDATA (tem2); - } - } + { + dump_fingerprint (stdout, "", + (unsigned char *) fingerprint); + exit (0); + } else - { - version = emacs_version; - copyright = emacs_copyright; - } - printf (("%s %s\n" - "%s\n" - "%s comes with ABSOLUTELY NO WARRANTY.\n" - "You may redistribute copies of %s\n" - "under the terms of the GNU General Public License.\n" - "For more information about these matters, " - "see the file named COPYING.\n"), - PACKAGE_NAME, version, copyright, PACKAGE_NAME, PACKAGE_NAME); - exit (0); + { + fputs ("Not initialized\n", stderr); + exit (1); + } } +#endif emacs_wd = emacs_get_current_dir_name (); +#ifdef WINDOWSNT + initial_wd = emacs_wd; +#endif #ifdef HAVE_PDUMPER if (dumped_with_pdumper_p ()) pdumper_record_wd (emacs_wd); #endif - if (argmatch (argv, argc, "-chdir", "--chdir", 4, &ch_to_dir, &skip_args)) + if (argmatch (argv, argc, "-chdir", "--chdir", 4, &ch_to_dir, &skip_args) + && !only_version) { #ifdef WINDOWSNT /* argv[] array is kept in its original ANSI codepage encoding, @@ -1556,7 +1583,7 @@ main (int argc, char **argv) inhibit_window_system = 0; /* Handle the -t switch, which specifies filename to use as terminal. */ - while (1) + while (!only_version) { char *term; if (argmatch (argv, argc, "-t", "--terminal", 4, &term, &skip_args)) @@ -1594,7 +1621,8 @@ main (int argc, char **argv) /* Handle the -batch switch, which means don't do interactive display. */ noninteractive = 0; - if (argmatch (argv, argc, "-batch", "--batch", 5, NULL, &skip_args)) + if (argmatch (argv, argc, "-batch", "--batch", 5, NULL, &skip_args) + || only_version) { noninteractive = 1; Vundo_outer_limit = Qnil; @@ -1611,7 +1639,8 @@ main (int argc, char **argv) } /* Handle the --help option, which gives a usage message. */ - if (argmatch (argv, argc, "-help", "--help", 3, NULL, &skip_args)) + if (argmatch (argv, argc, "-help", "--help", 3, NULL, &skip_args) + && !only_version) { int i; printf ("Usage: %s [OPTION-OR-FILENAME]...\n", argv[0]); @@ -1632,20 +1661,27 @@ main (int argc, char **argv) int sockfd = -1; - if (argmatch (argv, argc, "-fg-daemon", "--fg-daemon", 10, NULL, &skip_args) - || argmatch (argv, argc, "-fg-daemon", "--fg-daemon", 10, &dname_arg, &skip_args)) - { - daemon_type = 1; /* foreground */ - } - else if (argmatch (argv, argc, "-daemon", "--daemon", 5, NULL, &skip_args) - || argmatch (argv, argc, "-daemon", "--daemon", 5, &dname_arg, &skip_args) - || argmatch (argv, argc, "-bg-daemon", "--bg-daemon", 10, NULL, &skip_args) - || argmatch (argv, argc, "-bg-daemon", "--bg-daemon", 10, &dname_arg, &skip_args)) + if (!only_version) { - daemon_type = 2; /* background */ + if (argmatch (argv, argc, "-fg-daemon", "--fg-daemon", 10, NULL, + &skip_args) + || argmatch (argv, argc, "-fg-daemon", "--fg-daemon", 10, &dname_arg, + &skip_args)) + { + daemon_type = 1; /* foreground */ + } + else if (argmatch (argv, argc, "-daemon", "--daemon", 5, NULL, &skip_args) + || argmatch (argv, argc, "-daemon", "--daemon", 5, &dname_arg, + &skip_args) + || argmatch (argv, argc, "-bg-daemon", "--bg-daemon", 10, NULL, + &skip_args) + || argmatch (argv, argc, "-bg-daemon", "--bg-daemon", 10, + &dname_arg, &skip_args)) + { + daemon_type = 2; /* background */ + } } - if (daemon_type > 0) { #ifndef DOS_NT @@ -1694,12 +1730,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) { @@ -1881,14 +1930,9 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem init_bignum (); init_threads (); init_eval (); - init_atimer (); running_asynch_code = 0; init_random (); - -#ifdef HAVE_PDUMPER - if (dumped_with_pdumper_p ()) - init_xfaces (); -#endif + init_xfaces (); #if defined HAVE_JSON && !defined WINDOWSNT init_json (); @@ -1897,6 +1941,11 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem if (!initialized) syms_of_comp (); + /* Do less garbage collection in batch mode (since these tend to be + more short-lived, and the memory is returned to the OS on exit + anyway). */ + Vgc_cons_percentage = make_float (noninteractive? 1.0: 0.1); + no_loadup = argmatch (argv, argc, "-nl", "--no-loadup", 6, NULL, &skip_args); @@ -1910,7 +1959,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem bool module_assertions = argmatch (argv, argc, "-module-assertions", "--module-assertions", 15, NULL, &skip_args); - if (will_dump_p () && module_assertions) + if (will_dump_p () && module_assertions && !only_version) { fputs ("Module assertions are not supported during dumping\n", stderr); exit (1); @@ -1958,7 +2007,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem int count_before = skip_args; /* Skip any number of -d options, but only use the last one. */ - while (1) + while (!only_version) { int count_before_this = skip_args; @@ -1994,6 +2043,16 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem no_site_lisp = 1; } + if (argmatch (argv, argc, "-x", 0, 1, &junk, &skip_args)) + { + noninteractive = 1; + no_site_lisp = 1; + /* This is picked up in startup.el. */ + argv[skip_args - 1] = (char *) "-scripteval"; + skip_args -= 1; + sort_args (argc, argv); + } + /* Don't actually discard this arg. */ skip_args = count_before; } @@ -2043,6 +2102,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 @@ -2087,6 +2149,72 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem init_callproc (); /* Must follow init_cmdargs but not init_sys_modes. */ init_fileio (); init_lread (); + + /* If "-version" was specified, produce version information and + exit. We do it here because the code below needs to call Lisp + primitives, which cannot be done safely before we call all the + init_FOO initialization functions above. */ + if (only_version) + { + const char *version, *copyright; + + if (initialized) + { + Lisp_Object tem = Fsymbol_value (intern_c_string ("emacs-version")); + Lisp_Object tem2 = Fsymbol_value (intern_c_string ("emacs-copyright")); + if (!STRINGP (tem)) + { + fputs ("Invalid value of 'emacs-version'\n", stderr); + exit (1); + } + if (!STRINGP (tem2)) + { + fputs ("Invalid value of 'emacs-copyright'\n", stderr); + exit (1); + } + else + { + version = SSDATA (tem); + copyright = SSDATA (tem2); + } + } + else + { + version = emacs_version; + copyright = emacs_copyright; + } + printf ("%s %s\n", PACKAGE_NAME, version); + + if (initialized) + { + Lisp_Object rversion, rbranch, rtime; + + rversion + = Fsymbol_value (intern_c_string ("emacs-repository-version")); + rbranch + = Fsymbol_value (intern_c_string ("emacs-repository-branch")); + rtime + = Fsymbol_value (intern_c_string ("emacs-build-time")); + + if (!NILP (rversion) && !NILP (rbranch) && !NILP (rtime)) + printf ("Development version %s on %s branch; build date %s.\n", + SSDATA (Fsubstring (rversion, make_fixnum (0), + make_fixnum (12))), + SSDATA (rbranch), + SSDATA (Fformat_time_string (build_string ("%Y-%m-%d"), + rtime, Qnil))); + } + + printf (("%s\n" + "%s comes with ABSOLUTELY NO WARRANTY.\n" + "You may redistribute copies of %s\n" + "under the terms of the GNU General Public License.\n" + "For more information about these matters, " + "see the file named COPYING.\n"), + copyright, PACKAGE_NAME, PACKAGE_NAME); + exit (0); + } + #ifdef WINDOWSNT /* Check to see if Emacs has been installed correctly. */ check_windows_init_file (); @@ -2153,6 +2281,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 (); @@ -2214,6 +2343,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 @@ -2270,6 +2420,10 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem #endif } +#ifdef HAVE_HAIKU + init_haiku_select (); +#endif + init_charset (); /* This calls putenv and so must precede init_process_emacs. */ @@ -2281,7 +2435,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 @@ -2353,6 +2507,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 (); @@ -2375,6 +2534,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 }, @@ -2398,8 +2560,10 @@ static const struct standard_args standard_args[] = /* (Note that to imply -nsl, -Q is partially handled here.) */ { "-Q", "--quick", 55, 0 }, { "-quick", 0, 55, 0 }, + { "-x", 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 }, @@ -2647,24 +2811,47 @@ sort_args (int argc, char **argv) xfree (priority); } -DEFUN ("kill-emacs", Fkill_emacs, Skill_emacs, 0, 1, "P", +DEFUN ("kill-emacs", Fkill_emacs, Skill_emacs, 0, 2, "P", doc: /* Exit the Emacs job and kill it. If ARG is an integer, return ARG as the exit program code. If ARG is a string, stuff it as keyboard input. Any other value of ARG, or ARG omitted, means return an exit code that indicates successful program termination. +If RESTART is non-nil, instead of just exiting at the end, start a new +Emacs process, using the same command line arguments as the currently +running Emacs process. + This function is called upon receipt of the signals SIGTERM or SIGHUP, and upon SIGINT in batch mode. -The value of `kill-emacs-hook', if not void, -is a list of functions (of no args), -all of which are called before Emacs is actually killed. */ +The value of `kill-emacs-hook', if not void, is a list of functions +(of no args), all of which are called before Emacs is actually +killed. */ attributes: noreturn) - (Lisp_Object arg) + (Lisp_Object arg, Lisp_Object restart) { int exit_code; +#ifndef WINDOWSNT + /* Do some checking before shutting down Emacs, because errors + can't be meaningfully reported afterwards. */ + if (!NILP (restart)) + { + /* This is very unlikely, but it's possible to execute a binary + (on some systems) with no argv. */ + if (initial_argc < 1) + error ("No command line arguments known; unable to re-execute Emacs"); + + /* Check that the binary hasn't gone away. */ + if (!initial_emacs_executable) + error ("Unknown Emacs executable"); + + if (!file_access_p (initial_emacs_executable, F_OK)) + error ("Emacs executable \"%s\" can't be found", initial_argv[0]); + } +#endif + #ifdef HAVE_LIBSYSTEMD /* Notify systemd we are shutting down, but only if we have notified it about startup. */ @@ -2708,6 +2895,17 @@ all of which are called before Emacs is actually killed. */ eln_load_path_final_clean_up (); #endif + if (!NILP (restart)) + { +#ifdef WINDOWSNT + if (w32_reexec_emacs (initial_cmdline, initial_wd) < 0) +#else + initial_argv[0] = initial_emacs_executable; + if (execvp (*initial_argv, initial_argv) < 1) +#endif + emacs_perror ("Unable to re-execute Emacs"); + } + if (FIXNUMP (arg)) exit_code = (XFIXNUM (arg) < 0 ? XFIXNUM (arg) | INT_MIN @@ -2747,6 +2945,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))]; @@ -2788,6 +2990,10 @@ shut_down_emacs (int sig, Lisp_Object stuff) check_message_stack (); } +#ifdef HAVE_NATIVE_COMP + eln_load_path_final_clean_up (); +#endif + #ifdef MSDOS dos_cleanup (); #endif @@ -2821,7 +3027,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 (); @@ -2994,6 +3200,9 @@ decode_env_path (const char *evarname, const char *defalt, bool empty) { const char *path, *p; Lisp_Object lpath, element, tem; +#ifdef NS_SELF_CONTAINED + void *autorelease = NULL; +#endif /* Default is to use "." for empty path elements. But if argument EMPTY is true, use nil instead. */ Lisp_Object empty_element = empty ? Qnil : build_string ("."); @@ -3021,6 +3230,8 @@ decode_env_path (const char *evarname, const char *defalt, bool empty) if (!path) { #ifdef NS_SELF_CONTAINED + /* ns_relocate needs a valid autorelease pool around it. */ + autorelease = ns_alloc_autorelease_pool (); path = ns_relocate (defalt); #else path = defalt; @@ -3123,6 +3334,11 @@ decode_env_path (const char *evarname, const char *defalt, bool empty) else break; } + +#ifdef NS_SELF_CONTAINED + if (autorelease) + ns_release_autorelease_pool (autorelease); +#endif return Fnreverse (lpath); } @@ -3239,6 +3455,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..141d2546f08 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; @@ -749,7 +707,7 @@ DEFUN ("default-toplevel-value", Fdefault_toplevel_value, Sdefault_toplevel_valu union specbinding *binding = default_toplevel_binding (symbol); Lisp_Object value = binding ? specpdl_old_value (binding) : Fdefault_value (symbol); - if (!EQ (value, Qunbound)) + if (!BASE_EQ (value, Qunbound)) return value; xsignal1 (Qvoid_variable, symbol); } @@ -783,7 +741,9 @@ value. */) and where the `foo` package only gets loaded when <foo-function> is called, so the outer `let` incorrectly made the binding lexical because the <foo-var> wasn't yet declared as dynamic at that point. */ - error ("Defining as dynamic an already lexical var"); + xsignal2 (Qerror, + build_string ("Defining as dynamic an already lexical var"), + symbol); XSYMBOL (symbol)->u.s.declared_special = true; if (!NILP (doc)) @@ -796,6 +756,33 @@ value. */) return Qnil; } +static Lisp_Object +defvar (Lisp_Object sym, Lisp_Object initvalue, Lisp_Object docstring, bool eval) +{ + Lisp_Object tem; + + CHECK_SYMBOL (sym); + + tem = Fdefault_boundp (sym); + + /* Do it before evaluating the initial value, for self-references. */ + Finternal__define_uninitialized_variable (sym, docstring); + + if (NILP (tem)) + Fset_default (sym, eval ? eval_sub (initvalue) : initvalue); + else + { /* Check if there is really a global binding rather than just a let + binding that shadows the global unboundness of the var. */ + union specbinding *binding = default_toplevel_binding (sym); + if (binding && BASE_EQ (specpdl_old_value (binding), Qunbound)) + { + set_specpdl_old_value (binding, + eval ? eval_sub (initvalue) : initvalue); + } + } + return sym; +} + DEFUN ("defvar", Fdefvar, Sdefvar, 1, UNEVALLED, 0, doc: /* Define SYMBOL as a variable, and return SYMBOL. You are not required to define a variable in order to use it, but @@ -810,12 +797,10 @@ value. If SYMBOL is buffer-local, its default value is what is set; buffer-local values are not affected. If INITVALUE is missing, SYMBOL's value is not set. -If SYMBOL has a local binding, then this form affects the local -binding. This is usually not what you want. Thus, if you need to -load a file defining variables, with this form or with `defconst' or -`defcustom', you should always load that file _outside_ any bindings -for these variables. (`defconst' and `defcustom' behave similarly in -this respect.) +If SYMBOL is let-bound, then this form does not affect the local let +binding but the toplevel default binding instead, like +`set-toplevel-default-binding`. +(`defcustom' behaves similarly in this respect.) The optional argument DOCSTRING is a documentation string for the variable. @@ -826,7 +811,7 @@ To define a buffer-local variable, use `defvar-local'. usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) (Lisp_Object args) { - Lisp_Object sym, tem, tail; + Lisp_Object sym, tail; sym = XCAR (args); tail = XCDR (args); @@ -838,24 +823,8 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) if (!NILP (XCDR (tail)) && !NILP (XCDR (XCDR (tail)))) error ("Too many arguments"); Lisp_Object exp = XCAR (tail); - - tem = Fdefault_boundp (sym); tail = XCDR (tail); - - /* Do it before evaluating the initial value, for self-references. */ - Finternal__define_uninitialized_variable (sym, CAR (tail)); - - if (NILP (tem)) - Fset_default (sym, eval_sub (exp)); - else - { /* Check if there is really a global binding rather than just a let - binding that shadows the global unboundness of the var. */ - union specbinding *binding = default_toplevel_binding (sym); - if (binding && EQ (specpdl_old_value (binding), Qunbound)) - { - set_specpdl_old_value (binding, eval_sub (exp)); - } - } + return defvar (sym, exp, CAR (tail), true); } else if (!NILP (Vinternal_interpreter_environment) && (SYMBOLP (sym) && !XSYMBOL (sym)->u.s.declared_special)) @@ -874,6 +843,14 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) return sym; } +DEFUN ("defvar-1", Fdefvar_1, Sdefvar_1, 2, 3, 0, + doc: /* Like `defvar' but as a function. +More specifically behaves like (defvar SYM 'INITVALUE DOCSTRING). */) + (Lisp_Object sym, Lisp_Object initvalue, Lisp_Object docstring) +{ + return defvar (sym, initvalue, docstring, false); +} + DEFUN ("defconst", Fdefconst, Sdefconst, 2, UNEVALLED, 0, doc: /* Define SYMBOL as a constant variable. This declares that neither programs nor users should ever change the @@ -903,9 +880,18 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */) error ("Too many arguments"); docstring = XCAR (XCDR (XCDR (args))); } + tem = eval_sub (XCAR (XCDR (args))); + return Fdefconst_1 (sym, tem, docstring); +} +DEFUN ("defconst-1", Fdefconst_1, Sdefconst_1, 2, 3, 0, + doc: /* Like `defconst' but as a function. +More specifically, behaves like (defconst SYM 'INITVALUE DOCSTRING). */) + (Lisp_Object sym, Lisp_Object initvalue, Lisp_Object docstring) +{ + CHECK_SYMBOL (sym); + Lisp_Object tem = initvalue; Finternal__define_uninitialized_variable (sym, docstring); - tem = eval_sub (XCAR (XCDR (args))); if (!NILP (Vpurify_flag)) tem = Fpurecopy (tem); Fset_default (sym, tem); /* FIXME: set-default-toplevel-value? */ @@ -935,7 +921,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 +981,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 +1061,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. @@ -1224,6 +1251,13 @@ unwind_to_catch (struct handler *catch, enum nonlocal_exit type, set_poll_suppress_count (catch->poll_suppress_count); unblock_input_to (catch->interrupt_input_blocked); +#ifdef HAVE_X_WINDOWS + /* Restore the X error handler stack. This is important because + otherwise a display disconnect won't unwind the stack of error + traps to the right depth. */ + x_unwind_errors_to (catch->x_error_handler_depth); +#endif + do { /* Unwind the specpdl stack, and then restore the proper set of @@ -1238,6 +1272,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 +1306,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)); @@ -1341,7 +1376,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, && (SYMBOLP (XCAR (tem)) || CONSP (XCAR (tem)))))) error ("Invalid condition handler: %s", - SDATA (Fprin1_to_string (tem, Qt))); + SDATA (Fprin1_to_string (tem, Qt, Qnil))); if (CONSP (tem) && EQ (XCAR (tem), QCsuccess)) success_handler = XCDR (tem); else @@ -1395,7 +1430,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 +1451,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 +1540,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,8 +1629,12 @@ 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; +#ifdef HAVE_X_WINDOWS + c->x_error_handler_depth = x_error_message_count; +#endif handlerlist = c; return c; } @@ -1696,27 +1651,14 @@ process_quit_flag (void) Lisp_Object flag = Vquit_flag; Vquit_flag = Qnil; if (EQ (flag, Qkill_emacs)) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); if (EQ (Vthrow_on_input, flag)) Fthrow (Vthrow_on_input, Qt); 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 +1731,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 +1794,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); } @@ -2125,8 +2070,7 @@ then strings and vectors are not accepted. */) (Lisp_Object function, Lisp_Object for_call_interactively) { register Lisp_Object fun; - register Lisp_Object funcar; - Lisp_Object if_prop = Qnil; + bool genfun = false; /* If true, we should consult `interactive-form'. */ fun = function; @@ -2134,52 +2078,89 @@ then strings and vectors are not accepted. */) if (NILP (fun)) return Qnil; - /* Check an `interactive-form' property if present, analogous to the - function-documentation property. */ - fun = function; - while (SYMBOLP (fun)) - { - Lisp_Object tmp = Fget (fun, Qinteractive_form); - if (!NILP (tmp)) - if_prop = Qt; - fun = Fsymbol_function (fun); - } - /* Emacs primitives are interactive if their DEFUN specifies an interactive spec. */ if (SUBRP (fun)) - return XSUBR (fun)->intspec ? Qt : if_prop; - + { + if (XSUBR (fun)->intspec.string) + return Qt; + } /* Bytecode objects are interactive if they are long enough to have an element whose index is COMPILED_INTERACTIVE, which is where the interactive spec is stored. */ else if (COMPILEDP (fun)) - return (PVSIZE (fun) > COMPILED_INTERACTIVE ? Qt : if_prop); + { + if (PVSIZE (fun) > COMPILED_INTERACTIVE) + return Qt; + else if (PVSIZE (fun) > COMPILED_DOC_STRING) + { + Lisp_Object doc = AREF (fun, COMPILED_DOC_STRING); + /* An invalid "docstring" is a sign that we have an OClosure. */ + genfun = !(NILP (doc) || VALID_DOCSTRING_P (doc)); + } + } #ifdef HAVE_MODULES /* Module functions are interactive if their `interactive_form' field is non-nil. */ else if (MODULE_FUNCTIONP (fun)) - return NILP (module_function_interactive_form (XMODULE_FUNCTION (fun))) - ? if_prop - : Qt; + { + if (!NILP (module_function_interactive_form (XMODULE_FUNCTION (fun)))) + return Qt; + } #endif /* Strings and vectors are keyboard macros. */ - if (STRINGP (fun) || VECTORP (fun)) + else if (STRINGP (fun) || VECTORP (fun)) return (NILP (for_call_interactively) ? Qt : Qnil); /* Lists may represent commands. */ - if (!CONSP (fun)) + else if (!CONSP (fun)) return Qnil; - funcar = XCAR (fun); - if (EQ (funcar, Qclosure)) - return (!NILP (Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))))) - ? Qt : if_prop); - else if (EQ (funcar, Qlambda)) - return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop; - else if (EQ (funcar, Qautoload)) - return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop; + else + { + Lisp_Object funcar = XCAR (fun); + if (EQ (funcar, Qautoload)) + { + if (!NILP (Fcar (Fcdr (Fcdr (XCDR (fun)))))) + return Qt; + } + else + { + Lisp_Object body = CDR_SAFE (XCDR (fun)); + if (EQ (funcar, Qclosure)) + body = CDR_SAFE (body); + else if (!EQ (funcar, Qlambda)) + return Qnil; + if (!NILP (Fassq (Qinteractive, body))) + return Qt; + else if (VALID_DOCSTRING_P (CAR_SAFE (body))) + /* A "docstring" is a sign that we may have an OClosure. */ + genfun = true; + } + } + + /* By now, if it's not a function we already returned nil. */ + + /* Check an `interactive-form' property if present, analogous to the + function-documentation property. */ + fun = function; + while (SYMBOLP (fun)) + { + Lisp_Object tmp = Fget (fun, Qinteractive_form); + if (!NILP (tmp)) + error ("Found an 'interactive-form' property!"); + fun = Fsymbol_function (fun); + } + + /* If there's no immediate interactive form but it's an OClosure, + then delegate to the generic-function in case it has + a type-specific interactive-form. */ + if (genfun) + { + Lisp_Object iform = call1 (Qinteractive_form, fun); + return NILP (iform) ? Qnil : Qt; + } else return Qnil; } @@ -2214,7 +2195,7 @@ this does nothing and returns nil. */) && !AUTOLOADP (XSYMBOL (function)->u.s.function)) return Qnil; - if (!NILP (Vpurify_flag) && EQ (docstring, make_fixnum (0))) + if (!NILP (Vpurify_flag) && BASE_EQ (docstring, make_fixnum (0))) /* `read1' in lread.c has found the docstring starting with "\ and assumed the docstring will be provided by Snarf-documentation, so it passed us 0 instead. But that leads to accidental sharing in purecopy's @@ -2225,28 +2206,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) && BASE_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 +2262,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; @@ -2272,31 +2273,22 @@ it defines a macro. */) /* This is to make sure that loadup.el gives a clear picture of what files are preloaded and when. */ if (will_dump_p () && !will_bootstrap_p ()) - error ("Attempt to autoload %s while preparing to dump", - SDATA (SYMBOL_NAME (funname))); + { + /* Avoid landing here recursively while outputting the + backtrace from the error. */ + gflags.will_dump_ = false; + error ("Attempt to autoload %s while preparing to dump", + SDATA (SYMBOL_NAME (funname))); + } 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 +2313,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 +2371,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 +2379,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 +2428,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 +2450,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 +2522,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 +2554,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--; @@ -2794,7 +2770,7 @@ run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args, sym = args[0]; val = find_symbol_value (sym); - if (EQ (val, Qunbound) || NILP (val)) + if (BASE_EQ (val, Qunbound) || NILP (val)) return ret; else if (!CONSP (val) || FUNCTIONP (val)) { @@ -2869,78 +2845,14 @@ 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); -} +DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, + doc: /* Return t if OBJECT is a function. -/* 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); -} +An object is a function if it is callable via `funcall'; this includes +symbols with function bindings, but excludes macros and special forms. -DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, - doc: /* Return t if OBJECT is a function. */) +Ordinarily return nil if OBJECT is not a function, although t might be +returned in rare cases. */) (Lisp_Object object) { if (FUNCTIONP (object)) @@ -2979,74 +2891,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 +2971,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 +3063,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 +3085,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 +3110,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 +3203,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 +3354,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 +3445,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,10 +3454,9 @@ 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 ()))); + || (BASE_EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ()))); if (sym->u.s.redirect == SYMBOL_LOCALIZED) { @@ -3582,22 +3471,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 +3511,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 +3568,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 +3603,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 +3668,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 +3680,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 +3691,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 +3730,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 +3885,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 +3909,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 +3919,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 +3928,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 +3950,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 +3966,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 +4070,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 +4128,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 +4237,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 +4292,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. @@ -4503,14 +4374,17 @@ alist of active lexical bindings. */); defsubr (&Sdefault_toplevel_value); defsubr (&Sset_default_toplevel_value); defsubr (&Sdefvar); + defsubr (&Sdefvar_1); defsubr (&Sdefvaralias); DEFSYM (Qdefvaralias, "defvaralias"); defsubr (&Sdefconst); + defsubr (&Sdefconst_1); defsubr (&Sinternal__define_uninitialized_variable); defsubr (&Smake_var_non_special); defsubr (&Slet); defsubr (&SletX); defsubr (&Swhile); + defsubr (&Sfuncall_with_delayed_message); defsubr (&Smacroexpand); defsubr (&Scatch); defsubr (&Sthrow); @@ -4539,5 +4413,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 481001b423b..9697f6c8cf1 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)); } @@ -704,20 +708,20 @@ This function does not grok magic file names. */) memset (data + prefix_len, 'X', nX); memcpy (data + prefix_len + nX, SSDATA (encoded_suffix), suffix_len); int kind = (NILP (dir_flag) ? GT_FILE - : EQ (dir_flag, make_fixnum (0)) ? GT_NOCREATE + : BASE_EQ (dir_flag, make_fixnum (0)) ? GT_NOCREATE : GT_DIR); int fd = gen_tempname (data, suffix_len, O_BINARY | O_CLOEXEC, kind); 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. */ @@ -2593,9 +2601,9 @@ is case-insensitive. */) if (err <= 0) return err < 0 ? Qt : Qnil; Lisp_Object parent = file_name_directory (filename); - /* Avoid infinite loop if the root has trouble - (impossible?). */ - if (!NILP (Fstring_equal (parent, filename))) + /* Avoid infinite loop if the root has trouble (if that's even possible). + Without a parent, we just don't know and return nil as well. */ + if (!STRINGP (parent) || !NILP (Fstring_equal (parent, filename))) return Qnil; filename = parent; } @@ -2710,11 +2718,25 @@ This is what happens in interactive use with M-x. */) : Qnil); if (!NILP (symlink_target)) Fmake_symbolic_link (symlink_target, newname, ok_if_already_exists); + else if (S_ISFIFO (file_st.st_mode)) + { + /* If it's a FIFO, calling `copy-file' will hang if it's a + inter-file system move, so do it here. (It will signal + an error in that case, but it won't hang in any case.) */ + if (!NILP (ok_if_already_exists)) + barf_or_query_if_file_exists (newname, false, + "rename to it", + FIXNUMP (ok_if_already_exists), + false); + if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) != 0) + report_file_errno ("Renaming", list2 (file, newname), errno); + return Qnil; + } else 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); @@ -3834,7 +3856,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; @@ -3877,6 +3899,10 @@ The optional third and fourth arguments BEG and END specify what portion of the file to insert. These arguments count bytes in the file, not characters in the buffer. If VISIT is non-nil, BEG and END must be nil. +When inserting data from a special file (e.g., /dev/urandom), you +can't specify VISIT or BEG, and END should be specified to avoid +inserting unlimited data into the buffer. + If optional fifth argument REPLACE is non-nil, replace the current buffer contents (in the accessible portion) with the file contents. This is better than simply deleting and inserting the whole thing @@ -3900,11 +3926,11 @@ 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; - bool not_regular = 0; + bool regular = true; int save_errno = 0; char read_buf[READ_BUF_SIZE]; struct coding_system coding; @@ -3919,7 +3945,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. */ @@ -3928,6 +3953,7 @@ by calling `format-decode', which see. */) /* SAME_AT_END_CHARPOS counts characters, because restore_window_points needs the old character count. */ ptrdiff_t same_at_end_charpos = ZV; + bool seekable = true; if (current_buffer->base_buffer && ! NILP (visit)) error ("Cannot do file visiting in an indirect buffer"); @@ -3981,7 +4007,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. */ @@ -4001,7 +4027,8 @@ by calling `format-decode', which see. */) least signal an error. */ if (!S_ISREG (st.st_mode)) { - not_regular = 1; + regular = false; + seekable = lseek (fd, 0, SEEK_CUR) < 0; if (! NILP (visit)) { @@ -4009,7 +4036,12 @@ by calling `format-decode', which see. */) goto notfound; } - if (! NILP (replace) || ! NILP (beg) || ! NILP (end)) + if (!NILP (beg) && !seekable) + xsignal2 (Qfile_error, + build_string ("cannot use a start position in a non-seekable file/device"), + orig_filename); + + if (!NILP (replace)) xsignal2 (Qfile_error, build_string ("not a regular file"), orig_filename); } @@ -4031,7 +4063,7 @@ by calling `format-decode', which see. */) end_offset = file_offset (end); else { - if (not_regular) + if (!regular) end_offset = TYPE_MAXIMUM (off_t); else { @@ -4053,7 +4085,7 @@ by calling `format-decode', which see. */) /* Check now whether the buffer will become too large, in the likely case where the file's length is not changing. This saves a lot of needless work before a buffer overflow. */ - if (! not_regular) + if (regular) { /* The likely offset where we will stop reading. We could read more (or less), if the file grows (or shrinks) as we read it. */ @@ -4091,7 +4123,7 @@ by calling `format-decode', which see. */) { /* Don't try looking inside a file for a coding system specification if it is not seekable. */ - if (! not_regular && ! NILP (Vset_auto_coding_function)) + if (regular && !NILP (Vset_auto_coding_function)) { /* Find a coding system specified in the heading two lines or in the tailing several lines of the file. @@ -4324,7 +4356,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. */ @@ -4395,7 +4427,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; @@ -4553,7 +4585,7 @@ by calling `format-decode', which see. */) goto handled; } - if (! not_regular) + if (seekable || !NILP (end)) total = end_offset - beg_offset; else /* For a special file, all we can do is guess. */ @@ -4599,7 +4631,7 @@ by calling `format-decode', which see. */) ptrdiff_t trytry = min (total - how_much, READ_BUF_SIZE); ptrdiff_t this; - if (not_regular) + if (!seekable && NILP (end)) { Lisp_Object nbytes; @@ -4650,7 +4682,7 @@ by calling `format-decode', which see. */) For a special file, where TOTAL is just a buffer size, so don't bother counting in HOW_MUCH. (INSERTED is where we count the number of characters inserted.) */ - if (! not_regular) + if (seekable || !NILP (end)) how_much += this; inserted += this; } @@ -4701,7 +4733,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); @@ -4828,7 +4860,7 @@ by calling `format-decode', which see. */) Funlock_file (BVAR (current_buffer, file_truename)); Funlock_file (filename); } - if (not_regular) + if (!regular) xsignal2 (Qfile_error, build_string ("not a regular file"), orig_filename); } @@ -4852,7 +4884,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); @@ -5183,8 +5215,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; @@ -5387,7 +5419,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 @@ -5517,7 +5549,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 @@ -5797,6 +5832,15 @@ See Info node `(elisp)Modification Time' for more details. */) return Qnil; } +Lisp_Object +buffer_visited_file_modtime (struct buffer *buf) +{ + int ns = buf->modtime.tv_nsec; + if (ns < 0) + return make_fixnum (UNKNOWN_MODTIME_NSECS - ns); + return make_lisp_time (buf->modtime); +} + DEFUN ("visited-file-modtime", Fvisited_file_modtime, Svisited_file_modtime, 0, 0, 0, doc: /* Return the current buffer's recorded visited file modification time. @@ -5806,10 +5850,7 @@ visited file doesn't exist. See Info node `(elisp)Modification Time' for more details. */) (void) { - int ns = current_buffer->modtime.tv_nsec; - if (ns < 0) - return make_fixnum (UNKNOWN_MODTIME_NSECS - ns); - return make_lisp_time (current_buffer->modtime); + return buffer_visited_file_modtime (current_buffer); } DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, @@ -5836,6 +5877,8 @@ in `current-time' or an integer flag as returned by `visited-file-modtime'. */) current_buffer->modtime = mtime; current_buffer->modtime_size = -1; } + else if (current_buffer->base_buffer) + error ("An indirect buffer does not have a visited file"); else { register Lisp_Object filename; @@ -5949,14 +5992,19 @@ do_auto_save_eh (Lisp_Object ignore) DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "", doc: /* Auto-save all buffers that need it. -This is all buffers that have auto-saving enabled -and are changed since last auto-saved. -Auto-saving writes the buffer into a file -so that your editing is not lost if the system crashes. -This file is not the file you visited; that changes only when you save. +This auto-saves all buffers that have auto-saving enabled and +were changed since last auto-saved. + +Auto-saving writes the buffer into a file so that your edits are +not lost if the system crashes. + +The auto-save file is not the file you visited; that changes only +when you save. + Normally, run the normal hook `auto-save-hook' before saving. A non-nil NO-MESSAGE argument means do not print any message if successful. + A non-nil CURRENT-ONLY argument means save only current buffer. */) (Lisp_Object no_message, Lisp_Object current_only) { @@ -5966,12 +6014,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; @@ -6195,7 +6244,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 @@ -6381,6 +6430,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"); @@ -6439,6 +6489,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 25b35feb02b..a657cc4582c 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 @@ -419,6 +419,13 @@ lock_file_1 (Lisp_Object lfname, bool force) Lisp_Object luser_name = Fuser_login_name (Qnil); Lisp_Object lhost_name = Fsystem_name (); + /* Protect against the extremely unlikely case of the host name + containing an @ character. */ + if (!NILP (lhost_name) && strchr (SSDATA (lhost_name), '@')) + lhost_name = CALLN (Ffuncall, intern ("string-replace"), + build_string ("@"), build_string ("-"), + lhost_name); + char const *user_name = STRINGP (luser_name) ? SSDATA (luser_name) : ""; char const *host_name = STRINGP (lhost_name) ? SSDATA (lhost_name) : ""; char lock_info_str[MAX_LFINFO + 1]; @@ -489,15 +496,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, Lisp_Object lfname) { - int ret; lock_info_type local_owner; ptrdiff_t lfinfolen; intmax_t pid, boot_time; @@ -563,20 +584,31 @@ current_lock_owner (lock_info_type *owner, Lisp_Object 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 (""); + /* Protect against the extremely unlikely case of the host name + containing an @ character. */ + else if (strchr (SSDATA (system_name), '@')) + system_name = CALLN (Ffuncall, intern ("string-replace"), + build_string ("@"), build_string ("-"), + system_name); + /* On current host? */ if (STRINGP (system_name) && dot - (at + 1) == SBYTES (system_name) && memcmp (at + 1, SSDATA (system_name), SBYTES (system_name)) == 0) { if (pid == getpid ()) - 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 @@ -585,18 +617,16 @@ current_lock_owner (lock_info_type *owner, Lisp_Object 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, Lisp_Object lfname) @@ -605,14 +635,14 @@ lock_if_free (lock_info_type *clasher, Lisp_Object 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; @@ -672,15 +702,15 @@ lock_file (Lisp_Object fn) if (!NILP (subject_buf) && NILP (Fverify_visited_file_modtime (subject_buf)) && !NILP (Ffile_exists_p (fn)) - && !(!NILP (lfname) && current_lock_owner (NULL, lfname) == -2)) + && !(!NILP (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. */ if (!NILP (lfname)) { /* 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) + lock_if_free returns an errno value. */ + if (lock_if_free (&lock_info, lfname) == ANOTHER_OWNS_IT) { /* Someone else has the lock. Consider breaking it. */ Lisp_Object attack; @@ -709,9 +739,9 @@ unlock_file (Lisp_Object fn) return Qnil; int err = current_lock_owner (0, lfname); - if (err == -2 && unlink (SSDATA (lfname)) != 0 && errno != ENOENT) - err = errno; - if (0 < err) + if (! (err == 0 || err == ANOTHER_OWNS_IT + || (err == I_OWN_IT + && (unlink (SSDATA (lfname)) == 0 || (err = errno) == ENOENT)))) report_file_errno ("Unlocking file", fn, err); return Qnil; @@ -860,8 +890,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); } @@ -879,8 +911,8 @@ syms_of_filelock (void) DEFVAR_BOOL ("create-lockfiles", create_lockfiles, doc: /* Non-nil means use lockfiles to avoid editing collisions. -The name of the (per-buffer) lockfile is constructed by prepending a -'.#' to the name of the file being locked. See also `lock-buffer' and +The name of the (per-buffer) lockfile is constructed by prepending +".#" to the name of the file being locked. See also `lock-buffer' and Info node `(emacs)Interlocking'. */); create_lockfiles = true; diff --git a/src/floatfns.c b/src/floatfns.c index 22376846c94..293184c70f1 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -29,14 +29,20 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ C99 and C11 require the following math.h functions in addition to the C89 functions. Of these, Emacs currently exports only the - starred ones to Lisp, since we haven't found a use for the others: - acosh, atanh, cbrt, *copysign, erf, erfc, exp2, expm1, fdim, fma, - fmax, fmin, fpclassify, hypot, ilogb, isfinite, isgreater, - isgreaterequal, isinf, isless, islessequal, islessgreater, *isnan, - isnormal, isunordered, lgamma, log1p, *log2 [via (log X 2)], *logb - (approximately), lrint/llrint, lround/llround, nan, nearbyint, - nextafter, nexttoward, remainder, remquo, *rint, round, scalbln, - scalbn, signbit, tgamma, *trunc. + starred ones to Lisp, since we haven't found a use for the others. + Also, it uses the ones marked "+" internally: + acosh, atanh, cbrt, copysign (implemented by signbit), erf, erfc, + exp2, expm1, fdim, fma, fmax, fmin, fpclassify, hypot, +ilogb, + isfinite, isgreater, isgreaterequal, isinf, isless, islessequal, + islessgreater, *isnan, isnormal, isunordered, lgamma, log1p, *log2 + [via (log X 2)], logb (approximately; implemented by frexp), + +lrint/llrint, +lround/llround, nan, nearbyint, nextafter, + nexttoward, remainder, remquo, *rint, round, scalbln, +scalbn, + +signbit, tgamma, *trunc. + + The C standard also requires functions for float and long double + that are not listed above. Of these functions, Emacs uses only the + following internally: fabsf, powf, sprintf. */ #include <config.h> @@ -347,6 +353,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 b2b209e1e8a..1f57e675b12 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)) + { + EMACS_INT lim = XFIXNUM (limit); + if (lim <= 0) + xsignal1 (Qargs_out_of_range, limit); + return get_random_fixnum (lim); + } + else if (BIGNUMP (limit)) { - if (0 > mpz_sgn (*xbignum_val (limit))) - xsignal2 (Qwrong_type_argument, Qnatnump, limit); - return get_random_bignum (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, @@ -642,19 +589,21 @@ Do NOT use this function to compare file names for equality. */) #endif /* !__STDC_ISO_10646__, !WINDOWSNT */ } -static Lisp_Object concat (ptrdiff_t nargs, Lisp_Object *args, - enum Lisp_Type target_type, bool last_special); +static Lisp_Object concat_to_list (ptrdiff_t nargs, Lisp_Object *args, + Lisp_Object last_tail); +static Lisp_Object concat_to_vector (ptrdiff_t nargs, Lisp_Object *args); +static Lisp_Object concat_to_string (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_to_string (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_to_string (3, ((Lisp_Object []) {s1, s2, s3})); } DEFUN ("append", Fappend, Sappend, 0, MANY, 0, @@ -665,7 +614,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_to_list (nargs - 1, args, args[nargs - 1]); } DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0, @@ -678,7 +629,7 @@ to be `eq'. usage: (concat &rest SEQUENCES) */) (ptrdiff_t nargs, Lisp_Object *args) { - return concat (nargs, args, Lisp_String, 0); + return concat_to_string (nargs, args); } DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0, @@ -688,7 +639,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_to_vector (nargs, args); } @@ -702,16 +653,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,294 +704,370 @@ 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 - a string and has text properties to be copied. */ +/* This structure holds information of an argument of `concat_to_string' + that is a string and has text properties to be copied. */ struct textprop_rec { ptrdiff_t argnum; /* refer to ARGS (arguments of `concat') */ - ptrdiff_t from; /* refer to ARGS[argnum] (argument string) */ ptrdiff_t to; /* refer to VAL (the target string) */ }; static Lisp_Object -concat (ptrdiff_t nargs, Lisp_Object *args, - enum Lisp_Type target_type, bool last_special) +concat_to_string (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 = i; + 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 { - textprops[num_textprops].argnum = argnum; - textprops[num_textprops].from = 0; - textprops[num_textprops++].to = toindex; + /* Copy a single-byte string to a multibyte string. */ + toindex_byte += str_to_multibyte (SDATA (result) + toindex_byte, + SDATA (arg), nchars); } - 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. */ +Lisp_Object +concat_to_list (ptrdiff_t nargs, Lisp_Object *args, Lisp_Object last_tail) +{ + /* Copy the contents of the args into the result. */ + Lisp_Object result = Qnil; + Lisp_Object last = Qnil; /* Last cons in result if nonempty. */ + + for (ptrdiff_t i = 0; i < nargs; i++) + { + Lisp_Object arg = args[i]; + /* List arguments are treated specially since this is the common case. */ + if (CONSP (arg)) + { + Lisp_Object head = Fcons (XCAR (arg), Qnil); + Lisp_Object prev = head; + arg = XCDR (arg); + FOR_EACH_TAIL (arg) + { + Lisp_Object next = Fcons (XCAR (arg), Qnil); + XSETCDR (prev, next); + prev = next; + } + CHECK_LIST_END (arg, arg); + if (NILP (result)) + result = head; + else + XSETCDR (last, head); + last = prev; + } + else if (NILP (arg)) + ; + else if (VECTORP (arg) || STRINGP (arg) + || BOOL_VECTOR_P (arg) || COMPILEDP (arg)) + { + ptrdiff_t arglen = XFIXNUM (Flength (arg)); + ptrdiff_t argindex_byte = 0; + + /* Copy element by element. */ + for (ptrdiff_t argindex = 0; argindex < arglen; argindex++) + { + /* Fetch next element of `arg' arg into `elt', or break if + `arg' is exhausted. */ + Lisp_Object elt; + if (STRINGP (arg)) + { + int c; + if (STRING_MULTIBYTE (arg)) + { + ptrdiff_t char_idx = argindex; + c = fetch_string_char_advance_no_check (arg, &char_idx, + &argindex_byte); + } + else + c = SREF (arg, argindex); + elt = make_fixed_natnum (c); + } + else if (BOOL_VECTOR_P (arg)) + elt = bool_vector_ref (arg, argindex); + else + elt = AREF (arg, argindex); + + /* Store this element into the result. */ + Lisp_Object node = Fcons (elt, Qnil); + if (NILP (result)) + result = node; + else + XSETCDR (last, node); + last = node; + } + } + else + wrong_type_argument (Qsequencep, arg); + } + + if (NILP (result)) + result = last_tail; + else + XSETCDR (last, last_tail); + + return result; +} + +/* Concatenate sequences into a vector. */ +Lisp_Object +concat_to_vector (ptrdiff_t nargs, Lisp_Object *args) +{ + /* 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 (!(VECTORP (arg) || CONSP (arg) || NILP (arg) || STRINGP (arg) + || BOOL_VECTOR_P (arg) || COMPILEDP (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); + } + + /* Create the output vector. */ + Lisp_Object result = make_uninit_vector (result_len); + Lisp_Object *dst = XVECTOR (result)->contents; + + /* Copy the contents of the args into the result. */ + + for (ptrdiff_t i = 0; i < nargs; i++) + { + Lisp_Object arg = args[i]; + if (VECTORP (arg)) + { + ptrdiff_t size = ASIZE (arg); + memcpy (dst, XVECTOR (arg)->contents, size * sizeof *dst); + dst += size; + } + else if (CONSP (arg)) + do + { + *dst++ = XCAR (arg); + arg = XCDR (arg); + } + while (!NILP (arg)); + else if (NILP (arg)) + ; + else if (STRINGP (arg)) + { + ptrdiff_t size = SCHARS (arg); + if (STRING_MULTIBYTE (arg)) + { + ptrdiff_t byte = 0; + for (ptrdiff_t i = 0; i < size;) + { + int c = fetch_string_char_advance_no_check (arg, &i, &byte); + *dst++ = make_fixnum (c); + } + } + else + for (ptrdiff_t i = 0; i < size; i++) + *dst++ = make_fixnum (SREF (arg, i)); + } + else if (BOOL_VECTOR_P (arg)) + { + ptrdiff_t size = bool_vector_size (arg); + for (ptrdiff_t i = 0; i < size; i++) + *dst++ = bool_vector_ref (arg, i); + } + else + { + eassert (COMPILEDP (arg)); + ptrdiff_t size = PVSIZE (arg); + memcpy (dst, XVECTOR (arg)->contents, size * sizeof *dst); + dst += size; + } + } + eassert (dst == XVECTOR (result)->contents + result_len); + + return result; } static Lisp_Object string_char_byte_cache_string; @@ -1036,7 +1095,7 @@ string_char_to_byte (Lisp_Object string, ptrdiff_t char_index) if (best_above == best_above_byte) return char_index; - if (EQ (string, string_char_byte_cache_string)) + if (BASE_EQ (string, string_char_byte_cache_string)) { if (string_char_byte_cache_charpos < char_index) { @@ -1096,7 +1155,7 @@ string_byte_to_char (Lisp_Object string, ptrdiff_t byte_index) if (best_above == best_above_byte) return byte_index; - if (EQ (string, string_char_byte_cache_string)) + if (BASE_EQ (string, string_char_byte_cache_string)) { if (string_char_byte_cache_bytepos < byte_index) { @@ -1145,65 +1204,25 @@ string_byte_to_char (Lisp_Object string, ptrdiff_t byte_index) return i; } -/* Convert STRING to a multibyte string. */ - -static Lisp_Object -string_make_multibyte (Lisp_Object string) -{ - unsigned char *buf; - ptrdiff_t nbytes; - Lisp_Object ret; - USE_SAFE_ALLOCA; - - if (STRING_MULTIBYTE (string)) - return string; - - nbytes = count_size_as_multibyte (SDATA (string), - SCHARS (string)); - /* If all the chars are ASCII, they won't need any more bytes - once converted. In that case, we can return STRING itself. */ - if (nbytes == SBYTES (string)) - return string; - - buf = SAFE_ALLOCA (nbytes); - copy_text (SDATA (string), buf, SBYTES (string), - 0, 1); - - ret = make_multibyte_string ((char *) buf, SCHARS (string), nbytes); - SAFE_FREE (); - - return ret; -} - - /* Convert STRING (if unibyte) to a multibyte string without changing - the number of characters. Characters 0200 through 0237 are - converted to eight-bit characters. */ + the number of characters. Characters 0x80..0xff are interpreted as + raw bytes. */ Lisp_Object string_to_multibyte (Lisp_Object string) { - unsigned char *buf; - ptrdiff_t nbytes; - Lisp_Object ret; - USE_SAFE_ALLOCA; - if (STRING_MULTIBYTE (string)) return string; - nbytes = count_size_as_multibyte (SDATA (string), SBYTES (string)); + ptrdiff_t nchars = SCHARS (string); + ptrdiff_t nbytes = count_size_as_multibyte (SDATA (string), nchars); /* If all the chars are ASCII, they won't need any more bytes once converted. */ - if (nbytes == SBYTES (string)) + if (nbytes == nchars) return make_multibyte_string (SSDATA (string), nbytes, nbytes); - buf = SAFE_ALLOCA (nbytes); - memcpy (buf, SDATA (string), SBYTES (string)); - str_to_multibyte (buf, nbytes, SBYTES (string)); - - ret = make_multibyte_string ((char *) buf, SCHARS (string), nbytes); - SAFE_FREE (); - + Lisp_Object ret = make_uninit_multibyte_string (nchars, nbytes); + str_to_multibyte (SDATA (ret), SDATA (string), nchars); return ret; } @@ -1248,7 +1267,17 @@ string the same way whether it is unibyte or multibyte.) */) { CHECK_STRING (string); - return string_make_multibyte (string); + if (STRING_MULTIBYTE (string)) + return string; + + ptrdiff_t nchars = SCHARS (string); + ptrdiff_t nbytes = count_size_as_multibyte (SDATA (string), nchars); + if (nbytes == nchars) + return string; + + Lisp_Object ret = make_uninit_multibyte_string (nchars, nbytes); + str_to_multibyte (SDATA (ret), SDATA (string), nchars); + return ret; } DEFUN ("string-make-unibyte", Fstring_make_unibyte, Sstring_make_unibyte, @@ -1353,19 +1382,24 @@ an error is signaled. */) (Lisp_Object string) { CHECK_STRING (string); + if (!STRING_MULTIBYTE (string)) + return string; - if (STRING_MULTIBYTE (string)) + ptrdiff_t chars = SCHARS (string); + Lisp_Object ret = make_uninit_string (chars); + unsigned char *src = SDATA (string); + unsigned char *dst = SDATA (ret); + for (ptrdiff_t i = 0; i < chars; i++) { - ptrdiff_t chars = SCHARS (string); - unsigned char *str = xmalloc (chars); - ptrdiff_t converted = str_to_unibyte (SDATA (string), str, chars); - - if (converted < chars) - error ("Can't convert the %"pD"dth character to unibyte", converted); - string = make_unibyte_string ((char *) str, chars); - xfree (str); + unsigned char b = *src++; + if (b <= 0x7f) + *dst++ = b; /* ASCII */ + else if (CHAR_BYTE8_HEAD_P (b)) + *dst++ = 0x80 | (b & 1) << 6 | (*src++ & 0x3f); /* raw byte */ + else + error ("Cannot convert character at index %"pD"d to unibyte", i); } - return string; + return ret; } @@ -1380,7 +1414,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); @@ -1567,7 +1601,7 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, { /* If the tortoise just jumped (which is rare), update TORTOISE_NUM accordingly. */ - if (EQ (tail, li.tortoise)) + if (BASE_EQ (tail, li.tortoise)) tortoise_num = num; saved_tail = XCDR (tail); @@ -2005,7 +2039,7 @@ This function may destructively modify SEQ to produce the value. */) next = XCDR (tail); /* If SEQ contains a cycle, attempting to reverse it in-place will inevitably come back to SEQ. */ - if (EQ (next, seq)) + if (BASE_EQ (next, seq)) circular_list (seq); Fsetcdr (tail, prev); prev = tail; @@ -2104,8 +2138,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 +2150,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 +2232,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); @@ -2333,24 +2301,27 @@ merge_c (Lisp_Object org_l1, Lisp_Object org_l2, bool (*less) (Lisp_Object, Lisp /* This does not check for quits. That is safe since it must terminate. */ -DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0, +DEFUN ("plist-get", Fplist_get, Splist_get, 2, 3, 0, doc: /* Extract a value from a property list. PLIST is a property list, which is a list of the form \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value corresponding to the given PROP, or nil if PROP is not one of the properties on the list. The comparison -with PROP is done using `eq'. +with PROP is done using PREDICATE, which defaults to `eq'. -This function never signals an error. */) - (Lisp_Object plist, Lisp_Object prop) +This function doesn't signal an error if PLIST is invalid. */) + (Lisp_Object plist, Lisp_Object prop, Lisp_Object predicate) { Lisp_Object tail = plist; + if (NILP (predicate)) + return plist_get (plist, prop); + FOR_EACH_TAIL_SAFE (tail) { if (! CONSP (XCDR (tail))) break; - if (EQ (prop, XCAR (tail))) + if (!NILP (call2 (predicate, prop, XCAR (tail)))) return XCAR (XCDR (tail)); tail = XCDR (tail); } @@ -2358,39 +2329,58 @@ This function never signals an error. */) return Qnil; } +/* Faster version of the above that works with EQ only */ +Lisp_Object +plist_get (Lisp_Object plist, Lisp_Object prop) +{ + Lisp_Object tail = plist; + FOR_EACH_TAIL_SAFE (tail) + { + if (! CONSP (XCDR (tail))) + break; + if (EQ (prop, XCAR (tail))) + return XCAR (XCDR (tail)); + tail = XCDR (tail); + } + return Qnil; +} + DEFUN ("get", Fget, Sget, 2, 2, 0, doc: /* Return the value of SYMBOL's PROPNAME property. This is the last value stored with `(put SYMBOL PROPNAME VALUE)'. */) (Lisp_Object symbol, Lisp_Object propname) { CHECK_SYMBOL (symbol); - Lisp_Object propval = Fplist_get (CDR (Fassq (symbol, Voverriding_plist_environment)), - propname); + Lisp_Object propval = plist_get (CDR (Fassq (symbol, + Voverriding_plist_environment)), + propname); if (!NILP (propval)) return propval; - return Fplist_get (XSYMBOL (symbol)->u.s.plist, propname); + return plist_get (XSYMBOL (symbol)->u.s.plist, propname); } -DEFUN ("plist-put", Fplist_put, Splist_put, 3, 3, 0, +DEFUN ("plist-put", Fplist_put, Splist_put, 3, 4, 0, doc: /* Change value in PLIST of PROP to VAL. PLIST is a property list, which is a list of the form \(PROP1 VALUE1 PROP2 VALUE2 ...). -The comparison with PROP is done using `eq'. +The comparison with PROP is done using PREDICATE, which defaults to `eq'. If PROP is already a property on the list, its value is set to VAL, otherwise the new PROP VAL pair is added. The new plist is returned; use `(setq x (plist-put x prop val))' to be sure to use the new value. The PLIST is modified by side effects. */) - (Lisp_Object plist, Lisp_Object prop, Lisp_Object val) + (Lisp_Object plist, Lisp_Object prop, Lisp_Object val, Lisp_Object predicate) { Lisp_Object prev = Qnil, tail = plist; + if (NILP (predicate)) + return plist_put (plist, prop, val); FOR_EACH_TAIL (tail) { if (! CONSP (XCDR (tail))) break; - if (EQ (prop, XCAR (tail))) + if (!NILP (call2 (predicate, prop, XCAR (tail)))) { Fsetcar (XCDR (tail), val); return plist; @@ -2408,47 +2398,8 @@ The PLIST is modified by side effects. */) return plist; } -DEFUN ("put", Fput, Sput, 3, 3, 0, - doc: /* Store SYMBOL's PROPNAME property with value VALUE. -It can be retrieved with `(get SYMBOL PROPNAME)'. */) - (Lisp_Object symbol, Lisp_Object propname, Lisp_Object value) -{ - CHECK_SYMBOL (symbol); - set_symbol_plist - (symbol, Fplist_put (XSYMBOL (symbol)->u.s.plist, propname, value)); - return value; -} - -DEFUN ("lax-plist-get", Flax_plist_get, Slax_plist_get, 2, 2, 0, - doc: /* Extract a value from a property list, comparing with `equal'. -This function is otherwise like `plist-get', but may signal an error -if PLIST isn't a valid plist. */) - (Lisp_Object plist, Lisp_Object prop) -{ - Lisp_Object tail = plist; - FOR_EACH_TAIL (tail) - { - if (! CONSP (XCDR (tail))) - break; - if (! NILP (Fequal (prop, XCAR (tail)))) - return XCAR (XCDR (tail)); - tail = XCDR (tail); - } - - CHECK_TYPE (NILP (tail), Qplistp, plist); - - return Qnil; -} - -DEFUN ("lax-plist-put", Flax_plist_put, Slax_plist_put, 3, 3, 0, - doc: /* Change value in PLIST of PROP to VAL, comparing with `equal'. -PLIST is a property list, which is a list of the form -\(PROP1 VALUE1 PROP2 VALUE2 ...). PROP and VAL are any objects. -If PROP is already a property on the list, its value is set to VAL, -otherwise the new PROP VAL pair is added. The new plist is returned; -use `(setq x (lax-plist-put x prop val))' to be sure to use the new value. -The PLIST is modified by side effects. */) - (Lisp_Object plist, Lisp_Object prop, Lisp_Object val) +Lisp_Object +plist_put (Lisp_Object plist, Lisp_Object prop, Lisp_Object val) { Lisp_Object prev = Qnil, tail = plist; FOR_EACH_TAIL (tail) @@ -2456,7 +2407,7 @@ The PLIST is modified by side effects. */) if (! CONSP (XCDR (tail))) break; - if (! NILP (Fequal (prop, XCAR (tail)))) + if (EQ (prop, XCAR (tail))) { Fsetcar (XCDR (tail), val); return plist; @@ -2466,12 +2417,24 @@ The PLIST is modified by side effects. */) tail = XCDR (tail); } CHECK_TYPE (NILP (tail), Qplistp, plist); - Lisp_Object newcell = list2 (prop, val); + Lisp_Object newcell + = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev)))); if (NILP (prev)) return newcell; Fsetcdr (XCDR (prev), newcell); return plist; } + +DEFUN ("put", Fput, Sput, 3, 3, 0, + doc: /* Store SYMBOL's PROPNAME property with value VALUE. +It can be retrieved with `(get SYMBOL PROPNAME)'. */) + (Lisp_Object symbol, Lisp_Object propname, Lisp_Object value) +{ + CHECK_SYMBOL (symbol); + set_symbol_plist + (symbol, plist_put (XSYMBOL (symbol)->u.s.plist, propname, value)); + return value; +} DEFUN ("eql", Feql, Seql, 2, 2, 0, doc: /* Return t if the two args are `eq' or are indistinguishable numbers. @@ -2569,7 +2532,14 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, } } - if (EQ (o1, o2)) + /* 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 (BASE_EQ (o1, o2)) return true; if (XTYPE (o1) != XTYPE (o2)) return false; @@ -2807,20 +2777,26 @@ usage: (nconc &rest LISTS) */) static EMACS_INT mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) { - if (VECTORP (seq) || COMPILEDP (seq)) + if (NILP (seq)) + return 0; + else if (CONSP (seq)) { + Lisp_Object tail = seq; for (ptrdiff_t i = 0; i < leni; i++) { - Lisp_Object dummy = call1 (fn, AREF (seq, i)); + if (! CONSP (tail)) + return i; + Lisp_Object dummy = call1 (fn, XCAR (tail)); if (vals) vals[i] = dummy; + tail = XCDR (tail); } } - else if (BOOL_VECTOR_P (seq)) + else if (VECTORP (seq) || COMPILEDP (seq)) { - for (EMACS_INT i = 0; i < leni; i++) + for (ptrdiff_t i = 0; i < leni; i++) { - Lisp_Object dummy = call1 (fn, bool_vector_ref (seq, i)); + Lisp_Object dummy = call1 (fn, AREF (seq, i)); if (vals) vals[i] = dummy; } @@ -2838,29 +2814,30 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) vals[i_before] = dummy; } } - else /* Must be a list, since Flength did not get an error */ + else { - Lisp_Object tail = seq; - for (ptrdiff_t i = 0; i < leni; i++) + eassert (BOOL_VECTOR_P (seq)); + for (EMACS_INT i = 0; i < leni; i++) { - if (! CONSP (tail)) - return i; - Lisp_Object dummy = call1 (fn, XCAR (tail)); + Lisp_Object dummy = call1 (fn, bool_vector_ref (seq, i)); if (vals) vals[i] = dummy; - tail = XCDR (tail); } } 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. */) @@ -2877,12 +2854,18 @@ FUNCTION must be a function of one argument, and must return a value SAFE_ALLOCA_LISP (args, args_alloc); ptrdiff_t nmapped = mapcar1 (leni, args, function, sequence); ptrdiff_t nargs = 2 * nmapped - 1; + eassert (nmapped == leni); - for (ptrdiff_t i = nmapped - 1; i > 0; i--) - args[i + i] = args[i]; + if (NILP (separator) || (STRINGP (separator) && SCHARS (separator) == 0)) + nargs = nmapped; + else + { + for (ptrdiff_t i = nmapped - 1; i > 0; i--) + args[i + i] = args[i]; - for (ptrdiff_t i = 1; i < nargs; i += 2) - args[i] = separator; + for (ptrdiff_t i = 1; i < nargs; i += 2) + args[i] = separator; + } Lisp_Object ret = Fconcat (nargs, args); SAFE_FREE (); @@ -2961,6 +2944,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,8 +2973,11 @@ 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); + /* Preserve the actual command that eventually called `yes-or-no-p' + (otherwise `repeat' will be repeating `exit-minibuffer'). */ + specbind (Qreal_this_command, Vreal_this_command); while (1) { @@ -3149,14 +3138,19 @@ 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 of what files are preloaded and when. */ if (will_dump_p () && !will_bootstrap_p ()) - error ("(require %s) while preparing to dump", - SDATA (SYMBOL_NAME (feature))); + { + /* Avoid landing here recursively while outputting the + backtrace from the error. */ + gflags.will_dump_ = false; + error ("(require %s) while preparing to dump", + SDATA (SYMBOL_NAME (feature))); + } /* A certain amount of recursive `require' is legitimate, but if we require the same feature recursively 3 times, @@ -3176,12 +3170,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 +3193,6 @@ FILENAME are suppressed. */) SDATA (tem3), tem2); } - /* Once loading finishes, don't undo it. */ - Vautoload_queue = Qt; feature = unbind_to (count, feature); } @@ -3218,22 +3206,25 @@ FILENAME are suppressed. */) bottleneck of Widget operation. Here is their translation to C, for the sole reason of efficiency. */ -DEFUN ("plist-member", Fplist_member, Splist_member, 2, 2, 0, +DEFUN ("plist-member", Fplist_member, Splist_member, 2, 3, 0, doc: /* Return non-nil if PLIST has the property PROP. PLIST is a property list, which is a list of the form \(PROP1 VALUE1 PROP2 VALUE2 ...). -The comparison with PROP is done using `eq'. +The comparison with PROP is done using PREDICATE, which defaults to +`eq'. Unlike `plist-get', this allows you to distinguish between a missing property and a property with the value nil. The value is actually the tail of PLIST whose car is PROP. */) - (Lisp_Object plist, Lisp_Object prop) + (Lisp_Object plist, Lisp_Object prop, Lisp_Object predicate) { Lisp_Object tail = plist; + if (NILP (predicate)) + predicate = Qeq; FOR_EACH_TAIL (tail) { - if (EQ (XCAR (tail), prop)) + if (!NILP (call2 (predicate, XCAR (tail), prop))) return tail; tail = XCDR (tail); if (! CONSP (tail)) @@ -3243,13 +3234,22 @@ The value is actually the tail of PLIST whose car is PROP. */) return Qnil; } +/* plist_member isn't used much in the Emacs sources, so just provide + a shim so that the function name follows the same pattern as + plist_get/plist_put. */ +Lisp_Object +plist_member (Lisp_Object plist, Lisp_Object prop) +{ + return Fplist_member (plist, prop, Qnil); +} + DEFUN ("widget-put", Fwidget_put, Swidget_put, 3, 3, 0, doc: /* In WIDGET, set PROPERTY to VALUE. The value can later be retrieved with `widget-get'. */) (Lisp_Object widget, Lisp_Object property, Lisp_Object value) { CHECK_CONS (widget); - XSETCDR (widget, Fplist_put (XCDR (widget), property, value)); + XSETCDR (widget, plist_put (XCDR (widget), property, value)); return value; } @@ -3266,7 +3266,7 @@ later with `widget-put'. */) if (NILP (widget)) return Qnil; CHECK_CONS (widget); - tmp = Fplist_member (XCDR (widget), property); + tmp = plist_member (XCDR (widget), property); if (CONSP (tmp)) { tmp = XCDR (tmp); @@ -3649,7 +3649,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 +3692,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 +3717,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,13 +4156,13 @@ 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)); } -/* Ignore HT and compare KEY1 and KEY2 using 'eql'. +/* Ignore H and compare KEY1 and KEY2 using 'eql'. Value is true if KEY1 and KEY2 are the same. */ static Lisp_Object @@ -4171,7 +4171,7 @@ cmpfn_eql (Lisp_Object key1, Lisp_Object key2, struct Lisp_Hash_Table *h) return Feql (key1, key2); } -/* Ignore HT and compare KEY1 and KEY2 using 'equal'. +/* Ignore H and compare KEY1 and KEY2 using 'equal'. Value is true if KEY1 and KEY2 are the same. */ static Lisp_Object @@ -4181,7 +4181,7 @@ cmpfn_equal (Lisp_Object key1, Lisp_Object key2, struct Lisp_Hash_Table *h) } -/* Given HT, compare KEY1 and KEY2 using HT->user_cmp_function. +/* Given H, compare KEY1 and KEY2 using H->user_cmp_function. Value is true if KEY1 and KEY2 are the same. */ static Lisp_Object @@ -4192,34 +4192,35 @@ cmpfn_user_defined (Lisp_Object key1, Lisp_Object key2, return hash_table_user_defined_call (ARRAYELTS (args), args, h); } -/* Ignore HT and return a hash code for KEY which uses 'eq' to compare - keys. */ +/* Ignore H and return a hash code for KEY which uses 'eq' to compare keys. */ 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. +/* Ignore H 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)); } -/* Ignore HT and return a hash code for KEY which uses 'eql' to compare keys. +/* Ignore H 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); } -/* Given HT, return a hash code for KEY which uses a user-defined +/* Given H, return a hash code for KEY which uses a user-defined function to compare keys. */ Lisp_Object @@ -4475,7 +4476,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; @@ -4525,7 +4527,7 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, /* Store key/value in the key_and_value vector. */ i = h->next_free; eassert (NILP (HASH_HASH (h, i))); - eassert (EQ (Qunbound, (HASH_KEY (h, i)))); + eassert (BASE_EQ (Qunbound, (HASH_KEY (h, i)))); h->next_free = HASH_NEXT (h, i); set_hash_key_slot (h, i, key); set_hash_value_slot (h, i, value); @@ -4912,6 +4914,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. */ @@ -4947,7 +4951,8 @@ Hash codes are not guaranteed to be preserved across Emacs sessions. */) DEFUN ("sxhash-eql", Fsxhash_eql, Ssxhash_eql, 1, 1, 0, doc: /* Return an integer hash code for OBJ suitable for `eql'. -If (eql A B), then (= (sxhash-eql A) (sxhash-eql B)). +If (eql A B), then (= (sxhash-eql A) (sxhash-eql B)), but the opposite +isn't necessarily true. Hash codes are not guaranteed to be preserved across Emacs sessions. */) (Lisp_Object obj) @@ -4957,7 +4962,8 @@ Hash codes are not guaranteed to be preserved across Emacs sessions. */) DEFUN ("sxhash-equal", Fsxhash_equal, Ssxhash_equal, 1, 1, 0, doc: /* Return an integer hash code for OBJ suitable for `equal'. -If (equal A B), then (= (sxhash-equal A) (sxhash-equal B)). +If (equal A B), then (= (sxhash-equal A) (sxhash-equal B)), but the +opposite isn't necessarily true. Hash codes are not guaranteed to be preserved across Emacs sessions. */) (Lisp_Object obj) @@ -5264,7 +5270,7 @@ FUNCTION is called with two arguments, KEY and VALUE. for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i) { Lisp_Object k = HASH_KEY (h, i); - if (!EQ (k, Qunbound)) + if (!BASE_EQ (k, Qunbound)) call2 (function, k, HASH_VALUE (h, i)); } @@ -5914,9 +5920,12 @@ from the absolute start of the buffer, disregarding the narrowing. */) if (!NILP (absolute)) start = BEG_BYTE; - /* Check that POSITION is in the accessible range of the buffer. */ - if (pos < BEGV || pos > ZV) + /* Check that POSITION is in the accessible range of the buffer, or, + if we're reporting absolute positions, in the buffer. */ + if (NILP (absolute) && (pos < BEGV || pos > ZV)) args_out_of_range_3 (make_int (pos), make_int (BEGV), make_int (ZV)); + else if (!NILP (absolute) && (pos < 1 || pos > Z)) + args_out_of_range_3 (make_int (pos), make_int (1), make_int (Z)); return make_int (count_lines (start, CHAR_TO_BYTE (pos)) + 1); } @@ -6092,8 +6101,6 @@ The same variable also affects the function `read-answer'. */); defsubr (&Sget); defsubr (&Splist_put); defsubr (&Sput); - defsubr (&Slax_plist_get); - defsubr (&Slax_plist_put); defsubr (&Seql); defsubr (&Sequal); defsubr (&Sequal_including_properties); @@ -6125,4 +6132,6 @@ The same variable also affects the function `read-answer'. */); defsubr (&Sbuffer_hash); defsubr (&Slocale_info); defsubr (&Sbuffer_line_statistics); + + DEFSYM (Qreal_this_command, "real-this-command"); } diff --git a/src/font.c b/src/font.c index dcbcbc46be6..3846cfc1079 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 @@ -727,7 +731,7 @@ font_put_extra (Lisp_Object font, Lisp_Object prop, Lisp_Object val) { Lisp_Object prev = Qnil; - if (EQ (val, Qunbound)) + if (BASE_EQ (val, Qunbound)) return val; while (CONSP (extra) && NILP (Fstring_lessp (prop, XCAR (XCAR (extra))))) @@ -741,7 +745,7 @@ font_put_extra (Lisp_Object font, Lisp_Object prop, Lisp_Object val) return val; } XSETCDR (slot, val); - if (EQ (val, Qunbound)) + if (BASE_EQ (val, Qunbound)) ASET (font, FONT_EXTRA_INDEX, Fdelq (slot, extra)); return val; } @@ -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) @@ -3551,8 +3589,8 @@ font_open_by_name (struct frame *f, Lisp_Object name) The second is with frame F NULL. In this case, DRIVER is globally registered in the variable `font_driver_list'. All font-driver - implementations must call this function in its syms_of_XXXX - (e.g. syms_of_xfont). */ + implementations must call this function in its + syms_of_XXXX_for_pdumper (e.g. syms_of_xfont_for_pdumper). */ void register_font_driver (struct font_driver const *driver, struct frame *f) @@ -4997,6 +5035,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. @@ -5015,8 +5080,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) { @@ -5568,6 +5638,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 @@ -5686,7 +5757,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 (); @@ -5698,6 +5773,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..06bd297ccb2 100644 --- a/src/font.h +++ b/src/font.h @@ -155,8 +155,9 @@ enum font_property_index /* In a font-spec, the value is an alist of extra information of a font such as name, OpenType features, and language coverage. In addition, in a font-entity, the value may contain a pair - (font-entity . INFO) where INFO is extra information to identify - a font (font-driver dependent). */ + (font-entity . INFO) where INFO is extra information to + identify a font (font-driver dependent). In a font-entity, + this holds font driver-specific information. */ FONT_EXTRA_INDEX, /* alist alist */ /* This value is the length of font-spec vector. */ @@ -965,7 +966,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 +1000,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 0c278259a79..a39e1c4944f 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) { @@ -1436,10 +1444,6 @@ affects all frames on the same terminal device. */) If FRAME is a switch-frame event `(switch-frame FRAME1)', use FRAME1 as frame. - If TRACK is non-zero and the frame that currently has the focus - redirects its focus to the selected frame, redirect that focused - frame's focus to FRAME instead. - FOR_DELETION non-zero means that the selected frame is being deleted, which includes the possibility that the frame's terminal is dead. @@ -1447,7 +1451,7 @@ affects all frames on the same terminal device. */) The value of NORECORD is passed as argument to Fselect_window. */ Lisp_Object -do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object norecord) +do_switch_frame (Lisp_Object frame, int for_deletion, Lisp_Object norecord) { struct frame *sf = SELECTED_FRAME (), *f; @@ -1469,59 +1473,6 @@ do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object nor else if (f == sf) return frame; - /* If a frame's focus has been redirected toward the currently - selected frame, we should change the redirection to point to the - newly selected frame. This means that if the focus is redirected - from a minibufferless frame to a surrogate minibuffer frame, we - can use `other-window' to switch between all the frames using - that minibuffer frame, and the focus redirection will follow us - around. */ -#if 0 - /* This is too greedy; it causes inappropriate focus redirection - that's hard to get rid of. */ - if (track) - { - Lisp_Object tail; - - for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail)) - { - Lisp_Object focus; - - if (!FRAMEP (XCAR (tail))) - emacs_abort (); - - focus = FRAME_FOCUS_FRAME (XFRAME (XCAR (tail))); - - if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ()) - Fredirect_frame_focus (XCAR (tail), frame); - } - } -#else /* ! 0 */ - /* Instead, apply it only to the frame we're pointing to. */ -#ifdef HAVE_WINDOW_SYSTEM - if (track && FRAME_WINDOW_P (f) && FRAME_TERMINAL (f)->get_focus_frame) - { - Lisp_Object focus, gfocus; - - gfocus = FRAME_TERMINAL (f)->get_focus_frame (f); - if (FRAMEP (gfocus)) - { - focus = FRAME_FOCUS_FRAME (XFRAME (gfocus)); - if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ()) - /* Redirect frame focus also when FRAME has its minibuffer - window on the selected frame (see Bug#24500). - - Don't do that: It causes redirection problem with a - separate minibuffer frame (Bug#24803) and problems - when updating the cursor on such frames. - || (NILP (focus) - && EQ (FRAME_MINIBUF_WINDOW (f), sf->selected_window))) */ - Fredirect_frame_focus (gfocus, frame); - } - } -#endif /* HAVE_X_WINDOWS */ -#endif /* ! 0 */ - if (!for_deletion && FRAME_HAS_MINIBUF_P (sf)) resize_mini_window (XWINDOW (FRAME_MINIBUF_WINDOW (sf)), 1); @@ -1619,7 +1570,7 @@ This function returns FRAME, or nil if FRAME has been deleted. */) /* Do not select a tooltip frame (Bug#47207). */ error ("Cannot select a tooltip frame"); else - return do_switch_frame (frame, 1, 0, norecord); + return do_switch_frame (frame, 0, norecord); } DEFUN ("handle-switch-frame", Fhandle_switch_frame, @@ -1635,7 +1586,7 @@ necessarily represent user-visible input focus. */) kset_prefix_arg (current_kboard, Vcurrent_prefix_arg); run_hook (Qmouse_leave_buffer_hook); - return do_switch_frame (event, 0, 0, Qnil); + return do_switch_frame (event, 0, Qnil); } DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0, @@ -1982,6 +1933,9 @@ delete_frame (Lisp_Object frame, Lisp_Object force) int is_tooltip_frame; bool nochild = !FRAME_PARENT_FRAME (f); Lisp_Object minibuffer_child_frame = Qnil; +#ifdef HAVE_X_WINDOWS + specpdl_ref ref; +#endif if (!FRAME_LIVE_P (f)) return Qnil; @@ -1992,6 +1946,15 @@ 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) + || (x_dnd_waiting_for_finish && f == x_dnd_finish_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); @@ -2141,7 +2104,7 @@ delete_frame (Lisp_Object frame, Lisp_Object force) Fraise_frame (frame1); #endif - do_switch_frame (frame1, 0, 1, Qnil); + do_switch_frame (frame1, 1, Qnil); sf = SELECTED_FRAME (); } else @@ -2156,7 +2119,29 @@ delete_frame (Lisp_Object frame, Lisp_Object force) /* Clear any X selections for this frame. */ #ifdef HAVE_X_WINDOWS if (FRAME_X_P (f)) - x_clear_frame_selections (f); + { + /* Don't preserve selections when a display is going away, since + that sends stuff down the wire. */ + + ref = SPECPDL_INDEX (); + + if (EQ (force, Qnoelisp)) + specbind (Qx_auto_preserve_selections, Qnil); + + x_clear_frame_selections (f); + unbind_to (ref, Qnil); + } +#endif + +#ifdef HAVE_PGTK + if (FRAME_PGTK_P (f)) + { + /* Do special selection events now, in case the window gets + destroyed by this deletion. Does this run Lisp code? */ + swallow_events (false); + + pgtk_clear_frame_selections (f); + } #endif /* Free glyphs. @@ -2225,7 +2210,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) @@ -2329,7 +2315,8 @@ delete_frame (Lisp_Object frame, Lisp_Object force) kset_default_minibuffer_frame (kb, Qnil); } - /* Cause frame titles to update--necessary if we now have just one frame. */ + /* Cause frame titles to update--necessary if we now have just one + frame. */ if (!is_tooltip_frame) update_mode_lines = 15; @@ -2386,9 +2373,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 @@ -2506,9 +2496,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); @@ -2535,7 +2528,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); @@ -2543,7 +2536,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); @@ -2556,9 +2552,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; @@ -2579,7 +2577,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); @@ -3496,7 +3498,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); @@ -3520,6 +3525,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'). */) @@ -3617,7 +3625,7 @@ DEFUN ("frame-fringe-width", Ffringe_width, Sfringe_width, 0, 1, 0, DEFUN ("frame-child-frame-border-width", Fframe_child_frame_border_width, Sframe_child_frame_border_width, 0, 1, 0, doc: /* Return width of FRAME's child-frame border in pixels. - If FRAME's 'child-frame-border-width' parameter is nil, return FRAME's + If FRAME's `child-frame-border-width' parameter is nil, return FRAME's internal border width instead. */) (Lisp_Object frame) { @@ -3908,6 +3916,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)}, @@ -4247,7 +4259,7 @@ gui_set_frame_parameters (struct frame *f, Lisp_Object alist) } /* Don't die if just one of these was set. */ - if (EQ (left, Qunbound)) + if (BASE_EQ (left, Qunbound)) { left_no_change = 1; if (f->left_pos < 0) @@ -4255,7 +4267,7 @@ gui_set_frame_parameters (struct frame *f, Lisp_Object alist) else XSETINT (left, f->left_pos); } - if (EQ (top, Qunbound)) + if (BASE_EQ (top, Qunbound)) { top_no_change = 1; if (f->top_pos < 0) @@ -5025,6 +5037,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: @@ -5041,15 +5081,15 @@ 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. */ bool gui_mouse_grabbed (Display_Info *dpyinfo) { - return (dpyinfo->grabbed + return ((dpyinfo->grabbed + || (dpyinfo->terminal->any_grab_hook + && dpyinfo->terminal->any_grab_hook (dpyinfo))) && dpyinfo->last_mouse_frame && FRAME_LIVE_P (dpyinfo->last_mouse_frame)); } @@ -5067,8 +5107,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. @@ -5389,7 +5427,7 @@ gui_frame_get_and_record_arg (struct frame *f, Lisp_Object alist, value = gui_display_get_arg (FRAME_DISPLAY_INFO (f), alist, param, attribute, class, type); - if (! NILP (value) && ! EQ (value, Qunbound)) + if (! NILP (value) && ! BASE_EQ (value, Qunbound)) store_frame_param (f, param, value); return value; @@ -5410,7 +5448,7 @@ gui_default_parameter (struct frame *f, Lisp_Object alist, Lisp_Object prop, Lisp_Object tem; tem = gui_frame_get_arg (f, alist, prop, xprop, xclass, type); - if (EQ (tem, Qunbound)) + if (BASE_EQ (tem, Qunbound)) tem = deflt; AUTO_FRAME_ARG (arg, prop, tem); gui_set_frame_parameters (f, arg); @@ -5672,9 +5710,9 @@ gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p, height = gui_display_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER); width = gui_display_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER); - if (!EQ (width, Qunbound) || !EQ (height, Qunbound)) + if (!BASE_EQ (width, Qunbound) || !BASE_EQ (height, Qunbound)) { - if (!EQ (width, Qunbound)) + if (!BASE_EQ (width, Qunbound)) { if (CONSP (width) && EQ (XCAR (width), Qtext_pixels)) { @@ -5710,7 +5748,7 @@ gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p, } } - if (!EQ (height, Qunbound)) + if (!BASE_EQ (height, Qunbound)) { if (CONSP (height) && EQ (XCAR (height), Qtext_pixels)) { @@ -5748,7 +5786,7 @@ gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p, user_size = gui_display_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER); - if (!NILP (user_size) && !EQ (user_size, Qunbound)) + if (!NILP (user_size) && !BASE_EQ (user_size, Qunbound)) window_prompting |= USSize; else window_prompting |= PSize; @@ -5761,7 +5799,7 @@ gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p, left = gui_display_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER); user_position = gui_display_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER); - if (! EQ (top, Qunbound) || ! EQ (left, Qunbound)) + if (! BASE_EQ (top, Qunbound) || ! BASE_EQ (left, Qunbound)) { if (EQ (top, Qminus)) { @@ -5784,7 +5822,7 @@ gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p, else if (FLOATP (top)) f->top_pos = frame_float (f, top, FRAME_FLOAT_TOP, &parent_done, &outer_done, 0); - else if (EQ (top, Qunbound)) + else if (BASE_EQ (top, Qunbound)) f->top_pos = 0; else { @@ -5814,7 +5852,7 @@ gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p, else if (FLOATP (left)) f->left_pos = frame_float (f, left, FRAME_FLOAT_LEFT, &parent_done, &outer_done, 0); - else if (EQ (left, Qunbound)) + else if (BASE_EQ (left, Qunbound)) f->left_pos = 0; else { @@ -5823,7 +5861,7 @@ gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p, window_prompting |= XNegative; } - if (!NILP (user_position) && ! EQ (user_position, Qunbound)) + if (!NILP (user_position) && ! BASE_EQ (user_position, Qunbound)) window_prompting |= USPosition; else window_prompting |= PPosition; @@ -5910,7 +5948,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) @@ -5948,6 +5986,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); @@ -6037,6 +6079,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"); @@ -6054,11 +6098,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"); @@ -6096,6 +6144,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"); @@ -6195,14 +6244,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; @@ -6222,7 +6281,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 @@ -6468,6 +6527,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 @@ -6483,6 +6550,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 cc0dae8f5ab..458b6257e49 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 @@ -586,6 +590,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; @@ -636,6 +642,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. */ @@ -853,6 +862,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. */ @@ -865,6 +884,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 @@ -917,6 +942,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 @@ -1266,8 +1293,28 @@ SET_FRAME_VISIBLE (struct frame *f, int v) } /* Set iconified status of frame F. */ -#define SET_FRAME_ICONIFIED(f, i) \ - (f)->iconified = (eassert (0 <= (i) && (i) <= 1), (i)) +INLINE void +SET_FRAME_ICONIFIED (struct frame *f, int i) +{ +#ifdef HAVE_WINDOW_SYSTEM + Lisp_Object frame; +#endif + + eassert (0 <= (i) && (i) <= 1); + + f->iconified = i; + +#ifdef HAVE_WINDOW_SYSTEM + /* Iconifying a frame might cause the frame title to change if no + title was explicitly specified. Force the frame title to be + recomputed. */ + + XSETFRAME (frame, f); + + if (FRAME_WINDOW_P (f)) + gui_consider_frame_title (frame); +#endif +} extern Lisp_Object selected_frame; extern Lisp_Object old_selected_frame; @@ -1316,8 +1363,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); @@ -1650,6 +1695,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); @@ -1674,7 +1720,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. */ @@ -1710,6 +1756,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..6bb41110d5c 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -22,13 +22,30 @@ 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" #include "font.h" #include "ftfont.h" #include "pdumper.h" +#ifdef HAVE_PGTK +#include "xsettings.h" +#endif + +#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) @@ -154,7 +171,16 @@ ftcrfont_open (struct frame *f, Lisp_Object entity, int pixel_size) cairo_matrix_t font_matrix, ctm; cairo_matrix_init_scale (&font_matrix, pixel_size, pixel_size); cairo_matrix_init_identity (&ctm); + +#ifdef HAVE_PGTK + cairo_font_options_t *options = xsettings_get_font_options (); +#else cairo_font_options_t *options = cairo_font_options_create (); +#endif +#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 +530,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,18 +602,58 @@ 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; } +#ifdef HAVE_PGTK +/* Determine if FONT_OBJECT is a valid cached font for ENTITY by + comparing the options used to open it with the user's current + preferences specified via GSettings. */ +static bool +ftcrfont_cached_font_ok (struct frame *f, Lisp_Object font_object, + Lisp_Object entity) +{ + struct font_info *info = (struct font_info *) XFONT_OBJECT (font_object); + + cairo_font_options_t *options = cairo_font_options_create (); + cairo_scaled_font_get_font_options (info->cr_scaled_font, options); + cairo_font_options_t *gsettings_options = xsettings_get_font_options (); + + bool equal = cairo_font_options_equal (options, gsettings_options); + cairo_font_options_destroy (options); + cairo_font_options_destroy (gsettings_options); + + return equal; +} +#endif + #ifdef HAVE_HARFBUZZ static Lisp_Object @@ -615,6 +724,9 @@ struct font_driver const ftcrfont_driver = #endif .filter_properties = ftfont_filter_properties, .combining_capability = ftfont_combining_capability, +#ifdef HAVE_PGTK + .cached_font_ok = ftcrfont_cached_font_ok +#endif }; #ifdef HAVE_HARFBUZZ struct font_driver ftcrhbfont_driver; diff --git a/src/ftfont.c b/src/ftfont.c index f457505fb3b..301a145b7ac 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) @@ -629,8 +645,29 @@ ftfont_get_open_type_spec (Lisp_Object otf_spec) return spec; } +#if defined HAVE_XFT && defined FC_COLOR +static bool +xft_color_font_whitelisted_p (const char *family) +{ + Lisp_Object tem, name; + + tem = Vxft_color_font_whitelist; + + FOR_EACH_TAIL_SAFE (tem) + { + name = XCAR (tem); + + if (STRINGP (name) && !strcmp (family, SSDATA (name))) + return true; + } + + return false; +} +#endif + static FcPattern * -ftfont_spec_pattern (Lisp_Object spec, char *otlayout, struct OpenTypeSpec **otspec, const char **langname) +ftfont_spec_pattern (Lisp_Object spec, char *otlayout, + struct OpenTypeSpec **otspec, const char **langname) { Lisp_Object tmp, extra; FcPattern *pattern = NULL; @@ -769,6 +806,8 @@ ftfont_spec_pattern (Lisp_Object spec, char *otlayout, struct OpenTypeSpec **ots /* We really don't like color fonts, they cause Xft crashes. See Bug#30874. */ if (xft_ignore_color_fonts + && (NILP (AREF (spec, FONT_FAMILY_INDEX)) + || NILP (Vxft_color_font_whitelist)) && ! FcPatternAddBool (pattern, FC_COLOR, FcFalse)) goto err; #endif @@ -865,6 +904,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; @@ -911,7 +953,12 @@ ftfont_list (struct frame *f, Lisp_Object spec) returns them even when it shouldn't really do so, so we need to manually skip them here (Bug#37786). */ FcBool b; + FcChar8 *str; + if (xft_ignore_color_fonts + && (FcPatternGetString (fontset->fonts[i], FC_FAMILY, + 0, &str) != FcResultMatch + || !xft_color_font_whitelisted_p ((char *) str)) && FcPatternGetBool (fontset->fonts[i], FC_COLOR, 0, &b) == FcResultMatch && b != FcFalse) continue; @@ -3110,6 +3157,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..a0de0238c47 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; @@ -1631,10 +1635,10 @@ gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist) char *c_hostname; if (NILP (proplist)) - proplist = Fcdr (Fplist_get (p->childp, QCtls_parameters)); + proplist = Fcdr (plist_get (p->childp, QCtls_parameters)); - verify_error = Fplist_get (proplist, QCverify_error); - hostname = Fplist_get (proplist, QChostname); + verify_error = plist_get (proplist, QCverify_error); + hostname = plist_get (proplist, QChostname); if (EQ (verify_error, Qt)) verify_error_all = true; @@ -1664,7 +1668,7 @@ gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist) p->gnutls_peer_verification = peer_verification; - warnings = Fplist_get (Fgnutls_peer_status (proc), intern (":warnings")); + warnings = plist_get (Fgnutls_peer_status (proc), intern (":warnings")); if (!NILP (warnings)) { for (Lisp_Object tail = warnings; CONSP (tail); tail = XCDR (tail)) @@ -1866,13 +1870,13 @@ one trustfile (usually a CA bundle). */) return Qnil; } - hostname = Fplist_get (proplist, QChostname); - priority_string = Fplist_get (proplist, QCpriority); - trustfiles = Fplist_get (proplist, QCtrustfiles); - keylist = Fplist_get (proplist, QCkeylist); - crlfiles = Fplist_get (proplist, QCcrlfiles); - loglevel = Fplist_get (proplist, QCloglevel); - prime_bits = Fplist_get (proplist, QCmin_prime_bits); + hostname = plist_get (proplist, QChostname); + priority_string = plist_get (proplist, QCpriority); + trustfiles = plist_get (proplist, QCtrustfiles); + keylist = plist_get (proplist, QCkeylist); + crlfiles = plist_get (proplist, QCcrlfiles); + loglevel = plist_get (proplist, QCloglevel); + prime_bits = plist_get (proplist, QCmin_prime_bits); if (!STRINGP (hostname)) { @@ -1925,7 +1929,7 @@ one trustfile (usually a CA bundle). */) check_memory_full (gnutls_certificate_allocate_credentials (&x509_cred)); XPROCESS (proc)->gnutls_x509_cred = x509_cred; - verify_flags = Fplist_get (proplist, QCverify_flags); + verify_flags = plist_get (proplist, QCverify_flags); if (TYPE_RANGED_FIXNUMP (unsigned int, verify_flags)) { gnutls_verify_flags = XFIXNAT (verify_flags); @@ -2105,7 +2109,7 @@ one trustfile (usually a CA bundle). */) } XPROCESS (proc)->gnutls_complete_negotiation_p = - !NILP (Fplist_get (proplist, QCcomplete_negotiation)); + !NILP (plist_get (proplist, QCcomplete_negotiation)); GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET; ret = emacs_gnutls_handshake (XPROCESS (proc)); if (ret < GNUTLS_E_SUCCESS) @@ -2344,7 +2348,7 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, if (!NILP (info) && CONSP (info)) { - Lisp_Object v = Fplist_get (info, QCcipher_id); + Lisp_Object v = plist_get (info, QCcipher_id); if (TYPE_RANGED_FIXNUMP (gnutls_cipher_algorithm_t, v)) gca = XFIXNUM (v); } @@ -2621,7 +2625,7 @@ itself. */) if (!NILP (info) && CONSP (info)) { - Lisp_Object v = Fplist_get (info, QCmac_algorithm_id); + Lisp_Object v = plist_get (info, QCmac_algorithm_id); if (TYPE_RANGED_FIXNUMP (gnutls_mac_algorithm_t, v)) gma = XFIXNUM (v); } @@ -2711,7 +2715,7 @@ the number itself. */) if (!NILP (info) && CONSP (info)) { - Lisp_Object v = Fplist_get (info, QCdigest_algorithm_id); + Lisp_Object v = plist_get (info, QCdigest_algorithm_id); if (TYPE_RANGED_FIXNUMP (gnutls_digest_algorithm_t, v)) gda = XFIXNUM (v); } 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..f2018bc01f5 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) { @@ -595,57 +736,74 @@ xg_check_special_colors (struct frame *f, const char *color_name, Emacs_Color *color) { - bool success_p = 0; - bool get_bg = strcmp ("gtk_selection_bg_color", color_name) == 0; - bool get_fg = !get_bg && strcmp ("gtk_selection_fg_color", color_name) == 0; + bool success_p; + bool get_bg; + bool get_fg; +#ifdef HAVE_GTK3 + GtkStyleContext *gsty; + GdkRGBA col; + char buf[sizeof "rgb://rrrr/gggg/bbbb"]; + int state; + GdkRGBA *c; + unsigned short r, g, b; +#else + GtkStyle *gsty; + GdkColor *grgb; +#endif - if (! FRAME_GTK_WIDGET (f) || ! (get_bg || get_fg)) + get_bg = !strcmp ("gtk_selection_bg_color", color_name); + get_fg = !get_bg && !strcmp ("gtk_selection_fg_color", color_name); + success_p = false; + +#ifdef HAVE_PGTK + while (FRAME_PARENT_FRAME (f)) + f = FRAME_PARENT_FRAME (f); +#endif + + if (!FRAME_GTK_WIDGET (f) || !(get_bg || get_fg)) return success_p; block_input (); - { #ifdef HAVE_GTK3 - GtkStyleContext *gsty - = gtk_widget_get_style_context (FRAME_GTK_OUTER_WIDGET (f)); - GdkRGBA col; - char buf[sizeof "rgb://rrrr/gggg/bbbb"]; - int state = GTK_STATE_FLAG_SELECTED|GTK_STATE_FLAG_FOCUSED; - if (get_fg) - gtk_style_context_get_color (gsty, state, &col); - else - { - GdkRGBA *c; - /* FIXME: Retrieving the background color is deprecated in - GTK+ 3.16. New versions of GTK+ don't use the concept of a - single background color any more, so we shouldn't query for - it. */ - gtk_style_context_get (gsty, state, - GTK_STYLE_PROPERTY_BACKGROUND_COLOR, &c, - NULL); - col = *c; - gdk_rgba_free (c); - } + gsty = gtk_widget_get_style_context (FRAME_GTK_OUTER_WIDGET (f)); + state = GTK_STATE_FLAG_SELECTED | GTK_STATE_FLAG_FOCUSED; - unsigned short - r = col.red * 65535, - g = col.green * 65535, - b = col.blue * 65535; - sprintf (buf, "rgb:%04x/%04x/%04x", r, g, b); - success_p = x_parse_color (f, buf, color) != 0; -#else - GtkStyle *gsty = gtk_widget_get_style (FRAME_GTK_WIDGET (f)); - GdkColor *grgb = get_bg - ? &gsty->bg[GTK_STATE_SELECTED] - : &gsty->fg[GTK_STATE_SELECTED]; + if (get_fg) + gtk_style_context_get_color (gsty, state, &col); + else + { + /* FIXME: Retrieving the background color is deprecated in + GTK+ 3.16. New versions of GTK+ don't use the concept of a + single background color any more, so we shouldn't query for + it. */ + gtk_style_context_get (gsty, state, + GTK_STYLE_PROPERTY_BACKGROUND_COLOR, &c, + NULL); + col = *c; + gdk_rgba_free (c); + } - color->red = grgb->red; - color->green = grgb->green; - color->blue = grgb->blue; - color->pixel = grgb->pixel; - success_p = 1; + 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 + gsty = gtk_widget_get_style (FRAME_GTK_WIDGET (f)); + grgb = (get_bg ? &gsty->bg[GTK_STATE_SELECTED] + : &gsty->fg[GTK_STATE_SELECTED]); + + color->red = grgb->red; + color->green = grgb->green; + color->blue = grgb->blue; + color->pixel = grgb->pixel; + success_p = 1; #endif - - } unblock_input (); return success_p; } @@ -655,6 +813,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 +826,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 +848,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 +895,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 +946,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 +970,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 +990,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 +1029,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. @@ -857,6 +1068,7 @@ xg_set_geometry (struct frame *f) /* Handle negative positions without consulting gtk_window_parse_geometry (Bug#25851). The position will be off by scrollbar width + window manager decorations. */ +#ifndef HAVE_PGTK if (f->size_hint_flags & XNegative) f->left_pos = (x_display_pixel_width (FRAME_DISPLAY_INFO (f)) - FRAME_PIXEL_WIDTH (f) + f->left_pos); @@ -864,6 +1076,15 @@ xg_set_geometry (struct frame *f) if (f->size_hint_flags & YNegative) f->top_pos = (x_display_pixel_height (FRAME_DISPLAY_INFO (f)) - FRAME_PIXEL_HEIGHT (f) + f->top_pos); +#else + if (f->size_hint_flags & XNegative) + f->left_pos = (pgtk_display_pixel_width (FRAME_DISPLAY_INFO (f)) + - FRAME_PIXEL_WIDTH (f) + f->left_pos); + + if (f->size_hint_flags & YNegative) + f->top_pos = (pgtk_display_pixel_height (FRAME_DISPLAY_INFO (f)) + - FRAME_PIXEL_HEIGHT (f) + f->top_pos); +#endif /* GTK works in scaled pixels, so convert from X pixels. */ gtk_window_move (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), @@ -954,8 +1175,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); @@ -963,7 +1199,7 @@ xg_frame_set_char_size (struct frame *f, int width, int height) outer_height /= xg_get_scale (f); outer_width /= xg_get_scale (f); - x_wm_set_size_hint (f, 0, 0); + xg_wm_set_size_hint (f, 0, 0); /* Resize the top level widget so rows and columns remain constant. @@ -975,32 +1211,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 +1296,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 +1335,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 +1370,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 +1403,7 @@ xg_win_to_widget (Display *dpy, Window wdesc) unblock_input (); return gwdesc; } +#endif /* Set the background of widget W to PIXEL. */ @@ -1107,9 +1411,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 +1457,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 +1487,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 +1505,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 +1513,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 +1527,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 +1613,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 +1629,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 +1641,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 +1657,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 +1667,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 +1709,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 +1727,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 +1771,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 +1886,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) { @@ -1415,7 +1915,7 @@ xg_free_frame_widgets (struct frame *f) flag (this is useful when FLAGS is 0). */ void -x_wm_set_size_hint (struct frame *f, long int flags, bool user_position) +xg_wm_set_size_hint (struct frame *f, long int flags, bool user_position) { /* Must use GTK routines here, otherwise GTK resets the size hints to its own defaults. */ @@ -1436,9 +1936,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 +1952,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 +2003,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 +2021,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 +2055,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 +2070,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 +2100,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 +2115,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 +2134,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 +2153,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 +2186,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 +2454,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 +2740,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 +2777,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 +2842,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 +2900,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 +3044,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 +3056,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 +3218,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 +3289,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 +3364,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 +3390,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 +4120,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 +4140,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 +4166,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 +4182,7 @@ free_frame_menubar (struct frame *f) } } +#ifndef HAVE_PGTK bool xg_event_is_for_menubar (struct frame *f, const XEvent *event) { @@ -3575,6 +4197,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 +4217,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 +4236,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 +4263,7 @@ xg_event_is_for_menubar (struct frame *f, const XEvent *event) g_list_free (list); return iter != 0; } +#endif @@ -3628,6 +4281,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 +4354,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 +4362,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 +4457,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 +4478,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 +4528,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 +4569,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 +4579,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 +4683,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 +4707,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 +4748,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 +4814,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 +4855,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 +4880,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 +4920,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 +5008,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 +5042,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 +5087,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 +5188,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 +5293,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 +5394,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 +5450,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 +5689,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 +5702,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 +5713,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 +5780,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 +5795,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 +6095,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 +6140,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 +6189,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 +6240,443 @@ 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; + + if (popup_activated ()) + 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..190d6628314 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,10 +148,13 @@ 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); +extern void xg_wm_set_size_hint (struct frame *, long int, bool); + extern void update_frame_tool_bar (struct frame *f); extern void free_frame_tool_bar (struct frame *f); extern void xg_change_toolbar_position (struct frame *f, Lisp_Object pos); @@ -157,9 +166,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 +182,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 +203,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,7 +216,15 @@ extern Lisp_Object xg_get_page_setup (void); extern void xg_print_frames_dialog (Lisp_Object); #endif -/* Mark all callback data that are Lisp_object:s during GC. */ +#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_Objects during GC. */ extern void xg_mark_data (void); /* Initialize GTK specific parts. */ 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..8e911dd1843 --- /dev/null +++ b/src/haiku_draw_support.cc @@ -0,0 +1,536 @@ +/* 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, bool use_bilinear_filtering) +{ + BView *vw = get_view (view); + BBitmap *bm = (BBitmap *) bitmap; + + vw->SetDrawingMode (B_OP_OVER); + if (!use_bilinear_filtering) + vw->DrawBitmap (bm, BRect (x, y, x + width - 1, y + height - 1), + BRect (vx, vy, vx + vwidth - 1, vy + vheight - 1)); + else + vw->DrawBitmap (bm, BRect (x, y, x + width - 1, y + height - 1), + BRect (vx, vy, vx + vwidth - 1, vy + vheight - 1), + B_FILTER_BITMAP_BILINEAR); + vw->SetDrawingMode (B_OP_COPY); +} + +void +BView_DrawBitmapTiled (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; + BRect bounds = bm->Bounds (); + + if (width == -1) + width = BE_RECT_WIDTH (bounds); + + if (height == -1) + height = BE_RECT_HEIGHT (bounds); + + 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), + B_TILE_BITMAP); + vw->SetDrawingMode (B_OP_COPY); +} + +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); + uint32_t *bits; + size_t stride; + rgb_color low_color; + BRect bounds; + + if (bc.InitCheck () != B_OK || bc.ImportBits (bm) != B_OK) + return; + + bits = (uint32_t *) bc.Bits (); + stride = bc.BytesPerRow (); + + if (bm->ColorSpace () == B_GRAY1) + { + low_color = vw->LowColor (); + 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->SetDrawingMode ((bm->ColorSpace () + == B_GRAY1) + ? B_OP_OVER : B_OP_ERASE); + vw->DrawBitmap (&bc, rect); + vw->SetDrawingMode (B_OP_COPY); +} + +void +be_draw_image_mask (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 (); + int bx, by, bit; + BView *vw; + + if (bm.InitCheck () != B_OK) + return; + + /* Fill the background color or transparency into the bitmap, + depending on the value of the mask. */ + for (by = 0; by < BE_RECT_HEIGHT (bounds); ++by) + { + for (bx = 0; bx < BE_RECT_WIDTH (bounds); ++bx) + { + bit = haiku_get_pixel ((void *) source, bx, by); + + if (!bit) + haiku_put_pixel ((void *) &bm, bx, by, + ((uint32_t) 255 << 24) | color); + else + haiku_put_pixel ((void *) &bm, bx, by, 0); + } + } + + 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)); + vw->SetDrawingMode (B_OP_COPY); +} + +void +be_apply_affine_transform (void *view, double m0, double m1, double tx, + double m2, double m3, double ty) +{ + BAffineTransform transform (m0, m2, m1, m3, tx, ty); + + get_view (view)->SetTransform (transform); +} + +void +be_apply_inverse_transform (double (*matrix3x3)[3], int x, int y, + int *x_out, int *y_out) +{ + BAffineTransform transform (matrix3x3[0][0], matrix3x3[1][0], + matrix3x3[0][1], matrix3x3[1][1], + matrix3x3[0][2], matrix3x3[1][2]); + BPoint point (x, y); + + transform.ApplyInverse (&point); + + *x_out = std::floor (point.x); + *y_out = std::floor (point.y); +} + +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_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)); +} + +static void +be_draw_cross_on_pixmap_1 (BBitmap *bitmap, int x, int y, int width, + int height, uint32_t color) +{ + BBitmap dest (bitmap->Bounds (), + bitmap->ColorSpace (), + true, false); + BView view (bitmap->Bounds (), NULL, B_FOLLOW_NONE, 0); + rgb_color high_color; + + rgb32_to_rgb_color (color, &high_color); + dest.ImportBits (bitmap); + + if (!dest.Lock ()) + return; + + dest.AddChild (&view); + + view.SetHighColor (high_color); + view.StrokeLine (BPoint (x, y), + BPoint (x + width - 1, y + height - 1)); + view.StrokeLine (BPoint (x, y + height - 1), + BPoint (x + width - 1, y)); + view.RemoveSelf (); + bitmap->ImportBits (&dest); +} + +void +be_draw_cross_on_pixmap (void *bitmap, int x, int y, int width, + int height, uint32_t color) +{ + BBitmap *target = (BBitmap *) bitmap; + + be_draw_cross_on_pixmap_1 (target, x, y, width, height, + color); +} + +void +be_draw_bitmap_with_mask (void *view, void *bitmap, void *mask, + int dx, int dy, int width, int height, + int vx, int vy, int vwidth, int vheight, + bool use_bilinear_filtering) +{ + BBitmap *source ((BBitmap *) bitmap); + BBitmap combined (source->Bounds (), B_RGBA32); + BRect bounds; + int x, y, bit; + BView *vw; + uint32_t source_mask; + unsigned long pixel; + + if (combined.InitCheck () != B_OK) + return; + + if (combined.ImportBits (source) != B_OK) + return; + + bounds = source->Bounds (); + + if (source->ColorSpace () == B_RGB32) + source_mask = 255u << 24; + else + source_mask = 0; + + for (y = 0; y < BE_RECT_HEIGHT (bounds); ++y) + { + for (x = 0; x < BE_RECT_WIDTH (bounds); ++x) + { + bit = haiku_get_pixel (mask, x, y); + + if (bit) + { + pixel = haiku_get_pixel (bitmap, x, y); + haiku_put_pixel ((void *) &combined, x, y, + source_mask | pixel); + } + else + haiku_put_pixel ((void *) &combined, x, y, 0); + } + } + + vw = get_view (view); + + vw->SetDrawingMode (B_OP_OVER); + if (!use_bilinear_filtering) + vw->DrawBitmap (&combined, + BRect (dx, dy, dx + width - 1, dy + height - 1), + BRect (vx, vy, vx + vwidth - 1, vy + vheight - 1)); + else + vw->DrawBitmap (&combined, + BRect (dx, dy, dx + width - 1, dy + height - 1), + BRect (vx, vy, vx + vwidth - 1, vy + vheight - 1), + B_FILTER_BITMAP_BILINEAR); + vw->SetDrawingMode (B_OP_COPY); +} diff --git a/src/haiku_font_support.cc b/src/haiku_font_support.cc new file mode 100644 index 00000000000..d824cc59ae2 --- /dev/null +++ b/src/haiku_font_support.cc @@ -0,0 +1,941 @@ +/* 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" + +/* Cache used during font lookup. It contains an opened font object + we can look inside, and some previously determined information. */ +struct font_object_cache_bucket +{ + struct font_object_cache_bucket *next; + unsigned int hash; + + BFont *font_object; +}; + +static struct font_object_cache_bucket *font_object_cache[2048]; + +/* 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 int language_code_points[MAX_LANGUAGE][3] = + {{20154, 20754, 22996}, /* Chinese. */ + {51312, 49440, 44544}, /* Korean. */ + {26085, 26412, 12371}, /* Japanese. */}; + +static unsigned int +hash_string (const char *name_or_style) +{ + unsigned int i; + + i = 3323198485ul; + for (; *name_or_style; ++name_or_style) + { + i ^= *name_or_style; + i *= 0x5bd1e995; + i ^= i >> 15; + } + return i; +} + +static struct font_object_cache_bucket * +cache_font_object_data (const char *family, const char *style, + BFont *font_object) +{ + uint32_t hash; + struct font_object_cache_bucket *bucket, *next; + + hash = hash_string (family) ^ hash_string (style); + bucket = font_object_cache[hash % 2048]; + + for (next = bucket; next; next = next->next) + { + if (next->hash == hash) + { + delete next->font_object; + next->font_object = font_object; + + return next; + } + } + + next = new struct font_object_cache_bucket; + next->font_object = font_object; + next->hash = hash; + next->next = bucket; + font_object_cache[hash % 2048] = next; + return next; +} + +static struct font_object_cache_bucket * +lookup_font_object_data (const char *family, const char *style) +{ + uint32_t hash; + struct font_object_cache_bucket *bucket, *next; + + hash = hash_string (family) ^ hash_string (style); + bucket = font_object_cache[hash % 2048]; + + for (next = bucket; next; next = next->next) + { + if (next->hash == hash) + return next; + } + + return NULL; +} + +static bool +font_object_has_chars (struct font_object_cache_bucket *cached, + int *chars, int nchars, bool just_one_of) +{ + int i; + + for (i = 0; i < nchars; ++i) + { + if (just_one_of + && cached->font_object->IncludesBlock (chars[i], + chars[i])) + return true; + + if (!just_one_of + && !cached->font_object->IncludesBlock (chars[i], + chars[i])) + return false; + } + + return !just_one_of; +} + +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_metrics (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; + int tok = 0; + + if (!style) + return; + + pattern->weight = NO_WEIGHT; + pattern->width = NO_WIDTH; + pattern->slant = NO_SLANT; + + while ((token = std::strtok (!tok ? style : NULL, " ")) && tok < 3) + { + if (token && !strcmp (token, "Thin")) + pattern->weight = HAIKU_THIN; + else if (token && (!strcmp (token, "UltraLight") + || !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 == NO_WEIGHT) + 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") + || !strcmp (token, "UltraBold"))) + pattern->weight = HAIKU_EXTRA_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 != NO_WEIGHT) + 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; + static struct font_object_cache_bucket *cached; + unicode_block wanted_block; + + cached = lookup_font_object_data (family, style); + if (cached) + ft = cached->font_object; + else + { + ft = new BFont; + + if (ft->SetFamilyAndStyle (family, style) != B_OK) + { + delete ft; + return false; + } + + cached = cache_font_object_data (family, style, ft); + } + + return font_object_has_chars (cached, pattern->wanted_chars, + pattern->want_chars_len, false); +} + +static bool +font_check_one_of (struct haiku_font_pattern *pattern, font_family family, + char *style) +{ + BFont *ft; + static struct font_object_cache_bucket *cached; + unicode_block wanted_block; + + cached = lookup_font_object_data (family, style); + if (cached) + ft = cached->font_object; + else + { + ft = new BFont; + + if (ft->SetFamilyAndStyle (family, style) != B_OK) + { + delete ft; + return false; + } + + cached = cache_font_object_data (family, style, ft); + } + + return font_object_has_chars (cached, pattern->need_one_of, + pattern->need_one_of_len, true); +} + +static bool +font_check_language (struct haiku_font_pattern *pattern, font_family family, + char *style) +{ + BFont *ft; + static struct font_object_cache_bucket *cached; + + cached = lookup_font_object_data (family, style); + if (cached) + ft = cached->font_object; + else + { + ft = new BFont; + + if (ft->SetFamilyAndStyle (family, style) != B_OK) + { + delete ft; + return false; + } + + cached = cache_font_object_data (family, style, ft); + } + + if (pattern->language == MAX_LANGUAGE) + return false; + + return font_object_has_chars (cached, language_code_points[pattern->language], + 3, false); +} + +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); + /* Don't allow matching fonts with an adstyle if no style was + specified in the query pattern. */ + else if (m.specified & FSPEC_STYLE) + return false; + + 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, fam_count, si, fi; + struct haiku_font_pattern *p, *head, *n; + bool oblique_seen_p; + + fam_count = count_font_families (); + + for (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)) + { + 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; + + if (pt->specified & FSPEC_ANTIALIAS) + { + p->specified |= FSPEC_ANTIALIAS; + p->use_antialiasing = pt->use_antialiasing; + } + } + else if (sty_count) + { + for (si = 0; si < sty_count; ++si) + { + oblique_seen_p = 0; + head = r; + 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); + + /* Add the indices to this font now so we + won't have to loop over each font in + order to open it later. */ + + p->specified |= FSPEC_INDICES; + p->family_index = fi; + p->style_index = si; + + if (pt->specified & FSPEC_ANTIALIAS) + { + p->specified |= FSPEC_ANTIALIAS; + p->use_antialiasing = pt->use_antialiasing; + } + + 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 (p = r; p;) + { + if (!p->oblique_seen_p) + { + n = new haiku_font_pattern; + *n = *p; + + n->slant = SLANT_OBLIQUE; + + /* Opening a font by its indices doesn't provide enough + information to synthesize the oblique font later. */ + n->specified &= ~FSPEC_INDICES; + p->next = n; + p = p->next_family; + } + else + p = p->next_family; + } + } + + return r; +} + +/* Find and open a font with the family at FAMILY and the style at + STYLE, and set its size to SIZE. Value is NULL if opening the font + failed. */ +void * +be_open_font_at_index (int family, int style, float size) +{ + font_family family_name; + font_style style_name; + uint32 flags; + status_t rc; + BFont *font; + + rc = get_font_family (family, &family_name, &flags); + + if (rc != B_OK) + return NULL; + + rc = get_font_style (family_name, style, &style_name, &flags); + + if (rc != B_OK) + return NULL; + + font = new BFont; + + rc = font->SetFamilyAndStyle (family_name, style_name); + + if (rc != B_OK) + { + delete font; + return NULL; + } + + font->SetSize (size); + font->SetEncoding (B_UNICODE_UTF8); + font->SetSpacing (B_BITMAP_SPACING); + return font; +} + +/* 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, si, code; + font_family name; + font_style sname; + BFont *ft; + uint32 flags = 0; + struct haiku_font_pattern copy; + + 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)) + { + 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 (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)) + { + 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) + { + copy = *pat; + copy.slant = SLANT_REGULAR; + code = BFont_open_pattern (©, font, size); + + if (code) + return code; + + 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; +} + +void +be_init_font_data (void) +{ + memset (&font_object_cache, 0, sizeof font_object_cache); +} + +/* Free the font object cache. This is called every 50 updates of a + frame. */ +void +be_evict_font_cache (void) +{ + struct font_object_cache_bucket *bucket, *last; + int i; + + for (i = 0; i < 2048; ++i) + { + bucket = font_object_cache[i]; + + while (bucket) + { + last = bucket; + bucket = bucket->next; + delete last->font_object; + delete last; + } + + font_object_cache[i] = NULL; + } +} + +void +be_font_style_to_flags (char *style, struct haiku_font_pattern *pattern) +{ + pattern->specified = 0; + + font_style_to_flags (style, pattern); +} + +int +be_find_font_indices (struct haiku_font_pattern *pattern, + int *family_index, int *style_index) +{ + int32 i, j, n_families, n_styles; + font_family family; + font_style style; + uint32 flags; + + n_families = count_font_families (); + + for (i = 0; i < n_families; ++i) + { + if (get_font_family (i, &family, &flags) == B_OK) + { + n_styles = count_font_styles (family); + + for (j = 0; j < n_styles; ++j) + { + if (get_font_style (family, j, &style, &flags) == B_OK + && font_family_style_matches_p (family, style, + flags, pattern)) + { + *family_index = i; + *style_index = j; + + return 0; + } + } + } + } + + return 1; +} + +void +be_set_font_antialiasing (void *font, bool antialias_p) +{ + BFont *font_object; + + font_object = (BFont *) font; + font_object->SetFlags (antialias_p + ? B_FORCE_ANTIALIASING + : B_DISABLE_ANTIALIASING); +} diff --git a/src/haiku_io.c b/src/haiku_io.c new file mode 100644 index 00000000000..5cc70f6f71f --- /dev/null +++ b/src/haiku_io.c @@ -0,0 +1,213 @@ +/* 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; + +/* The port used to send replies to the application after a session + management event. */ +port_id port_emacs_to_session_manager; + +void +haiku_io_init (void) +{ + port_application_to_emacs = create_port (PORT_CAP, "application emacs port"); + port_emacs_to_session_manager = create_port (1, "session manager 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_CLICK: + return sizeof (struct haiku_menu_bar_click_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 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); + case SCREEN_CHANGED_EVENT: + return sizeof (struct haiku_screen_changed_event); + case CLIPBOARD_CHANGED_EVENT: + return sizeof (struct haiku_clipboard_changed_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"); +} diff --git a/src/haiku_select.cc b/src/haiku_select.cc new file mode 100644 index 00000000000..872da1d6c44 --- /dev/null +++ b/src/haiku_select.cc @@ -0,0 +1,519 @@ +/* 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 <Application.h> +#include <Clipboard.h> +#include <Message.h> +#include <Path.h> +#include <Entry.h> + +#include <cstdlib> +#include <cstring> + +#include "haikuselect.h" + +/* The clipboard object representing the primary selection. */ +static BClipboard *primary = NULL; + +/* The clipboard object representing the secondary selection. */ +static BClipboard *secondary = NULL; + +/* The clipboard object used by other programs, representing the + clipboard. */ +static BClipboard *system_clipboard = NULL; + +/* The number of times the system clipboard has changed. */ +static int64 count_clipboard = -1; + +/* The number of times the primary selection has changed. */ +static int64 count_primary = -1; + +/* The number of times the secondary selection has changed. */ +static int64 count_secondary = -1; + +/* Whether or not we currently think Emacs owns the primary + selection. */ +static bool owned_primary; + +/* Likewise for the secondary selection. */ +static bool owned_secondary; + +/* And the clipboard. */ +static bool owned_clipboard; + +static BClipboard * +get_clipboard_object (enum haiku_clipboard clipboard) +{ + switch (clipboard) + { + case CLIPBOARD_PRIMARY: + return primary; + + case CLIPBOARD_SECONDARY: + return secondary; + + case CLIPBOARD_CLIPBOARD: + return system_clipboard; + } + + abort (); +} + +static char * +be_find_clipboard_data_1 (BClipboard *cb, const char *type, ssize_t *len) +{ + BMessage *data; + const char *ptr; + ssize_t nbytes; + void *value; + + if (!cb->Lock ()) + return NULL; + + data = cb->Data (); + + if (!data) + { + cb->Unlock (); + return NULL; + } + + data->FindData (type, B_MIME_TYPE, (const void **) &ptr, + &nbytes); + + if (!ptr) + { + cb->Unlock (); + return NULL; + } + + if (len) + *len = nbytes; + + value = malloc (nbytes); + + if (!data) + { + cb->Unlock (); + return NULL; + } + + memcpy (value, ptr, nbytes); + cb->Unlock (); + + return (char *) value; +} + +static void +be_set_clipboard_data_1 (BClipboard *cb, const char *type, const char *data, + ssize_t len, bool clear) +{ + BMessage *message_data; + + if (!cb->Lock ()) + return; + + if (clear) + cb->Clear (); + + message_data = cb->Data (); + + if (!message_data) + { + cb->Unlock (); + return; + } + + if (data) + { + if (message_data->ReplaceData (type, B_MIME_TYPE, data, len) + == B_NAME_NOT_FOUND) + message_data->AddData (type, B_MIME_TYPE, data, len); + } + else + message_data->RemoveName (type); + + cb->Commit (); + cb->Unlock (); +} + +void +be_update_clipboard_count (enum haiku_clipboard id) +{ + switch (id) + { + case CLIPBOARD_CLIPBOARD: + count_clipboard = system_clipboard->SystemCount (); + owned_clipboard = true; + break; + + case CLIPBOARD_PRIMARY: + count_primary = primary->SystemCount (); + owned_primary = true; + break; + + case CLIPBOARD_SECONDARY: + count_secondary = secondary->SystemCount (); + owned_secondary = true; + break; + } +} + +char * +be_find_clipboard_data (enum haiku_clipboard id, const char *type, + ssize_t *len) +{ + return be_find_clipboard_data_1 (get_clipboard_object (id), + type, len); +} + +void +be_set_clipboard_data (enum haiku_clipboard id, const char *type, + const char *data, ssize_t len, bool clear) +{ + be_update_clipboard_count (id); + + be_set_clipboard_data_1 (get_clipboard_object (id), type, + data, len, clear); +} + +static bool +clipboard_owner_p (void) +{ + return (count_clipboard >= 0 + && (count_clipboard + 1 + == system_clipboard->SystemCount ())); +} + +static bool +primary_owner_p (void) +{ + return (count_primary >= 0 + && (count_primary + 1 + == primary->SystemCount ())); +} + +static bool +secondary_owner_p (void) +{ + return (count_secondary >= 0 + && (count_secondary + 1 + == secondary->SystemCount ())); +} + +bool +be_clipboard_owner_p (enum haiku_clipboard clipboard) +{ + switch (clipboard) + { + case CLIPBOARD_PRIMARY: + return primary_owner_p (); + + case CLIPBOARD_SECONDARY: + return secondary_owner_p (); + + case CLIPBOARD_CLIPBOARD: + return clipboard_owner_p (); + } + + abort (); +} + +void +be_clipboard_init (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; + + board = get_clipboard_object (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; + + board = get_clipboard_object (clipboard); + + if (discard) + board->Revert (); + else + board->Commit (); + + board->Unlock (); +} + +void +be_handle_clipboard_changed_message (void) +{ + int64 n_clipboard, n_primary, n_secondary; + + n_clipboard = system_clipboard->SystemCount (); + n_primary = primary->SystemCount (); + n_secondary = secondary->SystemCount (); + + if (count_clipboard != -1 + && (n_clipboard > count_clipboard + 1) + && owned_clipboard) + { + owned_clipboard = false; + haiku_selection_disowned (CLIPBOARD_CLIPBOARD, + n_clipboard); + } + + if (count_primary != -1 + && (n_primary > count_primary + 1) + && owned_primary) + { + owned_primary = false; + haiku_selection_disowned (CLIPBOARD_PRIMARY, + n_primary); + } + + if (count_secondary != -1 + && (n_secondary > count_secondary + 1) + && owned_secondary) + { + owned_secondary = false; + haiku_selection_disowned (CLIPBOARD_SECONDARY, + n_secondary); + } +} + +void +be_start_watching_selection (enum haiku_clipboard id) +{ + BClipboard *clipboard; + + clipboard = get_clipboard_object (id); + clipboard->StartWatching (be_app); +} + +bool +be_selection_outdated_p (enum haiku_clipboard id, int64 count) +{ + if (id == CLIPBOARD_CLIPBOARD && count_clipboard > count) + return true; + + if (id == CLIPBOARD_PRIMARY && count_primary > count) + return true; + + if (id == CLIPBOARD_SECONDARY && count_secondary > count) + return true; + + return false; +} + +int64 +be_get_clipboard_count (enum haiku_clipboard id) +{ + BClipboard *clipboard; + + clipboard = get_clipboard_object (id); + return clipboard->SystemCount (); +} diff --git a/src/haiku_support.cc b/src/haiku_support.cc new file mode 100644 index 00000000000..a3d3b7a17d3 --- /dev/null +++ b/src/haiku_support.cc @@ -0,0 +1,5422 @@ +/* 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 <attribute.h> + +#include <app/Application.h> +#include <app/Cursor.h> +#include <app/Clipboard.h> +#include <app/Messenger.h> +#include <app/Roster.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 <interface/ListView.h> +#include <interface/StringItem.h> +#include <interface/SplitView.h> +#include <interface/ScrollView.h> +#include <interface/StringView.h> +#include <interface/TextControl.h> +#include <interface/CheckBox.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 <support/ObjectList.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> + +#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, + REPLAY_MENU_BAR = 3007, + FONT_FAMILY_SELECTED = 3008, + FONT_STYLE_SELECTED = 3009, + FILE_PANEL_SELECTION = 3010, + QUIT_PREVIEW_DIALOG = 3011, + SET_FONT_INDICES = 3012, + SET_PREVIEW_DIALOG = 3013, + UPDATE_PREVIEW_DIALOG = 3014, + SEND_MOVE_FRAME_EVENT = 3015, + SET_DISABLE_ANTIALIASING = 3016, + }; + +/* 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, + }; + +struct font_selection_dialog_message +{ + /* Whether or not font selection was cancelled. */ + bool_bf cancel : 1; + + /* Whether or not a size was explicitly specified. */ + bool_bf size_specified : 1; + + /* Whether or not antialiasing should be disabled. */ + bool_bf disable_antialias : 1; + + /* The index of the selected font family. */ + int family_idx; + + /* The index of the selected font style. */ + int style_idx; + + /* The selected font size. */ + int size; +}; + +/* The color space of the main screen. B_NO_COLOR_SPACE means it has + not yet been computed. */ +static color_space dpy_color_space = B_NO_COLOR_SPACE; + +/* The keymap, or NULL if it has not been initialized. */ +static key_map *key_map; + +/* Indices of characters into the keymap. */ +static char *key_chars; + +/* Lock around keymap data, since it's touched from different + threads. */ +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; + +/* Variable where the popup menu thread returns the chosen menu + item. */ +static BMessage volatile *popup_track_message; + +/* Variable in which alert dialog threads return the selected button + number. */ +static int32 volatile alert_popup_value; + +/* The current window ID. This is increased every time a frame is + created. */ +static int current_window_id; + +/* The view that has the passive grab. */ +static void *grab_view; + +/* The locker for that variable. */ +static BLocker grab_view_locker; + +/* Whether or not a drag-and-drop operation is in progress. */ +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 *); + +/* The ID of the thread the BApplication is running in. */ +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."); + 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 (); +} + +static BRect +get_zoom_rect (BWindow *window) +{ + BScreen screen; + 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; + } + } + + if (window) + { + window_frame = window->Frame (); + decorator_frame = window->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; +} + +/* Invisible window used to get B_SCREEN_CHANGED events. */ +class EmacsScreenChangeMonitor : public BWindow +{ + BRect previous_screen_frame; + +public: + EmacsScreenChangeMonitor (void) : BWindow (BRect (-100, -100, 0, 0), "", + B_NO_BORDER_WINDOW_LOOK, + B_FLOATING_ALL_WINDOW_FEEL, + B_AVOID_FRONT | B_AVOID_FOCUS) + { + BScreen screen (this); + + if (!screen.IsValid ()) + return; + + previous_screen_frame = screen.Frame (); + + /* Immediately show this window upon creation. It will not steal + the focus or become visible. */ + Show (); + + if (!LockLooper ()) + return; + + Hide (); + UnlockLooper (); + } + + void + DispatchMessage (BMessage *msg, BHandler *handler) + { + struct haiku_screen_changed_event rq; + BRect frame; + + if (msg->what == B_SCREEN_CHANGED) + { + if (msg->FindInt64 ("when", &rq.when) != B_OK) + rq.when = 0; + + if (msg->FindRect ("frame", &frame) != B_OK + || frame != previous_screen_frame) + { + haiku_write (SCREEN_CHANGED_EVENT, &rq); + + if (frame.IsValid ()) + previous_screen_frame = frame; + } + } + + BWindow::DispatchMessage (msg, handler); + } +}; + +class Emacs : public BApplication +{ +public: + BMessage settings; + bool settings_valid_p; + EmacsScreenChangeMonitor *monitor; + + Emacs (void) : BApplication ("application/x-vnd.GNU-emacs"), + settings_valid_p (false) + { + 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; + monitor = new EmacsScreenChangeMonitor; + } + + ~Emacs (void) + { + if (monitor->LockLooper ()) + monitor->Quit (); + else + delete monitor; + } + + 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; + struct haiku_session_manager_reply reply; + int32 reply_type; + + haiku_write (APP_QUIT_REQUESTED_EVENT, &rq); + + if (read_port (port_emacs_to_session_manager, + &reply_type, &reply, sizeof reply) < B_OK) + /* Return true so the system kills us, since there's no real + alternative if this read fails. */ + return true; + + return reply.quit_reply; + } + + void + MessageReceived (BMessage *msg) + { + struct haiku_clipboard_changed_event rq; + + if (msg->what == QUIT_APPLICATION) + Quit (); + else if (msg->what == B_CLIPBOARD_CHANGED) + haiku_write (CLIPBOARD_CHANGED_EVENT, &rq); + else + BApplication::MessageReceived (msg); + } +}; + +class EmacsWindow : public BWindow +{ +public: + struct child_frame + { + struct child_frame *next; + int xoff, yoff; + EmacsWindow *window; + } *subset_windows; + + EmacsWindow *parent; + BRect pre_fullscreen_rect; + BRect pre_zoom_rect; + int x_before_zoom; + int y_before_zoom; + bool shown_flag; + volatile bool was_shown_p; + bool menu_bar_active_p; + bool override_redirect_p; + window_look pre_override_redirect_look; + window_feel pre_override_redirect_feel; + uint32 pre_override_redirect_workspaces; + int window_id; + bool *menus_begun; + enum haiku_z_group z_group; + bool tooltip_p; + enum haiku_fullscreen_mode fullscreen_mode; + + EmacsWindow () : BWindow (BRect (0, 0, 0, 0), "", B_TITLED_WINDOW_LOOK, + B_NORMAL_WINDOW_FEEL, B_NO_SERVER_SIDE_WINDOW_MODIFIERS), + subset_windows (NULL), + parent (NULL), + x_before_zoom (INT_MIN), + y_before_zoom (INT_MIN), + shown_flag (false), + was_shown_p (false), + menu_bar_active_p (false), + override_redirect_p (false), + window_id (current_window_id), + menus_begun (NULL), + z_group (Z_GROUP_NONE), + tooltip_p (false), + fullscreen_mode (FULLSCREEN_MODE_NONE) + { + /* 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 (); + } + + void + RecomputeFeel (void) + { + if (override_redirect_p || tooltip_p) + SetFeel (kMenuWindowFeel); + else if (parent) + SetFeel (B_FLOATING_SUBSET_WINDOW_FEEL); + else if (z_group == Z_GROUP_ABOVE) + SetFeel (B_FLOATING_ALL_WINDOW_FEEL); + else + SetFeel (B_NORMAL_WINDOW_FEEL); + } + + 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) + { + EmacsWindow *parent; + + if (!child_frame_lock.Lock ()) + gui_abort ("Failed to lock child frame state lock"); + + parent = this->parent; + this->parent = NULL; + RecomputeFeel (); + UpwardsUnSubsetChildren (parent); + this->RemoveFromSubset (this); + 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; + RecomputeFeel (); + this->AddToSubset (this); + if (!IsHidden () && this->parent) + UpwardsSubsetChildren (parent); + 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 + MoveToIncludingFrame (int x, int y) + { + BRect decorator, frame; + + decorator = DecoratorFrame (); + frame = Frame (); + + MoveTo (x + frame.left - decorator.left, + y + frame.top - decorator.top); + } + + void + DoMove (struct child_frame *f) + { + BRect frame = this->Frame (); + f->window->MoveToIncludingFrame (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) + { + 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 + 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 if (msg->what == SEND_MOVE_FRAME_EVENT) + FrameMoved (Frame ().LeftTop ()); + else if (msg->what == B_SCREEN_CHANGED) + { + if (fullscreen_mode != FULLSCREEN_MODE_NONE) + SetFullscreen (fullscreen_mode); + + BWindow::DispatchMessage (msg, handler); + } + else + BWindow::DispatchMessage (msg, handler); + } + + void + MenusBeginning (void) + { + struct haiku_menu_bar_state_event rq; + + rq.window = this; + if (!menus_begun) + haiku_write (MENU_BAR_OPEN, &rq); + 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.width = newWidth + 1.0f; + rq.height = newHeight + 1.0f; + + haiku_write (FRAME_RESIZED, &rq); + BWindow::FrameResized (newWidth, newHeight); + } + + void + FrameMoved (BPoint new_position) + { + struct haiku_move_event rq; + BRect frame, decorator_frame; + struct child_frame *f; + + if (fullscreen_mode == FULLSCREEN_MODE_WIDTH + && new_position.x != 0) + { + MoveTo (0, new_position.y); + return; + } + + if (fullscreen_mode == FULLSCREEN_MODE_HEIGHT + && new_position.y != 0) + { + MoveTo (new_position.x, 0); + return; + } + + rq.window = this; + rq.x = std::lrint (new_position.x); + rq.y = std::lrint (new_position.y); + + frame = Frame (); + decorator_frame = DecoratorFrame (); + + rq.decorator_width + = std::lrint (frame.left - decorator_frame.left); + rq.decorator_height + = std::lrint (frame.top - decorator_frame.top); + + haiku_write (MOVE_EVENT, &rq); + + CHILD_FRAME_LOCK_INSIDE_LOOPER_CALLBACK + { + for (f = subset_windows; f; f = f->next) + DoMove (f); + child_frame_lock.Unlock (); + + BWindow::FrameMoved (new_position); + } + } + + void + WorkspacesChanged (uint32_t old, uint32_t n) + { + struct child_frame *f; + + CHILD_FRAME_LOCK_INSIDE_LOOPER_CALLBACK + { + for (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->MoveToIncludingFrame (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) + { + struct haiku_iconification_event rq; + + rq.window = this; + rq.iconified_p = !parent && minimized_p; + haiku_write (ICONIFICATION, &rq); + + BWindow::Minimize (minimized_p); + } + + 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 (); + } + + BRect + ClearFullscreen (enum haiku_fullscreen_mode target_mode) + { + BRect original_frame; + + switch (fullscreen_mode) + { + case FULLSCREEN_MODE_MAXIMIZED: + original_frame = pre_zoom_rect; + + if (target_mode == FULLSCREEN_MODE_NONE) + BWindow::Zoom (pre_zoom_rect.LeftTop (), + BE_RECT_WIDTH (pre_zoom_rect) - 1, + BE_RECT_HEIGHT (pre_zoom_rect) - 1); + break; + + case FULLSCREEN_MODE_BOTH: + case FULLSCREEN_MODE_HEIGHT: + case FULLSCREEN_MODE_WIDTH: + original_frame = pre_fullscreen_rect; + SetFlags (Flags () & ~(B_NOT_MOVABLE + | B_NOT_ZOOMABLE + | B_NOT_RESIZABLE)); + + if (target_mode != FULLSCREEN_MODE_NONE) + goto out; + + MoveTo (pre_fullscreen_rect.LeftTop ()); + ResizeTo (BE_RECT_WIDTH (pre_fullscreen_rect) - 1, + BE_RECT_HEIGHT (pre_fullscreen_rect) - 1); + break; + + case FULLSCREEN_MODE_NONE: + original_frame = Frame (); + break; + } + + out: + fullscreen_mode = FULLSCREEN_MODE_NONE; + return original_frame; + } + + BRect + FullscreenRectForMode (enum haiku_fullscreen_mode mode) + { + BScreen screen (this); + BRect frame; + + if (!screen.IsValid ()) + return BRect (0, 0, 0, 0); + + frame = screen.Frame (); + + if (mode == FULLSCREEN_MODE_HEIGHT) + frame.right -= BE_RECT_WIDTH (frame) / 2; + else if (mode == FULLSCREEN_MODE_WIDTH) + frame.bottom -= BE_RECT_HEIGHT (frame) / 2; + + return frame; + } + + void + SetFullscreen (enum haiku_fullscreen_mode mode) + { + BRect zoom_rect, frame; + + frame = ClearFullscreen (mode); + + switch (mode) + { + case FULLSCREEN_MODE_MAXIMIZED: + pre_zoom_rect = frame; + zoom_rect = get_zoom_rect (this); + BWindow::Zoom (zoom_rect.LeftTop (), + BE_RECT_WIDTH (zoom_rect) - 1, + BE_RECT_HEIGHT (zoom_rect) - 1); + break; + + case FULLSCREEN_MODE_BOTH: + SetFlags (Flags () | B_NOT_MOVABLE); + FALLTHROUGH; + + case FULLSCREEN_MODE_HEIGHT: + case FULLSCREEN_MODE_WIDTH: + SetFlags (Flags () | B_NOT_ZOOMABLE | B_NOT_RESIZABLE); + pre_fullscreen_rect = frame; + zoom_rect = FullscreenRectForMode (mode); + ResizeTo (BE_RECT_WIDTH (zoom_rect) - 1, + BE_RECT_HEIGHT (zoom_rect) - 1); + MoveTo (zoom_rect.left, zoom_rect.top); + break; + + case FULLSCREEN_MODE_NONE: + break; + } + + fullscreen_mode = mode; + } + + void + Zoom (BPoint origin, float width, float height) + { + struct haiku_zoom_event rq; + + rq.window = this; + rq.fullscreen_mode = fullscreen_mode; + haiku_write (ZOOM_EVENT, &rq); + } + + 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"); + } +}; + +class EmacsMenuBar : public BMenuBar +{ + bool tracking_p; + +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 + 1); + rq.width = std::lrint (newWidth + 1); + + haiku_write (MENU_BAR_RESIZE, &rq); + BMenuBar::FrameResized (newWidth, newHeight); + } + + void + MouseDown (BPoint point) + { + struct haiku_menu_bar_click_event rq; + EmacsWindow *ew = (EmacsWindow *) Window (); + + rq.window = ew; + rq.x = std::lrint (point.x); + rq.y = std::lrint (point.y); + + if (!ew->menu_bar_active_p) + haiku_write (MENU_BAR_CLICK, &rq); + else + BMenuBar::MouseDown (point); + } + + 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 (); + + haiku_write (MENU_BAR_LEFT, &rq); + } + + 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); + BMenuBar::MouseDown (l); + window->menus_begun = NULL; + + if (!menus_begun) + msg->SendReply (msg); + else + msg->SendReply (BE_MENU_BAR_OPEN); + } + else if (msg->what == REPLAY_MENU_BAR) + { + window = (EmacsWindow *) Window (); + menus_begun = false; + window->menus_begun = &menus_begun; + + if (msg->FindPoint ("emacs:point", &pt) == B_OK) + BMenuBar::MouseDown (pt); + + 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; + int looper_locked_count; + BRegion sb_region; + BRegion invalid_region; + + BView *offscreen_draw_view; + BBitmap *offscreen_draw_bitmap_1; + BBitmap *copy_bitmap; + +#ifdef USE_BE_CAIRO + cairo_surface_t *cr_surface; + cairo_t *cr_context; + BLocker cr_surface_lock; +#endif + + BMessage *wait_for_release_message; + + EmacsView () : BView (BRect (0, 0, 0, 0), "Emacs", + B_FOLLOW_NONE, B_WILL_DRAW), + previous_buttons (0), + looper_locked_count (0), + offscreen_draw_view (NULL), + offscreen_draw_bitmap_1 (NULL), + copy_bitmap (NULL), +#ifdef USE_BE_CAIRO + cr_surface (NULL), + cr_context (NULL), +#endif + wait_for_release_message (NULL) + { + + } + + ~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 + 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 (), B_RGBA32, 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); + SetViewBitmap (copy_bitmap, Frame (), + Frame (), B_FOLLOW_NONE, 0); + } + else + copy_bitmap->ImportBits (offscreen_draw_bitmap_1); + + if (copy_bitmap->InitCheck () != B_OK) + gui_abort ("Failed to init copy bitmap during buffer flip"); + + 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 (), B_RGBA32, 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 (); + + if (transit == B_EXITED_VIEW) + rq.just_exited_p = true; + else + rq.just_exited_p = false; + + 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 (!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 (); + + haiku_write (MOUSE_MOTION, &rq); + } + + void + BasicMouseDown (BPoint point, BView *scroll_bar) + { + struct haiku_button_event rq; + uint32 mods, 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 (); + rq.scroll_bar = scroll_bar; + + 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; + + 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 (!scroll_bar) + SetMouseEventMask (B_POINTER_EVENTS, (B_LOCK_WINDOW_FOCUS + | B_NO_POINTER_HISTORY)); + + rq.time = system_time (); + haiku_write (BUTTON_DOWN, &rq); + } + + void + MouseDown (BPoint point) + { + BasicMouseDown (point, NULL); + } + + void + BasicMouseUp (BPoint point, BView *scroll_bar) + { + struct haiku_button_event rq; + uint32 buttons, mods; + + 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 (); + rq.scroll_bar = scroll_bar; + + 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; + + 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; + + rq.time = system_time (); + haiku_write (BUTTON_UP, &rq); + } + + void + MouseUp (BPoint point) + { + BasicMouseUp (point, NULL); + } +}; + +class EmacsScrollBar : public BScrollBar +{ +public: + int dragging; + 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; + bool in_overscroll; + bool can_overscroll; + bool maybe_overscroll; + BPoint last_overscroll; + int last_reported_overscroll_value; + int max_value, real_max_value; + int overscroll_start_value; + bigtime_t repeater_start; + EmacsView *parent; + + EmacsScrollBar (int x, int y, int x1, int y1, bool horizontal_p, + EmacsView *parent) + : BScrollBar (BRect (x, y, x1, y1), NULL, NULL, 0, 0, horizontal_p ? + B_HORIZONTAL : B_VERTICAL), + dragging (0), + handle_button (false), + in_overscroll (false), + can_overscroll (false), + maybe_overscroll (false), + parent (parent) + { + 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; + + 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; + SetMouseEventMask (B_POINTER_EVENTS, (B_SUSPEND_VIEW_FOCUS + | B_LOCK_WINDOW_FOCUS)); + parent->BasicMouseDown (ConvertToParent (pt), this); + + 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; + + in_overscroll = false; + maybe_overscroll = false; + + if (handle_button) + { + handle_button = false; + parent->BasicMouseUp (ConvertToParent (pt), this); + + 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 (); + + haiku_write (MENU_BAR_LEFT, &rq); + } + + 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); + menu->SetHighColor (ui_color (B_MENU_ITEM_TEXT_COLOR)); + BMenuItem::DrawContent (); + menu->PopState (); + } +}; + +class EmacsMenuItem : public BMenuItem +{ +public: + int menu_bar_id; + void *menu_ptr; + void *wind_ptr; + char *key; + char *help; + + EmacsMenuItem (const char *key_label, const char *label, + const char *help, BMessage *message = NULL) + : BMenuItem (label, message), + menu_bar_id (-1), + menu_ptr (NULL), + wind_ptr (NULL), + key (NULL), + help (NULL) + { + if (key_label) + key = strdup (key_label); + + if (help) + this->help = strdup (help); + } + + ~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 EmacsFontPreviewDialog : public BWindow +{ + BStringView text_view; + BMessenger preview_source; + BFont *current_font; + bool is_visible; + + void + DoLayout (void) + { + float width, height; + + text_view.GetPreferredSize (&width, &height); + text_view.ResizeTo (width - 1, height - 1); + + SetSizeLimits (width, width, height, height); + ResizeTo (width - 1, height - 1); + } + + bool + QuitRequested (void) + { + preview_source.SendMessage (QUIT_PREVIEW_DIALOG); + + return false; + } + + void + MessageReceived (BMessage *message) + { + int32 family, style; + uint32 flags; + font_family name; + font_style sname; + status_t rc; + const char *size_name; + int size; + + if (message->what == SET_FONT_INDICES) + { + size_name = message->FindString ("emacs:size"); + + if (message->FindInt32 ("emacs:family", &family) != B_OK + || message->FindInt32 ("emacs:style", &style) != B_OK) + return; + + rc = get_font_family (family, &name, &flags); + + if (rc != B_OK) + return; + + rc = get_font_style (name, style, &sname, &flags); + + if (rc != B_OK) + return; + + if (current_font) + delete current_font; + + current_font = new BFont; + current_font->SetFamilyAndStyle (name, sname); + + if (message->GetBool ("emacs:disable_antialiasing", false)) + current_font->SetFlags (B_DISABLE_ANTIALIASING); + + if (size_name && strlen (size_name)) + { + size = atoi (size_name); + current_font->SetSize (size); + } + + text_view.SetFont (current_font); + DoLayout (); + return; + } + + BWindow::MessageReceived (message); + } + +public: + + EmacsFontPreviewDialog (BWindow *target) + : BWindow (BRect (45, 45, 500, 300), + "Preview font", + B_FLOATING_WINDOW_LOOK, + B_MODAL_APP_WINDOW_FEEL, + B_NOT_ZOOMABLE | B_NOT_RESIZABLE), + text_view (BRect (0, 0, 0, 0), + NULL, "The quick brown fox " + "jumped over the lazy dog"), + preview_source (target), + current_font (NULL) + { + AddChild (&text_view); + DoLayout (); + } + + ~EmacsFontPreviewDialog (void) + { + text_view.RemoveSelf (); + + if (current_font) + delete current_font; + } +}; + +class TripleLayoutView : public BView +{ + BScrollView *view_1; + BView *view_2, *view_3; + + void + FrameResized (float new_width, float new_height) + { + BRect frame; + float width, height, height_1, width_1; + float basic_height; + + frame = Frame (); + + view_2->GetPreferredSize (&width, &height); + view_3->GetPreferredSize (&width_1, &height_1); + + basic_height = height + height_1; + + view_1->MoveTo (0, 0); + view_1->ResizeTo (BE_RECT_WIDTH (frame), + BE_RECT_HEIGHT (frame) - basic_height); + view_2->MoveTo (2, BE_RECT_HEIGHT (frame) - basic_height); + view_2->ResizeTo (BE_RECT_WIDTH (frame) - 4, height); + view_3->MoveTo (2, BE_RECT_HEIGHT (frame) - height_1); + view_3->ResizeTo (BE_RECT_WIDTH (frame) - 4, height_1); + + BView::FrameResized (new_width, new_height); + } + + /* This is called by the BSplitView. */ + BSize + MinSize (void) + { + float width, height; + float width_1, height_1; + BSize size_1; + + size_1 = view_1->MinSize (); + view_2->GetPreferredSize (&width, &height); + view_3->GetPreferredSize (&width_1, &height_1); + + return BSize (std::max (size_1.width, + std::max (width_1, width)), + std::max (size_1.height, height + height_1)); + } + +public: + TripleLayoutView (BScrollView *first, BView *second, + BView *third) : BView (NULL, B_FRAME_EVENTS), + view_1 (first), + view_2 (second), + view_3 (third) + { + FrameResized (801, 801); + } +}; + +class EmacsFontSelectionDialog : public BWindow +{ + BView basic_view; + BCheckBox antialias_checkbox; + BCheckBox preview_checkbox; + BSplitView split_view; + BListView font_family_pane; + BListView font_style_pane; + BScrollView font_family_scroller; + BScrollView font_style_scroller; + TripleLayoutView style_view; + BObjectList<BStringItem> all_families; + BObjectList<BStringItem> all_styles; + BButton cancel_button, ok_button; + BTextControl size_entry; + port_id comm_port; + bool allow_monospace_only; + int pending_selection_idx; + EmacsFontPreviewDialog *preview; + + void + ShowPreview (void) + { + if (!preview) + { + preview = new EmacsFontPreviewDialog (this); + preview->Show (); + + UpdatePreview (); + } + } + + void + UpdatePreview (void) + { + int family, style; + BMessage message; + BMessenger messenger (preview); + + family = font_family_pane.CurrentSelection (); + style = font_style_pane.CurrentSelection (); + + message.what = SET_FONT_INDICES; + message.AddInt32 ("emacs:family", family); + message.AddInt32 ("emacs:style", style); + + if (antialias_checkbox.Value () == B_CONTROL_ON) + message.AddBool ("emacs:disable_antialiasing", true); + + message.AddString ("emacs:size", + size_entry.Text ()); + + messenger.SendMessage (&message); + } + + void + HidePreview (void) + { + if (preview) + { + if (preview->LockLooper ()) + preview->Quit (); + /* I hope this works. */ + else + delete preview; + + preview = NULL; + } + } + + void + UpdateStylesForIndex (int idx) + { + int n, i, previous_selection; + uint32 flags; + font_family family; + font_style style; + BStringItem *item; + char *current_style; + + n = all_styles.CountItems (); + current_style = NULL; + previous_selection = font_style_pane.CurrentSelection (); + + if (previous_selection >= 0) + { + item = all_styles.ItemAt (previous_selection); + current_style = strdup (item->Text ()); + } + + font_style_pane.MakeEmpty (); + all_styles.MakeEmpty (); + + if (get_font_family (idx, &family, &flags) == B_OK) + { + n = count_font_styles (family); + + for (i = 0; i < n; ++i) + { + if (get_font_style (family, i, &style, &flags) == B_OK) + item = new BStringItem (style); + else + item = new BStringItem ("<error>"); + + if (current_style && pending_selection_idx < 0 + && !strcmp (current_style, style)) + pending_selection_idx = i; + + font_style_pane.AddItem (item); + all_styles.AddItem (item); + } + } + + if (pending_selection_idx >= 0) + { + font_style_pane.Select (pending_selection_idx); + font_style_pane.ScrollToSelection (); + } + + pending_selection_idx = -1; + UpdateForSelectedStyle (); + + if (current_style) + free (current_style); + } + + bool + QuitRequested (void) + { + struct font_selection_dialog_message rq; + + rq.cancel = true; + write_port (comm_port, 0, &rq, sizeof rq); + + return false; + } + + void + UpdateForSelectedStyle (void) + { + int style = font_style_pane.CurrentSelection (); + + if (style < 0) + ok_button.SetEnabled (false); + else + ok_button.SetEnabled (true); + + if (style >= 0 && preview) + UpdatePreview (); + } + + void + MessageReceived (BMessage *msg) + { + const char *text; + int idx; + struct font_selection_dialog_message rq; + + if (msg->what == FONT_FAMILY_SELECTED) + { + idx = font_family_pane.CurrentSelection (); + UpdateStylesForIndex (idx); + } + else if (msg->what == FONT_STYLE_SELECTED) + UpdateForSelectedStyle (); + else if (msg->what == B_OK + && font_style_pane.CurrentSelection () >= 0) + { + text = size_entry.Text (); + + rq.cancel = false; + rq.family_idx = font_family_pane.CurrentSelection (); + rq.style_idx = font_style_pane.CurrentSelection (); + rq.size = atoi (text); + rq.size_specified = rq.size > 0 || strlen (text); + + if (antialias_checkbox.Value () == B_CONTROL_ON) + rq.disable_antialias = true; + else + rq.disable_antialias = false; + + write_port (comm_port, 0, &rq, sizeof rq); + } + else if (msg->what == B_CANCEL) + { + rq.cancel = true; + + write_port (comm_port, 0, &rq, sizeof rq); + } + else if (msg->what == SET_PREVIEW_DIALOG) + { + if (preview_checkbox.Value () == B_CONTROL_OFF) + HidePreview (); + else + ShowPreview (); + } + else if (msg->what == QUIT_PREVIEW_DIALOG) + { + preview_checkbox.SetValue (B_CONTROL_OFF); + HidePreview (); + } + else if (msg->what == UPDATE_PREVIEW_DIALOG) + { + if (preview) + UpdatePreview (); + } + else if (msg->what == SET_DISABLE_ANTIALIASING) + { + if (preview) + UpdatePreview (); + } + + BWindow::MessageReceived (msg); + } + +public: + + ~EmacsFontSelectionDialog (void) + { + if (preview) + { + if (preview->LockLooper ()) + preview->Quit (); + /* I hope this works. */ + else + delete preview; + } + + font_family_pane.MakeEmpty (); + font_style_pane.MakeEmpty (); + + font_family_pane.RemoveSelf (); + font_style_pane.RemoveSelf (); + antialias_checkbox.RemoveSelf (); + preview_checkbox.RemoveSelf (); + style_view.RemoveSelf (); + font_family_scroller.RemoveSelf (); + font_style_scroller.RemoveSelf (); + cancel_button.RemoveSelf (); + ok_button.RemoveSelf (); + size_entry.RemoveSelf (); + basic_view.RemoveSelf (); + + if (comm_port >= B_OK) + delete_port (comm_port); + } + + EmacsFontSelectionDialog (bool monospace_only, + int initial_family_idx, + int initial_style_idx, + int initial_size, + bool initial_antialias) + : BWindow (BRect (0, 0, 500, 500), + "Select font from list", + B_TITLED_WINDOW_LOOK, + B_MODAL_APP_WINDOW_FEEL, 0), + basic_view (NULL, 0), + antialias_checkbox ("Disable antialiasing", "Disable antialiasing", + new BMessage (SET_DISABLE_ANTIALIASING)), + preview_checkbox ("Show preview", "Show preview", + new BMessage (SET_PREVIEW_DIALOG)), + font_family_pane (BRect (0, 0, 0, 0), NULL, + B_SINGLE_SELECTION_LIST, + B_FOLLOW_ALL_SIDES), + font_style_pane (BRect (0, 0, 0, 0), NULL, + B_SINGLE_SELECTION_LIST, + B_FOLLOW_ALL_SIDES), + font_family_scroller (NULL, &font_family_pane, + B_FOLLOW_LEFT | B_FOLLOW_TOP, + 0, false, true), + font_style_scroller (NULL, &font_style_pane, + B_FOLLOW_ALL_SIDES, + B_SUPPORTS_LAYOUT, false, true), + style_view (&font_style_scroller, &antialias_checkbox, + &preview_checkbox), + all_families (20, true), + all_styles (20, true), + cancel_button ("Cancel", "Cancel", + new BMessage (B_CANCEL)), + ok_button ("OK", "OK", new BMessage (B_OK)), + size_entry (NULL, "Size:", NULL, + new BMessage (UPDATE_PREVIEW_DIALOG)), + allow_monospace_only (monospace_only), + pending_selection_idx (initial_style_idx), + preview (NULL) + { + BStringItem *family_item; + int i, n_families; + font_family name; + uint32 flags, c; + BMessage *selection; + BTextView *size_text; + char format_buffer[4]; + + AddChild (&basic_view); + + basic_view.AddChild (&split_view); + basic_view.AddChild (&cancel_button); + basic_view.AddChild (&ok_button); + basic_view.AddChild (&size_entry); + split_view.AddChild (&font_family_scroller, 0.7); + split_view.AddChild (&style_view, 0.3); + style_view.AddChild (&font_style_scroller); + style_view.AddChild (&antialias_checkbox); + style_view.AddChild (&preview_checkbox); + + basic_view.SetViewUIColor (B_PANEL_BACKGROUND_COLOR); + style_view.SetViewUIColor (B_PANEL_BACKGROUND_COLOR); + + FrameResized (801, 801); + UpdateForSelectedStyle (); + + selection = new BMessage (FONT_FAMILY_SELECTED); + font_family_pane.SetSelectionMessage (selection); + selection = new BMessage (FONT_STYLE_SELECTED); + font_style_pane.SetSelectionMessage (selection); + selection = new BMessage (B_OK); + font_style_pane.SetInvocationMessage (selection); + selection = new BMessage (UPDATE_PREVIEW_DIALOG); + size_entry.SetModificationMessage (selection); + + comm_port = create_port (1, "font dialog port"); + + n_families = count_font_families (); + + for (i = 0; i < n_families; ++i) + { + if (get_font_family (i, &name, &flags) == B_OK) + { + family_item = new BStringItem (name); + + all_families.AddItem (family_item); + font_family_pane.AddItem (family_item); + + family_item->SetEnabled (!allow_monospace_only + || flags & B_IS_FIXED); + } + else + { + family_item = new BStringItem ("<error>"); + + all_families.AddItem (family_item); + font_family_pane.AddItem (family_item); + } + } + + if (initial_family_idx >= 0) + { + font_family_pane.Select (initial_family_idx); + font_family_pane.ScrollToSelection (); + } + + size_text = size_entry.TextView (); + + for (c = 0; c <= 47; ++c) + size_text->DisallowChar (c); + + for (c = 58; c <= 127; ++c) + size_text->DisallowChar (c); + + if (initial_size > 0 && initial_size < 1000) + { + sprintf (format_buffer, "%d", initial_size); + size_entry.SetText (format_buffer); + } + + if (!initial_antialias) + antialias_checkbox.SetValue (B_CONTROL_ON); + } + + void + FrameResized (float new_width, float new_height) + { + BRect frame; + float ok_height, ok_width; + float cancel_height, cancel_width; + float size_width, size_height; + float bone; + int max_height; + + ok_button.GetPreferredSize (&ok_width, &ok_height); + cancel_button.GetPreferredSize (&cancel_width, + &cancel_height); + size_entry.GetPreferredSize (&size_width, &size_height); + + max_height = std::max (std::max (ok_height, cancel_height), + size_height); + + SetSizeLimits (cancel_width + ok_width + size_width + 6, + 65535, max_height + 64, 65535); + frame = Frame (); + + basic_view.ResizeTo (BE_RECT_WIDTH (frame), BE_RECT_HEIGHT (frame)); + split_view.ResizeTo (BE_RECT_WIDTH (frame) - 1, + BE_RECT_HEIGHT (frame) - 4 - max_height); + + bone = BE_RECT_HEIGHT (frame) - 2 - max_height / 2; + + ok_button.MoveTo ((BE_RECT_WIDTH (frame) + - 4 - cancel_width - ok_width), + bone - ok_height / 2); + cancel_button.MoveTo (BE_RECT_WIDTH (frame) - 2 - cancel_width, + bone - cancel_height / 2); + size_entry.MoveTo (2, bone - size_height / 2); + + ok_button.ResizeTo (ok_width, ok_height); + cancel_button.ResizeTo (cancel_width, cancel_height); + size_entry.ResizeTo (std::max (size_width, + BE_RECT_WIDTH (frame) / 4), + size_height); + } + + void + WaitForChoice (struct font_selection_dialog_message *msg, + void (*process_pending_signals_function) (void), + bool (*should_quit_function) (void)) + { + int32 reply_type; + struct object_wait_info infos[2]; + ssize_t status; + + infos[0].object = port_application_to_emacs; + infos[0].type = B_OBJECT_TYPE_PORT; + infos[0].events = B_EVENT_READ; + + infos[1].object = comm_port; + infos[1].type = B_OBJECT_TYPE_PORT; + infos[1].events = B_EVENT_READ; + + while (true) + { + status = wait_for_objects (infos, 2); + + if (status < B_OK) + continue; + + if (infos[1].events & B_EVENT_READ) + { + if (read_port (comm_port, &reply_type, + msg, sizeof *msg) >= B_OK) + return; + + goto cancel; + } + + if (infos[0].events & B_EVENT_READ) + process_pending_signals_function (); + + if (should_quit_function ()) + goto cancel; + + infos[0].events = B_EVENT_READ; + infos[1].events = B_EVENT_READ; + } + + cancel: + msg->cancel = true; + return; + } + + status_t + InitCheck (void) + { + return comm_port >= B_OK ? B_OK : comm_port; + } +}; + +class EmacsFilePanelCallbackLooper : public BLooper +{ + port_id comm_port; + + void + MessageReceived (BMessage *msg) + { + const char *str_path, *name; + char *file_name, *str_buf; + BEntry entry; + BPath path; + entry_ref ref; + int32 old_what; + + if (msg->what == FILE_PANEL_SELECTION + || ((msg->FindInt32 ("old_what", &old_what) == B_OK + && old_what == FILE_PANEL_SELECTION))) + { + file_name = NULL; + + if (msg->FindRef ("refs", &ref) == B_OK + && entry.SetTo (&ref, 0) == B_OK + && entry.GetPath (&path) == B_OK) + { + str_path = path.Path (); + + if (str_path) + file_name = strdup (str_path); + } + else if (msg->FindRef ("directory", &ref) == B_OK + && entry.SetTo (&ref, 0) == B_OK + && entry.GetPath (&path) == B_OK) + { + name = msg->GetString ("name"); + str_path = path.Path (); + + if (name) + { + str_buf = (char *) alloca (std::strlen (str_path) + + std::strlen (name) + 2); + snprintf (str_buf, std::strlen (str_path) + + std::strlen (name) + 2, "%s/%s", + str_path, name); + file_name = strdup (str_buf); + } + } + + write_port (comm_port, 0, &file_name, sizeof file_name); + } + + BLooper::MessageReceived (msg); + } + +public: + EmacsFilePanelCallbackLooper (void) : BLooper () + { + comm_port = create_port (1, "file panel port"); + } + + ~EmacsFilePanelCallbackLooper (void) + { + delete_port (comm_port); + } + + char * + ReadFileName (void (*process_pending_signals_function) (void)) + { + object_wait_info infos[2]; + ssize_t status; + int32 reply_type; + char *file_name; + + file_name = NULL; + + infos[0].object = port_application_to_emacs; + infos[0].type = B_OBJECT_TYPE_PORT; + infos[0].events = B_EVENT_READ; + + infos[1].object = comm_port; + infos[1].type = B_OBJECT_TYPE_PORT; + infos[1].events = B_EVENT_READ; + + while (true) + { + status = wait_for_objects (infos, 2); + + if (status == B_INTERRUPTED || status == B_WOULD_BLOCK) + continue; + + if (infos[0].events & B_EVENT_READ) + process_pending_signals_function (); + + if (infos[1].events & B_EVENT_READ) + { + status = read_port (comm_port, + &reply_type, &file_name, + sizeof file_name); + + if (status < B_OK) + file_name = NULL; + + goto out; + } + + infos[0].events = B_EVENT_READ; + infos[1].events = B_EVENT_READ; + } + + out: + return file_name; + } + + status_t + InitCheck (void) + { + return comm_port >= B_OK ? B_OK : comm_port; + } +}; + +/* A view that is added as a child of a tooltip's text view, and + prevents motion events from reaching it (thereby moving the + tooltip). */ +class EmacsMotionSuppressionView : public BView +{ + void + AttachedToWindow (void) + { + BView *text_view, *tooltip_view; + + /* We know that this view is a child of the text view, whose + parent is the tooltip view, and that the tooltip view has + already set its mouse event mask. */ + + text_view = Parent (); + + if (!text_view) + return; + + tooltip_view = text_view->Parent (); + + if (!tooltip_view) + return; + + tooltip_view->SetEventMask (B_KEYBOARD_EVENTS, 0); + } + +public: + EmacsMotionSuppressionView (void) : BView (BRect (-1, -1, 1, 1), + NULL, 0, 0) + { + return; + } +}; + +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 +be_get_screen_dimensions (int *width, int *height) +{ + BScreen screen; + BRect frame; + + if (!screen.IsValid ()) + gui_abort ("Invalid screen"); + + frame = screen.Frame (); + + *width = BE_RECT_WIDTH (frame); + *height = BE_RECT_HEIGHT (frame); +} + +/* 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 +be_delete_cursor (void *cursor) +{ + if (cursor) + delete (BCursor *) cursor; +} + +void * +be_create_cursor_from_id (int id) +{ + return new BCursor ((enum BCursorID) id); +} + +void +BView_set_view_cursor (void *view, void *cursor) +{ + BView *v = (BView *) view; + + if (!v->LockLooper ()) + gui_abort ("Failed to lock view setting cursor"); + v->SetViewCursor ((BCursor *) cursor); + v->UnlockLooper (); +} + +void +BWindow_Flush (void *window) +{ + ((BWindow *) window)->Flush (); +} + +/* Make a scrollbar, attach it to VIEW's window, and return it. */ +void * +be_make_scroll_bar_for_view (void *view, int horizontal_p, + int x, int y, int x1, int y1) +{ + EmacsScrollBar *scroll_bar; + BView *vw = (BView *) view; + + if (!vw->LockLooper ()) + gui_abort ("Failed to lock scrollbar owner"); + + scroll_bar = new EmacsScrollBar (x, y, x1, y1, horizontal_p, + (EmacsView *) vw); + + vw->AddChild (scroll_bar); + vw->UnlockLooper (); + + return scroll_bar; +} + +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 (); + } +} + +/* 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) +{ + EmacsWindow *w = (EmacsWindow *) window; + if (!w->LockLooper ()) + gui_abort ("Failed to lock window while setting ttip decoration"); + w->tooltip_p = true; + w->RecomputeFeel (); + w->SetLook (B_BORDERED_WINDOW_LOOK); + 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; +} + +/* Create a popup menu. */ +void * +BPopUpMenu_new (const char *name) +{ + BPopUpMenu *menu = new BPopUpMenu (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) +{ + BMenu *be_menu = (BMenu *) menu; + EmacsTitleMenuItem *it; + + it = new EmacsTitleMenuItem (text); + be_menu->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 +be_show_sticky_tooltip (void *view, const char *tooltip_text, + int x, int y) +{ + BToolTip *tooltip; + BView *vw, *tooltip_view; + BPoint point; + + vw = (BView *) view; + + if (!vw->LockLooper ()) + gui_abort ("Failed to lock view while showing sticky tooltip"); + + vw->SetToolTip ((const char *) NULL); + + /* If the tooltip text is empty, then a tooltip object won't be + created by SetToolTip. */ + if (tooltip_text[0] == '\0') + tooltip_text = " "; + + vw->SetToolTip (tooltip_text); + + tooltip = vw->ToolTip (); + + vw->GetMouse (&point, NULL, 1); + point.x -= x; + point.y -= y; + + point.x = -point.x; + point.y = -point.y; + + /* We don't have to make the tooltip sticky since not receiving + mouse movement is enough to prevent it from being hidden. */ + tooltip->SetMouseRelativeLocation (point); + + /* Prevent the tooltip from moving in response to mouse + movement. */ + tooltip_view = tooltip->View (); + + if (tooltip_view) + tooltip_view->AddChild (new EmacsMotionSuppressionView); + + vw->ShowToolTip (tooltip); + vw->UnlockLooper (); +} + +/* Delete ALERT. */ +void +BAlert_delete (void *alert) +{ + delete (BAlert *) alert; +} + +/* Place the resolution of the monitor in DPI in X_OUT and Y_OUT. */ +void +be_get_display_resolution (double *x_out, double *y_out) +{ + BScreen s (B_MAIN_SCREEN_ID); + monitor_info i; + double x_inches, y_inches; + BRect frame; + + if (!s.IsValid ()) + gui_abort ("Invalid screen for resolution checks"); + + if (s.GetMonitorInfo (&i) == B_OK) + { + frame = s.Frame (); + + x_inches = (double) i.width * 25.4; + y_inches = (double) i.height * 25.4; + + *x_out = (double) BE_RECT_WIDTH (frame) / x_inches; + *y_out = (double) BE_RECT_HEIGHT (frame) / y_inches; + return; + } + + *x_out = 72.0; + *y_out = 72.0; +} + +/* 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; + BScreen screen; + + if (space == B_NO_COLOR_SPACE) + { + if (!screen.IsValid ()) + gui_abort ("Invalid screen"); + + space = dpy_color_space = screen.ColorSpace (); + } + + switch (space) + { + case B_RGB32: + case B_RGB24: + return 24; + case B_RGB16: + return 16; + case B_RGB15: + return 15; + case B_CMAP8: + case B_GRAY8: + return 8; + case B_GRAY1: + return 1; + + default: + 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) +{ + BScreen screen; + color_space space = dpy_color_space; + + if (space == B_NO_COLOR_SPACE) + { + if (!screen.IsValid ()) + gui_abort ("Invalid screen"); + + space = dpy_color_space = screen.ColorSpace (); + } + + switch (space) + { + case B_RGB32: + case B_RGB24: + return 16777216; + case B_RGB16: + return 65536; + case B_RGB15: + return 32768; + case B_CMAP8: + case B_GRAY8: + return 256; + case B_GRAY1: + return 2; + + default: + gui_abort ("Bad colorspace for screen"); + } + + return -1; +} + +/* Return whether or not the current display is only capable of + producing grayscale colors. */ +bool +be_is_display_grayscale (void) +{ + BScreen screen; + color_space space = dpy_color_space; + + if (space == B_NO_COLOR_SPACE) + { + if (!screen.IsValid ()) + gui_abort ("Invalid screen"); + + space = dpy_color_space = screen.ColorSpace (); + } + + return space == B_GRAY8 || space == B_GRAY1; +} + +/* 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; +} + +/* 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 (*process_pending_signals_function) (void)) +{ + BWindow *panel_window; + BEntry path; + BMessage msg (FILE_PANEL_SELECTION); + BFilePanel panel (open_p ? B_OPEN_PANEL : B_SAVE_PANEL, + NULL, NULL, (dir_only_p + ? B_DIRECTORY_NODE + : B_FILE_NODE | B_DIRECTORY_NODE)); + char *file_name; + EmacsFilePanelCallbackLooper *looper; + + looper = new EmacsFilePanelCallbackLooper; + + if (looper->InitCheck () < B_OK) + { + delete looper; + return NULL; + } + + if (default_dir) + { + if (path.SetTo (default_dir, 0) != B_OK) + default_dir = NULL; + } + + panel_window = panel.Window (); + + if (default_dir) + panel.SetPanelDirectory (&path); + + if (save_text) + panel.SetSaveText (save_text); + + panel_window->SetTitle (prompt); + panel_window->SetFeel (B_MODAL_APP_WINDOW_FEEL); + + panel.SetHideWhenDone (false); + panel.SetTarget (BMessenger (looper)); + panel.SetMessage (&msg); + panel.Show (); + + looper->Run (); + file_name = looper->ReadFileName (process_pending_signals_function); + + if (looper->Lock ()) + looper->Quit (); + + return file_name; +} + +/* 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. */ +/* 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_look = w->Look (); + w->RecomputeFeel (); + 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->SetLook (w->pre_override_redirect_look); + w->RecomputeFeel (); + 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 +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; +} + +/* Replay the menu bar click event EVENT. Return whether or not the + menu bar actually opened. */ +bool +be_replay_menu_bar_event (void *menu_bar, + struct haiku_menu_bar_click_event *event) +{ + BMenuBar *m = (BMenuBar *) menu_bar; + BMessenger messenger (m); + BMessage reply, msg (REPLAY_MENU_BAR); + + msg.AddPoint ("emacs:point", BPoint (event->x, event->y)); + messenger.SendMessage (&msg, &reply); + return reply.what == BE_MENU_BAR_OPEN; +} + +void +BWindow_set_z_group (void *window, enum haiku_z_group z_group) +{ + EmacsWindow *w = (EmacsWindow *) window; + + if (w->LockLooper ()) + { + if (w->z_group != z_group) + { + w->z_group = z_group; + w->RecomputeFeel (); + + if (w->z_group == Z_GROUP_BELOW) + w->SetFlags (w->Flags () | B_AVOID_FRONT); + else + w->SetFlags (w->Flags () & ~B_AVOID_FRONT); + } + + w->UnlockLooper (); + } +} + +int +be_get_ui_color (const char *name, uint32_t *color) +{ + color_which which; + rgb_color rgb; + + which = which_ui_color (name); + + if (which == B_NO_COLOR) + return 1; + + rgb = ui_color (which); + *color = (rgb.blue | rgb.green << 8 + | rgb.red << 16 | 255 << 24); + + return 0; +} + +bool +be_select_font (void (*process_pending_signals_function) (void), + bool (*should_quit_function) (void), + haiku_font_family_or_style *family, + haiku_font_family_or_style *style, + int *size, bool allow_monospace_only, + int initial_family, int initial_style, + int initial_size, bool initial_antialias, + bool *disable_antialias) +{ + EmacsFontSelectionDialog *dialog; + struct font_selection_dialog_message msg; + uint32 flags; + font_family family_buffer; + font_style style_buffer; + + dialog = new EmacsFontSelectionDialog (allow_monospace_only, + initial_family, initial_style, + initial_size, initial_antialias); + dialog->CenterOnScreen (); + + if (dialog->InitCheck () < B_OK) + { + dialog->Quit (); + return false; + } + + dialog->Show (); + dialog->WaitForChoice (&msg, process_pending_signals_function, + should_quit_function); + + if (!dialog->LockLooper ()) + gui_abort ("Failed to lock font selection dialog looper"); + dialog->Quit (); + + if (msg.cancel) + return false; + + if (get_font_family (msg.family_idx, + &family_buffer, &flags) != B_OK + || get_font_style (family_buffer, msg.style_idx, + &style_buffer, &flags) != B_OK) + return false; + + memcpy (family, family_buffer, sizeof *family); + memcpy (style, style_buffer, sizeof *style); + *size = msg.size_specified ? msg.size : -1; + *disable_antialias = msg.disable_antialias; + + return true; +} + +void +BWindow_set_sticky (void *window, bool sticky) +{ + BWindow *w = (BWindow *) window; + + if (w->LockLooper ()) + { + w->SetFlags (sticky ? (w->Flags () + | B_SAME_POSITION_IN_ALL_WORKSPACES) + : w->Flags () & ~B_SAME_POSITION_IN_ALL_WORKSPACES); + + w->UnlockLooper (); + } +} + +status_t +be_roster_launch (const char *type, const char *file, char **cargs, + ptrdiff_t nargs, void *message, team_id *team_id) +{ + BEntry entry; + entry_ref ref; + + if (type) + { + if (message) + return be_roster->Launch (type, (BMessage *) message, + team_id); + + return be_roster->Launch (type, (nargs > INT_MAX + ? INT_MAX : nargs), + cargs, team_id); + } + + if (entry.SetTo (file) != B_OK) + return B_ERROR; + + if (entry.GetRef (&ref) != B_OK) + return B_ERROR; + + if (message) + return be_roster->Launch (&ref, (BMessage *) message, + team_id); + + return be_roster->Launch (&ref, (nargs > INT_MAX + ? INT_MAX : nargs), + cargs, team_id); +} + +void * +be_create_pixmap_cursor (void *bitmap, int x, int y) +{ + BBitmap *bm; + BCursor *cursor; + + bm = (BBitmap *) bitmap; + cursor = new BCursor (bm, BPoint (x, y)); + + if (cursor->InitCheck () != B_OK) + { + delete cursor; + return NULL; + } + + return cursor; +} + +void +be_get_window_decorator_dimensions (void *window, int *left, int *top, + int *right, int *bottom) +{ + BWindow *wnd; + BRect frame, window_frame; + + wnd = (BWindow *) window; + + if (!wnd->LockLooper ()) + gui_abort ("Failed to lock window looper frame"); + + frame = wnd->DecoratorFrame (); + window_frame = wnd->Frame (); + + if (left) + *left = window_frame.left - frame.left; + + if (top) + *top = window_frame.top - frame.top; + + if (right) + *right = frame.right - window_frame.right; + + if (bottom) + *bottom = frame.bottom - window_frame.bottom; + + wnd->UnlockLooper (); +} + +void +be_get_window_decorator_frame (void *window, int *left, int *top, + int *width, int *height) +{ + BWindow *wnd; + BRect frame; + + wnd = (BWindow *) window; + + if (!wnd->LockLooper ()) + gui_abort ("Failed to lock window looper frame"); + + frame = wnd->DecoratorFrame (); + + *left = frame.left; + *top = frame.top; + *width = BE_RECT_WIDTH (frame); + *height = BE_RECT_HEIGHT (frame); + + wnd->UnlockLooper (); +} + +/* Request that a MOVE_EVENT be sent for WINDOW. This is so that + frame offsets can be updated after a frame parameter affecting + decorators changes. Sending an event instead of updating the + offsets directly avoids race conditions where events with older + information are received after the update happens. */ +void +be_send_move_frame_event (void *window) +{ + BWindow *wnd = (BWindow *) window; + BMessenger msg (wnd); + + msg.SendMessage (SEND_MOVE_FRAME_EVENT); +} + +void +be_lock_window (void *window) +{ + BWindow *wnd = (BWindow *) window; + + if (!wnd->LockLooper ()) + gui_abort ("Failed to lock window looper"); +} + +void +be_unlock_window (void *window) +{ + BWindow *wnd = (BWindow *) window; + + wnd->UnlockLooper (); +} + +void +be_set_window_fullscreen_mode (void *window, enum haiku_fullscreen_mode mode) +{ + EmacsWindow *w = (EmacsWindow *) window; + + if (!w->LockLooper ()) + gui_abort ("Failed to lock window to set fullscreen mode"); + + w->SetFullscreen (mode); + w->UnlockLooper (); +} + +bool +be_get_explicit_workarea (int *x, int *y, int *width, int *height) +{ + BDeskbar deskbar; + BRect zoom; + deskbar_location location; + + location = deskbar.Location (); + + if (location != B_DESKBAR_TOP + && location != B_DESKBAR_BOTTOM) + return false; + + zoom = get_zoom_rect (NULL); + + *x = zoom.left; + *y = zoom.top; + *width = BE_RECT_WIDTH (zoom); + *height = BE_RECT_HEIGHT (zoom); + + return true; +} diff --git a/src/haiku_support.h b/src/haiku_support.h new file mode 100644 index 00000000000..5f44494a8d3 --- /dev/null +++ b/src/haiku_support.h @@ -0,0 +1,741 @@ +/* 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_SYSTEM_DEFAULT = 1, + CURSOR_ID_CONTEXT_MENU = 3, + CURSOR_ID_COPY = 4, + CURSOR_ID_CREATE_LINK = 29, + CURSOR_ID_CROSS_HAIR = 5, + CURSOR_ID_FOLLOW_LINK = 6, + CURSOR_ID_GRAB = 7, + CURSOR_ID_GRABBING = 8, + CURSOR_ID_HELP = 9, + CURSOR_ID_I_BEAM = 2, + CURSOR_ID_I_BEAM_HORIZONTAL = 10, + CURSOR_ID_MOVE = 11, + CURSOR_ID_NO_CURSOR = 12, + CURSOR_ID_NOT_ALLOWED = 13, + CURSOR_ID_PROGRESS = 14, + 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, + CURSOR_ID_ZOOM_IN = 27, + CURSOR_ID_ZOOM_OUT = 28 + }; + +enum haiku_z_group + { + Z_GROUP_ABOVE, + Z_GROUP_NONE, + Z_GROUP_BELOW, + }; + +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_CLICK, + MENU_BAR_OPEN, + MENU_BAR_SELECT_EVENT, + MENU_BAR_CLOSE, + MENU_BAR_HELP_EVENT, + ZOOM_EVENT, + DRAG_AND_DROP_EVENT, + APP_QUIT_REQUESTED_EVENT, + DUMMY_EVENT, + SCREEN_CHANGED_EVENT, + MENU_BAR_LEFT, + CLIPBOARD_CHANGED_EVENT, + }; + +struct haiku_clipboard_changed_event +{ + char dummy; +}; + +struct haiku_screen_changed_event +{ + bigtime_t when; +}; + +struct haiku_quit_requested_event +{ + void *window; +}; + +struct haiku_resize_event +{ + void *window; + float width; + float height; +}; + +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; +}; + +enum haiku_modifier_specification + { + HAIKU_MODIFIER_ALT = 1, + HAIKU_MODIFIER_CTRL = (1 << 1), + HAIKU_MODIFIER_SHIFT = (1 << 2), + 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_menu_bar_click_event +{ + void *window; + int x, y; +}; + +struct haiku_button_event +{ + void *window; + void *scroll_bar; + 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, y; + int decorator_width; + int decorator_height; +}; + +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_menu_bar_help_event +{ + void *window; + int mb_idx; + void *data; + bool highlight_p; +}; + +struct haiku_zoom_event +{ + void *window; + int fullscreen_mode; +}; + +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, + FSPEC_INDICES = 1 << 9, + FSPEC_ANTIALIAS = 1 << 10, + }; + +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. */ + }; + +enum haiku_font_weight + { + NO_WEIGHT = -1, + HAIKU_THIN = 0, + HAIKU_EXTRALIGHT = 40, + HAIKU_LIGHT = 50, + HAIKU_SEMI_LIGHT = 75, + HAIKU_REGULAR = 100, + HAIKU_SEMI_BOLD = 180, + HAIKU_BOLD = 200, + HAIKU_EXTRA_BOLD = 205, + HAIKU_BOOK = 400, + HAIKU_HEAVY = 800, + HAIKU_ULTRA_HEAVY = 900, + HAIKU_BLACK = 1000, + HAIKU_MEDIUM = 2000, + }; + +enum haiku_fullscreen_mode + { + FULLSCREEN_MODE_NONE, + FULLSCREEN_MODE_WIDTH, + FULLSCREEN_MODE_HEIGHT, + FULLSCREEN_MODE_BOTH, + FULLSCREEN_MODE_MAXIMIZED, + }; + +struct haiku_font_pattern +{ + /* Bitmask indicating which fields are set. */ + int specified; + + /* The next font in this list. */ + struct haiku_font_pattern *next; + + /* The last font in the list during font lookup. */ + struct haiku_font_pattern *last; + + /* The next font in the list whose family differs from this one. + Only valid during font lookup. */ + struct haiku_font_pattern *next_family; + + /* The family of the font. */ + haiku_font_family_or_style family; + + /* The style of the font. */ + haiku_font_family_or_style style; + + /* Whether or the font is monospace. */ + int mono_spacing_p; + + /* The slant of the font. */ + enum haiku_font_slant slant; + + /* The width of the font. */ + enum haiku_font_width width; + + /* The language of the font. Used during font lookup. */ + enum haiku_font_language language; + + /* The weight of the font. */ + enum haiku_font_weight weight; + + /* List of characters that must be present in the font for the match + to succeed. */ + int *wanted_chars; + + /* The number of characters in `wanted_chars'. */ + int want_chars_len; + + /* List of characters. The font must fullfill at least one of + them for the match to succeed. */ + int *need_one_of; + + /* The number of characters in `need_one_of'. */ + int need_one_of_len; + + /* The index of the family of the font this pattern represents. */ + int family_index; + + /* The index of the style of the font this pattern represents. */ + int style_index; + + /* Temporary field used during font enumeration. */ + int oblique_seen_p; + + /* Whether or not to enable antialising in the font. This field is + special in that it's not handled by `BFont_open_pattern'. */ + int use_antialiasing; +}; + +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; +}; + +struct haiku_session_manager_reply +{ + bool quit_reply; +}; + +#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 */ + +#ifdef __cplusplus +extern "C" +{ +#endif +#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 port_id port_emacs_to_session_manager; + +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 be_draw_cross_on_pixmap (void *, int, int, int, int, + uint32_t); + +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 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_set_z_group (void *, enum haiku_z_group); +extern void BWindow_set_sticky (void *, bool); +extern void BWindow_Flush (void *); + +extern void BFont_close (void *); +extern void BFont_metrics (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_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, bool); +extern void BView_DrawBitmapWithEraseOp (void *, void *, int, int, int, int); +extern void BView_DrawBitmapTiled (void *, void *, int, int, + int, int, int, int, int, int); + +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 *be_transform_bitmap (void *, void *, uint32_t, double, + int, int, bool); +extern void be_apply_affine_transform (void *, double, double, double, + double, double, double); +extern void be_apply_inverse_transform (double (*)[3], int, int, int *, int *); +extern void be_draw_image_mask (void *, void *, int, int, int, int, int, int, + int, int, uint32_t); +extern void be_draw_bitmap_with_mask (void *, void *, void *, int, int, int, + int, int, int, int, int, bool); + +extern void be_get_display_resolution (double *, double *); +extern void be_get_screen_dimensions (int *, int *); + +/* Functions for creating and freeing cursors. */ +extern void *be_create_cursor_from_id (int); +extern void *be_create_pixmap_cursor (void *, int, int); +extern void be_delete_cursor (void *); + +extern void *be_make_scroll_bar_for_view (void *, int, int, int, int, int); +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 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 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 be_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 be_get_version_string (char *, int); +extern int be_get_display_planes (void); +extern int be_get_display_color_cells (void); +extern bool be_is_display_grayscale (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)); + +#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 void be_init_font_data (void); +extern void be_evict_font_cache (void); +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 be_font_style_to_flags (char *, struct haiku_font_pattern *); +extern void *be_open_font_at_index (int, int, float); +extern void be_set_font_antialiasing (void *, bool); +extern int be_get_ui_color (const char *, uint32_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); + +extern bool be_replay_menu_bar_event (void *, struct haiku_menu_bar_click_event *); +extern bool be_select_font (void (*) (void), bool (*) (void), + haiku_font_family_or_style *, + haiku_font_family_or_style *, + int *, bool, int, int, int, + bool, bool *); + +extern int be_find_font_indices (struct haiku_font_pattern *, int *, int *); +extern status_t be_roster_launch (const char *, const char *, char **, + ptrdiff_t, void *, team_id *); +extern void be_get_window_decorator_dimensions (void *, int *, int *, int *, int *); +extern void be_get_window_decorator_frame (void *, int *, int *, int *, int *); +extern void be_send_move_frame_event (void *); +extern void be_set_window_fullscreen_mode (void *, enum haiku_fullscreen_mode); + +extern void be_lock_window (void *); +extern void be_unlock_window (void *); +extern bool be_get_explicit_workarea (int *, int *, int *, int *); +#ifdef __cplusplus +} + +extern _Noreturn void gui_abort (const char *); +extern void *find_appropriate_view_for_draw (void *); +#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..e0a65b499f4 --- /dev/null +++ b/src/haikufns.c @@ -0,0 +1,3220 @@ +/* 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 "bitmaps/leftptr.xbm" +#include "bitmaps/leftpmsk.xbm" + +#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 X and Y deltas of the last call to `x-show-tip'. */ +Lisp_Object tip_dx, tip_dy; + +/* 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); + +/* The number of references to an image cache. */ +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 (! BASE_EQ (value, Qunbound)) + parms = Fcons (Fcons (r[i].tem, value), parms); + } + } + + return parms; +} + +/* Update the left and top offsets of F after its decorators + change. */ +static void +haiku_update_after_decoration_change (struct frame *f) +{ + /* Don't reset offsets during initial frame creation, since the + contents of f->left_pos and f->top_pos won't be applied to the + window until `x-create-frame' finishes, so setting them here will + overwrite the offsets that the window should be moved to. */ + + if (!FRAME_OUTPUT_DATA (f)->configury_done) + return; + + be_send_move_frame_event (FRAME_HAIKU_WINDOW (f)); +} + +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)); +} + +void +gamma_correct (struct frame *f, Emacs_Color *color) +{ + if (f->gamma) + { + color->red = (pow (color->red / 65535.0, f->gamma) + * 65535.0 + 0.5); + color->green = (pow (color->green / 65535.0, f->gamma) + * 65535.0 + 0.5); + color->blue = (pow (color->blue / 65535.0, f->gamma) + * 65535.0 + 0.5); + color->pixel = RGB_TO_ULONG (color->red / 256, + color->green / 256, + color->blue / 256); + } +} + +int +haiku_get_color (const char *name, Emacs_Color *color) +{ + unsigned short r16, g16, b16; + Lisp_Object tem, col; + int32 clr, rc; + uint32_t ui_color; + ptrdiff_t size, i; + Lisp_Object string; + + 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 (); + } + + rc = 1; + if (VECTORP (Vhaiku_allowed_ui_colors)) + { + size = ASIZE (Vhaiku_allowed_ui_colors); + + for (i = 0; i < size; ++i) + { + string = AREF (Vhaiku_allowed_ui_colors, i); + + block_input (); + if (STRINGP (string) && !strcmp (SSDATA (string), name)) + rc = be_get_ui_color (name, &ui_color); + unblock_input (); + } + } + + if (!rc) + { + color->pixel = ui_color; + color->red = RED_FROM_ULONG (ui_color) * 257; + color->green = GREEN_FROM_ULONG (ui_color) * 257; + color->blue = BLUE_FROM_ULONG (ui_color) * 257; + } + + return rc; +} + +static struct haiku_display_info * +haiku_display_info_for_name (Lisp_Object name) +{ + CHECK_STRING (name); + + if (!strcmp (SSDATA (name), "be")) + { + if (x_display_list) + return x_display_list; + + return haiku_term_init (); + } + + 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_set_z_group (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) +{ + int rc; + + /* Tooltip frames can't have Z groups, since the window feel is + overridden during frame creation. */ + if (FRAME_TOOLTIP_P (f)) + return; + + rc = 1; + block_input (); + + if (NILP (new_value)) + { + BWindow_set_z_group (FRAME_HAIKU_WINDOW (f), Z_GROUP_NONE); + FRAME_Z_GROUP (f) = z_group_none; + } + else if (EQ (new_value, Qabove)) + { + BWindow_set_z_group (FRAME_HAIKU_WINDOW (f), Z_GROUP_ABOVE); + FRAME_Z_GROUP (f) = z_group_above; + } + else if (EQ (new_value, Qbelow)) + { + BWindow_set_z_group (FRAME_HAIKU_WINDOW (f), Z_GROUP_BELOW); + FRAME_Z_GROUP (f) = z_group_below; + } + else + rc = 0; + + unblock_input (); + + if (!rc) + error ("Invalid z-group specification"); + + /* Setting the Z-group can change the frame's decorator. */ + haiku_update_after_decoration_change (f); +} + +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) +{ + if (!EQ (new_value, old_value)) + FRAME_NO_ACCEPT_FOCUS (f) = !NILP (new_value); + + block_input (); + 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 unsigned long +haiku_decode_color (struct frame *f, Lisp_Object color_name) +{ + Emacs_Color cdef; + + CHECK_STRING (color_name); + + if (!haiku_get_color (SSDATA (color_name), &cdef)) + return cdef.pixel; + + signal_error ("Undefined color", color_name); +} + +static void +haiku_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + struct haiku_output *output; + unsigned long fg, old_fg; + + fg = haiku_decode_color (f, arg); + old_fg = FRAME_FOREGROUND_PIXEL (f); + FRAME_FOREGROUND_PIXEL (f) = fg; + output = FRAME_OUTPUT_DATA (f); + + if (FRAME_HAIKU_WINDOW (f)) + { + if (output->cursor_color.pixel == old_fg) + haiku_query_color (fg, &output->cursor_color); + + update_face_from_frame_parameter (f, Qforeground_color, arg); + + if (FRAME_VISIBLE_P (f)) + redraw_frame (f); + } +} + +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 (BASE_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) + && ! BASE_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); + f->output_data.haiku->wait_for_event_type = -1; + f->output_data.haiku->relief_background = -1; + + 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 (BASE_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 (0), + "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, Qmouse_color, build_string ("font-color"), + "pointerColor", "Foreground", 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, 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 || (!BASE_EQ (tem, Qunbound) && !NILP (tem)); + + f->terminal->reference_count++; + + FRAME_OUTPUT_DATA (f)->window = BWindow_new (&FRAME_OUTPUT_DATA (f)->view); + + 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 (BASE_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 (BASE_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); + + gui_default_parameter (f, parms, Qz_group, Qnil, + NULL, NULL, RES_TYPE_SYMBOL); + + 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) + && !BASE_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->output_data.haiku->wait_for_event_type = -1; + f->output_data.haiku->relief_background = -1; + + 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 (BASE_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 (! BASE_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); + + /* FIXME: is there a better method to tell Emacs to not recolor the + cursors other than setting the color to a special value? */ + gui_default_parameter (f, parms, Qmouse_color, build_string ("font-color"), + "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 */ + + { + Lisp_Object disptype; + + if (be_get_display_planes () == 1) + disptype = Qmono; + else if (be_is_display_grayscale ()) + disptype = Qgrayscale; + else + disptype = Qcolor; + + 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 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; + + be_get_screen_dimensions (&max_x, &max_y); + + max_x = max_x - 1; + max_y = max_y - 1; + + 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) +{ + Lisp_Object it, frame; + + if (!NILP (tip_timer)) + { + call1 (Qcancel_timer, tip_timer); + tip_timer = Qnil; + } + + 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 (); + + haiku_update_after_decoration_change (f); +} + +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 (); + + haiku_update_after_decoration_change (f); +} + +static void +haiku_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) +{ + int nlines; + + if (FRAME_TOOLTIP_P (f)) + return; + + if (TYPE_RANGED_FIXNUMP (int, value)) + nlines = XFIXNUM (value); + else + nlines = 0; + + fset_redisplay (f); + + 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 + { + FRAME_MENU_BAR_LINES (f) = 0; + FRAME_MENU_BAR_HEIGHT (f) = 0; + + if (FRAME_EXTERNAL_MENU_BAR (f)) + free_frame_menubar (f); + + FRAME_EXTERNAL_MENU_BAR (f) = 0; + 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, *parent; + void *window; + int outer_x, outer_y, outer_width, outer_height; + int right_off, bottom_off, top_off; + int native_x, native_y; + + f = decode_window_system_frame (frame); + parent = FRAME_PARENT_FRAME (f); + window = FRAME_HAIKU_WINDOW (f); + + be_lock_window (window); + be_get_window_decorator_frame (window, &outer_x, &outer_y, + &outer_width, &outer_height); + be_get_window_decorator_dimensions (window, NULL, &top_off, + &right_off, &bottom_off); + be_unlock_window (window); + + native_x = FRAME_OUTPUT_DATA (f)->frame_x; + native_y = FRAME_OUTPUT_DATA (f)->frame_y; + + if (parent) + { + /* Adjust all the coordinates by the coordinates of the parent + frame. */ + outer_x -= FRAME_OUTPUT_DATA (parent)->frame_x; + outer_y -= FRAME_OUTPUT_DATA (parent)->frame_y; + native_x -= FRAME_OUTPUT_DATA (parent)->frame_x; + native_y -= FRAME_OUTPUT_DATA (parent)->frame_y; + } + + if (EQ (attribute, Qouter_edges)) + return list4i (outer_x, outer_y, + outer_x + outer_width, + outer_y + outer_height); + else if (EQ (attribute, Qnative_edges)) + return list4i (native_x, native_y, + native_x + FRAME_PIXEL_WIDTH (f), + native_y + FRAME_PIXEL_HEIGHT (f)); + else if (EQ (attribute, Qinner_edges)) + return list4i (native_x + FRAME_INTERNAL_BORDER_WIDTH (f), + native_y + FRAME_INTERNAL_BORDER_WIDTH (f) + + FRAME_MENU_BAR_HEIGHT (f) + FRAME_TOOL_BAR_HEIGHT (f), + native_x - FRAME_INTERNAL_BORDER_WIDTH (f) + + FRAME_PIXEL_WIDTH (f), + native_y + FRAME_PIXEL_HEIGHT (f) + - FRAME_INTERNAL_BORDER_WIDTH (f)); + + else + return list (Fcons (Qouter_position, + Fcons (make_fixnum (outer_x), + make_fixnum (outer_y))), + Fcons (Qouter_size, + Fcons (make_fixnum (outer_width), + make_fixnum (outer_height))), + Fcons (Qexternal_border_size, + Fcons (make_fixnum (right_off), + make_fixnum (bottom_off))), + Fcons (Qtitle_bar_size, + Fcons (make_fixnum (outer_width), + make_fixnum (top_off))), + 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) +{ + unsigned long background; + + background = haiku_decode_color (f, arg); + + FRAME_OUTPUT_DATA (f)->cursor_fg = background; + FRAME_BACKGROUND_PIXEL (f) = background; + + if (FRAME_HAIKU_VIEW (f)) + { + BView_draw_lock (FRAME_HAIKU_VIEW (f), false, 0, 0, 0, 0); + BView_SetViewColor (FRAME_HAIKU_VIEW (f), background); + BView_draw_unlock (FRAME_HAIKU_VIEW (f)); + + FRAME_OUTPUT_DATA (f)->cursor_fg = background; + update_face_from_frame_parameter (f, Qbackground_color, arg); + + if (FRAME_VISIBLE_P (f)) + redraw_frame (f); + } +} + +void +haiku_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + unsigned long fore_pixel, pixel; + + pixel = haiku_decode_color (f, arg); + + if (!NILP (Vx_cursor_fore_pixel)) + { + fore_pixel = haiku_decode_color (f, Vx_cursor_fore_pixel); + FRAME_OUTPUT_DATA (f)->cursor_fg = fore_pixel; + } + else + FRAME_OUTPUT_DATA (f)->cursor_fg = FRAME_BACKGROUND_PIXEL (f); + + haiku_query_color (pixel, &FRAME_CURSOR_COLOR (f)); + + if (FRAME_VISIBLE_P (f)) + { + gui_update_cursor (f, false); + gui_update_cursor (f, true); + } + + update_face_from_frame_parameter (f, Qcursor_color, arg); +} + +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, left, right, top, bottom, byte; + + 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]; + + 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, *byte; + int32_t bytes_per_row; + int mono_p, left, right, top, bottom; + ptrdiff_t off, bit, xoff; + + 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) + { + off = y * bytes_per_row; + bit = x % 8; + xoff = x / 8; + + 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); + haiku_free_custom_cursors (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); + + if (FRAME_OUTPUT_DATA (f)->saved_menu_event) + xfree (FRAME_OUTPUT_DATA (f)->saved_menu_event); + + 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; + + SET_FRAME_VISIBLE (frame, false); + SET_FRAME_ICONIFIED (frame, true); + + block_input (); + 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 the + default name. 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) +{ + struct haiku_display_info *dpyinfo; + + if (explicit_p) + { + if (f->explicit_name && NILP (name)) + update_mode_lines = 37; + + f->explicit_name = !NILP (name); + } + else if (f->explicit_name) + return; + + dpyinfo = FRAME_DISPLAY_INFO (f); + + if (NILP (name)) + name = dpyinfo->default_name; + + 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)); +#ifndef USE_BE_CAIRO + else + EmacsView_disable_double_buffering (FRAME_HAIKU_VIEW (f)); +#endif + + SET_FRAME_GARBAGED (f); + } + unblock_input (); +} + +static void +haiku_set_sticky (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) +{ + block_input (); + BWindow_set_sticky (FRAME_HAIKU_WINDOW (f), !NILP (new_value)); + unblock_input (); +} + +struct user_cursor_info +{ + /* A pointer to the Lisp_Object describing the cursor. */ + Lisp_Object *lisp_cursor; + + /* The offset of the cursor in the `struct haiku_output' of each + frame. */ + ptrdiff_t output_offset; + + /* The offset of the default value of the cursor in the display + info structure. */ + ptrdiff_t default_offset; +}; + +struct user_cursor_bitmap_info +{ + /* A bitmap to use instead of the font cursor to create cursors in a + certain color. */ + const void *bits; + + /* The mask for that bitmap. */ + const void *mask; + + /* The dimensions of the cursor bitmap. */ + int width, height; + + /* The position inside the cursor bitmap corresponding to the + position of the mouse pointer. */ + int x, y; +}; + +#define INIT_USER_CURSOR(lisp, cursor) \ + { (lisp), offsetof (struct haiku_output, cursor), \ + offsetof (struct haiku_display_info, cursor) } + +struct user_cursor_info custom_cursors[] = + { + INIT_USER_CURSOR (&Vx_pointer_shape, text_cursor), + INIT_USER_CURSOR (NULL, nontext_cursor), + INIT_USER_CURSOR (NULL, modeline_cursor), + INIT_USER_CURSOR (&Vx_sensitive_text_pointer_shape, hand_cursor), + INIT_USER_CURSOR (&Vx_hourglass_pointer_shape, hourglass_cursor), + INIT_USER_CURSOR (NULL, horizontal_drag_cursor), + INIT_USER_CURSOR (NULL, vertical_drag_cursor), + INIT_USER_CURSOR (NULL, left_edge_cursor), + INIT_USER_CURSOR (NULL, top_left_corner_cursor), + INIT_USER_CURSOR (NULL, top_edge_cursor), + INIT_USER_CURSOR (NULL, top_right_corner_cursor), + INIT_USER_CURSOR (NULL, right_edge_cursor), + INIT_USER_CURSOR (NULL, bottom_right_corner_cursor), + INIT_USER_CURSOR (NULL, bottom_edge_cursor), + INIT_USER_CURSOR (NULL, bottom_left_corner_cursor), + INIT_USER_CURSOR (NULL, no_cursor), + }; + +struct user_cursor_bitmap_info cursor_bitmaps[] = + { + { ibeam_ptr_bits, ibeam_ptrmask_bits, 15, 15, 7, 7 }, /* text_cursor */ + { left_ptr_bits, left_ptrmsk_bits, 16, 16, 3, 1 }, /* nontext_cursor */ + { left_ptr_bits, left_ptrmsk_bits, 16, 16, 3, 1 }, /* modeline_cursor */ + { hand_ptr_bits, hand_ptrmask_bits, 15, 15, 4, 3 }, /* hand_cursor */ + { hourglass_bits, hourglass_mask_bits, 15, 15, 7, 7 }, /* hourglass_cursor */ + { horizd_ptr_bits, horizd_ptrmask_bits, 15, 15, 7, 7 }, /* horizontal_drag_cursor */ + { vertd_ptr_bits, vertd_ptrmask_bits, 15, 15, 7, 7 }, /* vertical_drag_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* left_edge_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* top_left_corner_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* top_edge_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* top_right_corner_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* right_edge_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* bottom_right_corner_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* bottom_edge_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* bottom_left_corner_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* no_cursor */ + }; + +/* Array of cursor bitmaps for each system cursor ID. This is used to + color in user-specified cursors. */ +struct user_cursor_bitmap_info cursor_bitmaps_for_id[28] = + { + { NULL, NULL, 0, 0, 0, 0 }, + { left_ptr_bits, left_ptrmsk_bits, 16, 16, 3, 1 }, + { ibeam_ptr_bits, ibeam_ptrmask_bits, 15, 15, 7, 7 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { cross_ptr_bits, cross_ptrmask_bits, 30, 30, 15, 15 }, + { NULL, NULL, 0, 0, 0, 0 }, + { hand_ptr_bits, hand_ptrmask_bits, 15, 15, 4, 3 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { hourglass_bits, hourglass_mask_bits, 15, 15, 7, 7 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { horizd_ptr_bits, horizd_ptrmask_bits, 15, 15, 7, 7 }, + { vertd_ptr_bits, vertd_ptrmask_bits, 15, 15, 7, 7 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + }; + +static void * +haiku_create_colored_cursor (struct user_cursor_bitmap_info *info, + uint32_t foreground, uint32_t background) +{ + const char *bits, *mask; + void *bitmap, *cursor; + int width, height, bytes_per_line, x, y; + + bits = info->bits; + mask = info->mask; + width = info->width; + height = info->height; + bytes_per_line = (width + 7) / 8; + + bitmap = BBitmap_new (width, height, false); + + if (!bitmap) + memory_full (SIZE_MAX); + + for (y = 0; y < height; ++y) + { + for (x = 0; x < width; ++x) + { + if (mask[x / 8] >> (x % 8) & 1) + haiku_put_pixel (bitmap, x, y, + (bits[x / 8] >> (x % 8) & 1 + ? (foreground | 255u << 24) + : (background | 255u << 24))); + else + haiku_put_pixel (bitmap, x, y, 0); + } + + mask += bytes_per_line; + bits += bytes_per_line; + } + + cursor = be_create_pixmap_cursor (bitmap, info->x, info->y); + BBitmap_free (bitmap); + + return cursor; +} + +/* Free all cursors on F that were allocated specifically for the + frame. */ +void +haiku_free_custom_cursors (struct frame *f) +{ + struct user_cursor_info *cursor; + struct haiku_output *output; + struct haiku_display_info *dpyinfo; + Emacs_Cursor *frame_cursor; + Emacs_Cursor *display_cursor; + int i; + + output = FRAME_OUTPUT_DATA (f); + dpyinfo = FRAME_DISPLAY_INFO (f); + + for (i = 0; i < ARRAYELTS (custom_cursors); ++i) + { + cursor = &custom_cursors[i]; + frame_cursor = (Emacs_Cursor *) ((char *) output + + cursor->output_offset); + display_cursor = (Emacs_Cursor *) ((char *) dpyinfo + + cursor->default_offset); + + if (*frame_cursor != *display_cursor && *frame_cursor) + { + if (output->current_cursor == *frame_cursor) + output->current_cursor = *display_cursor; + + be_delete_cursor (*frame_cursor); + } + + *frame_cursor = *display_cursor; + } +} + +static void +haiku_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + struct haiku_output *output; + Emacs_Cursor *frame_cursor, old, *recolored; + int i, n, rc; + bool color_specified_p; + Emacs_Color color; + + CHECK_STRING (arg); + color_specified_p = true; + + if (!strcmp (SSDATA (arg), "font-color")) + color_specified_p = false; + else + rc = haiku_get_color (SSDATA (arg), &color); + + if (color_specified_p && rc) + signal_error ("Undefined color", arg); + + output = FRAME_OUTPUT_DATA (f); + + /* This will also reset all the cursors back to their default + values. */ + haiku_free_custom_cursors (f); + + for (i = 0; i < ARRAYELTS (custom_cursors); ++i) + { + frame_cursor = (Emacs_Cursor *) ((char *) output + + custom_cursors[i].output_offset); + old = *frame_cursor; + + if (custom_cursors[i].lisp_cursor + && FIXNUMP (*custom_cursors[i].lisp_cursor)) + { + if (!RANGED_FIXNUMP (0, *custom_cursors[i].lisp_cursor, + 28)) /* 28 is the largest Haiku cursor ID. */ + signal_error ("Invalid cursor", + *custom_cursors[i].lisp_cursor); + + n = XFIXNUM (*custom_cursors[i].lisp_cursor); + + if (color_specified_p && cursor_bitmaps_for_id[n].bits) + { + recolored + = haiku_create_colored_cursor (&cursor_bitmaps_for_id[n], + color.pixel, + FRAME_BACKGROUND_PIXEL (f)); + + if (recolored) + { + *frame_cursor = recolored; + continue; + } + } + + /* Create and set the custom cursor. */ + *frame_cursor = be_create_cursor_from_id (n); + } + else if (color_specified_p && cursor_bitmaps[i].bits) + { + recolored + = haiku_create_colored_cursor (&cursor_bitmaps[i], color.pixel, + FRAME_BACKGROUND_PIXEL (f)); + + if (recolored) + *frame_cursor = recolored; + } + } + + /* This function can be called before the frame's window is + created. */ + if (FRAME_HAIKU_WINDOW (f)) + { + if (output->current_cursor == old + && old != *frame_cursor) + { + output->current_cursor = *frame_cursor; + + BView_set_view_cursor (FRAME_HAIKU_VIEW (f), + *frame_cursor); + } + } + + update_face_from_frame_parameter (f, Qmouse_color, arg); +} + + + +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) +{ + struct frame *f = SELECTED_FRAME (); + void *view; + int x, y; + + if (FRAME_INITIAL_P (f) || !FRAME_HAIKU_P (f)) + return Qnil; + + block_input (); + view = FRAME_HAIKU_VIEW (f); + 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) +{ + check_haiku_display_info (terminal); + + return be_is_display_grayscale () ? Qnil : 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; + int rc; + + CHECK_STRING (color); + decode_window_system_frame (frame); + + block_input (); + rc = haiku_get_color (SSDATA (color), &col); + unblock_input (); + + if (rc) + return Qnil; + + return list3i (col.red, col.green, 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) +{ + check_haiku_display_info (terminal); + + return be_is_display_grayscale () ? Qt : 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) +{ + CHECK_STRING (display); + + if (NILP (Fstring_equal (display, build_string ("be")))) + { + if (!NILP (must_succeed)) + fatal ("Invalid display %s", SDATA (display)); + else + signal_error ("Invalid display", display); + } + + if (x_display_list) + { + if (!NILP (must_succeed)) + fatal ("A display is already open"); + else + error ("A display is already open"); + } + + haiku_term_init (); + 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) + +{ + int width, height; + check_haiku_display_info (terminal); + + be_get_screen_dimensions (&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) + +{ + int width, height; + check_haiku_display_info (terminal); + + be_get_screen_dimensions (&width, &height); + return make_fixnum (height); +} + +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; + + be_get_screen_dimensions (&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; + + be_get_screen_dimensions (&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) +{ + int planes; + bool grayscale_p; + + check_haiku_display_info (terminal); + + grayscale_p = be_is_display_grayscale (); + if (grayscale_p) + return Qstatic_gray; + + planes = be_get_display_planes (); + if (planes == 8) + return Qstatic_color; + + return Qtrue_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 = Vx_show_tooltip_timeout; + 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); + + tip_dx = dx; + tip_dy = 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); + be_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_window_system_frame (frame); + + 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) +{ + struct frame *f; + + if (FRAMEP (terminal)) + { + 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) +{ + struct frame *f; + char *file_name; + Lisp_Object value; + + if (popup_activated_p) + error ("Trying to use a menu from within a menu-entry"); + + if (!NILP (dir)) + { + CHECK_STRING (dir); + dir = ENCODE_FILE (dir); + } + + if (!NILP (save_text)) + CHECK_STRING (save_text); + + if (NILP (frame)) + frame = selected_frame; + + CHECK_STRING (prompt); + + f = decode_window_system_frame (frame); + + ++popup_activated_p; + unrequest_sigio (); + file_name = be_popup_file_dialog (!NILP (mustmatch) || !NILP (dir_only_p), + !NILP (dir) ? SSDATA (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)), + process_pending_signals); + request_sigio (); + --popup_activated_p; + + if (!file_name) + quit (); + + value = build_string (file_name); + free (file_name); + + return DECODE_FILE (value); +} + +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; +} + +DEFUN ("haiku-save-session-reply", Fhaiku_save_session_reply, + Shaiku_save_session_reply, 1, 1, 0, + doc: /* Reply to a `save-session' event. +QUIT-REPLY means whether or not all files were saved and program +termination should proceed. + +Calls to this function must be balanced by the amount of +`save-session' events received. This is done automatically, so do not +call this function yourself. */) + (Lisp_Object quit_reply) +{ + struct haiku_session_manager_reply reply; + reply.quit_reply = !NILP (quit_reply); + + block_input (); + unrequest_sigio (); + write_port (port_emacs_to_session_manager, 0, &reply, + sizeof reply); + request_sigio (); + unblock_input (); + + return Qnil; +} + +DEFUN ("haiku-display-monitor-attributes-list", + Fhaiku_display_monitor_attributes_list, + Shaiku_display_monitor_attributes_list, + 0, 1, 0, + doc: /* Return a list of physical monitor attributes on 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. + +Internal use only, use `display-monitor-attributes-list' instead. */) + (Lisp_Object terminal) +{ + struct MonitorInfo monitor; + struct haiku_display_info *dpyinfo; + Lisp_Object frames, tail, tem; + + dpyinfo = check_haiku_display_info (terminal); + frames = Qnil; + + FOR_EACH_FRAME (tail, tem) + { + maybe_quit (); + + if (FRAME_HAIKU_P (XFRAME (tem)) + && !FRAME_TOOLTIP_P (XFRAME (tem))) + frames = Fcons (tem, frames); + } + + monitor.geom.x = 0; + monitor.geom.y = 0; + be_get_screen_dimensions ((int *) &monitor.geom.width, + (int *) &monitor.geom.height); + + monitor.mm_width = (monitor.geom.width + / (dpyinfo->resx / 25.4)); + monitor.mm_height = (monitor.geom.height + / (dpyinfo->resy / 25.4)); + monitor.name = (char *) "BeOS monitor"; + + if (!be_get_explicit_workarea ((int *) &monitor.work.x, + (int *) &monitor.work.y, + (int *) &monitor.work.width, + (int *) &monitor.work.height)) + monitor.work = monitor.geom; + + return make_monitor_attribute_list (&monitor, 1, 0, + make_vector (1, frames), + "fallback"); +} + +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, + haiku_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, + haiku_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, + haiku_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"); + + DEFSYM (Qstatic_color, "static-color"); + DEFSYM (Qstatic_gray, "static-gray"); + DEFSYM (Qtrue_color, "true-color"); + DEFSYM (Qmono, "mono"); + DEFSYM (Qgrayscale, "grayscale"); + DEFSYM (Qcolor, "color"); + + 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); + defsubr (&Shaiku_save_session_reply); + defsubr (&Shaiku_display_monitor_attributes_list); + + 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); + tip_dx = Qnil; + staticpro (&tip_dx); + tip_dy = Qnil; + staticpro (&tip_dy); + + 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; + + DEFVAR_LISP ("x-pointer-shape", Vx_pointer_shape, + doc: /* SKIP: real doc in xfns.c. */); + Vx_pointer_shape = Qnil; + + DEFVAR_LISP ("x-hourglass-pointer-shape", Vx_hourglass_pointer_shape, + doc: /* SKIP: real doc in xfns.c. */); + Vx_hourglass_pointer_shape = Qnil; + + DEFVAR_LISP ("x-sensitive-text-pointer-shape", + Vx_sensitive_text_pointer_shape, + doc: /* SKIP: real doc in xfns.c. */); + Vx_sensitive_text_pointer_shape = Qnil; + + DEFVAR_LISP ("haiku-allowed-ui-colors", Vhaiku_allowed_ui_colors, + doc: /* Vector of UI colors that Emacs can look up from the system. +If this is set up incorrectly, Emacs can crash when encoutering an +invalid color. */); + Vhaiku_allowed_ui_colors = 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..3e7f6f86dcb --- /dev/null +++ b/src/haikufont.c @@ -0,0 +1,1357 @@ +/* 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); + + int *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_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_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_EXTRALIGHT; + 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) || EQ (weight, Qregular)) + 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_EXTRA_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; + + return HAIKU_REGULAR; +} + +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) || EQ (slant, Qregular)) + return SLANT_REGULAR; + + return SLANT_REGULAR; +} + +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) || EQ (lisp, Qregular)) + 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; + + return NORMAL_WIDTH; +} + +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 entity, extras; + + entity = font_make_entity (); + extras = Qnil; + + ASET (entity, FONT_TYPE_INDEX, Qhaiku); + ASET (entity, FONT_FOUNDRY_INDEX, Qhaiku); + ASET (entity, FONT_FAMILY_INDEX, Qdefault); + ASET (entity, FONT_ADSTYLE_INDEX, Qnil); + ASET (entity, FONT_REGISTRY_INDEX, Qiso10646_1); + ASET (entity, FONT_SIZE_INDEX, make_fixnum (0)); + ASET (entity, FONT_AVGWIDTH_INDEX, make_fixnum (0)); + ASET (entity, FONT_SPACING_INDEX, make_fixnum (FONT_SPACING_MONO)); + + /* FONT_EXTRA_INDEX in a font entity can contain a cons of two + numbers (STYLE . IDX) under the key :indices that tell Emacs how + to open a font. */ + if (ptn->specified & FSPEC_INDICES) + extras = Fcons (Fcons (QCindices, + Fcons (make_fixnum (ptn->family_index), + make_fixnum (ptn->style_index))), + extras); + + if (ptn->specified & FSPEC_ANTIALIAS) + extras = Fcons (Fcons (QCantialias, + ptn->use_antialiasing ? Qt : Qnil), + extras); + + ASET (entity, FONT_EXTRA_INDEX, extras); + + FONT_SET_STYLE (entity, FONT_WIDTH_INDEX, Qnormal); + FONT_SET_STYLE (entity, FONT_WEIGHT_INDEX, Qnormal); + FONT_SET_STYLE (entity, FONT_SLANT_INDEX, Qnormal); + + if (ptn->specified & FSPEC_FAMILY) + ASET (entity, FONT_FAMILY_INDEX, intern (ptn->family)); + else + ASET (entity, FONT_FAMILY_INDEX, Qdefault); + + if (ptn->specified & FSPEC_STYLE) + ASET (entity, FONT_ADSTYLE_INDEX, intern (ptn->style)); + else + { + if (ptn->specified & FSPEC_WEIGHT) + FONT_SET_STYLE (entity, FONT_WEIGHT_INDEX, + haikufont_weight_to_lisp (ptn->weight)); + if (ptn->specified & FSPEC_SLANT) + FONT_SET_STYLE (entity, FONT_SLANT_INDEX, + haikufont_slant_to_lisp (ptn->slant)); + if (ptn->specified & FSPEC_WIDTH) + FONT_SET_STYLE (entity, FONT_WIDTH_INDEX, + haikufont_width_to_lisp (ptn->width)); + } + + if (ptn->specified & FSPEC_SPACING) + ASET (entity, FONT_SPACING_INDEX, + make_fixnum (ptn->mono_spacing_p + ? FONT_SPACING_MONO + : FONT_SPACING_PROPORTIONAL)); + + return entity; +} + +static void +haikufont_pattern_from_object (struct haiku_font_pattern *pattern, + Lisp_Object font_object) +{ + Lisp_Object val; + + pattern->specified = 0; + + val = AREF (font_object, FONT_FAMILY_INDEX); + if (!NILP (val)) + { + pattern->specified |= FSPEC_FAMILY; + strncpy ((char *) &pattern->family, + SSDATA (SYMBOL_NAME (val)), + sizeof pattern->family - 1); + pattern->family[sizeof pattern->family - 1] = '\0'; + } + + val = AREF (font_object, FONT_ADSTYLE_INDEX); + if (!NILP (val)) + { + pattern->specified |= FSPEC_STYLE; + strncpy ((char *) &pattern->style, + SSDATA (SYMBOL_NAME (val)), + sizeof pattern->style - 1); + pattern->style[sizeof pattern->style - 1] = '\0'; + } + + val = FONT_WEIGHT_FOR_FACE (font_object); + if (!NILP (val) && !EQ (val, Qunspecified)) + { + pattern->specified |= FSPEC_WEIGHT; + pattern->weight = haikufont_lisp_to_weight (val); + } + + val = FONT_SLANT_FOR_FACE (font_object); + if (!NILP (val) && !EQ (val, Qunspecified)) + { + pattern->specified |= FSPEC_SLANT; + pattern->slant = haikufont_lisp_to_slant (val); + } + + val = FONT_WIDTH_FOR_FACE (font_object); + if (!NILP (val) && !EQ (val, Qunspecified)) + { + pattern->specified |= FSPEC_WIDTH; + pattern->width = haikufont_lisp_to_width (val); + } + + val = assq_no_quit (QCantialias, + AREF (font_object, FONT_EXTRA_INDEX)); + if (CONSP (val)) + { + pattern->specified |= FSPEC_ANTIALIAS; + pattern->use_antialiasing = !NILP (XCDR (val)); + } +} + +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 = assq_no_quit (QCantialias, AREF (ent, FONT_EXTRA_INDEX)); + if (CONSP (tem)) + { + ptn->specified |= FSPEC_ANTIALIAS; + ptn->use_antialiasing = !NILP (XCDR (tem)); + } + + 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, tem, extra, indices, antialias; + int px_size, min_width, max_width; + int avg_width, height, space_width, ascent; + int descent, underline_pos, underline_thickness; + + if (x <= 0) + { + /* Get pixel size from frame instead. */ + tem = get_frame_param (f, Qfontsize); + x = NILP (tem) ? 0 : XFIXNAT (tem); + } + + extra = AREF (font_entity, FONT_EXTRA_INDEX); + + indices = assq_no_quit (QCindices, extra); + antialias = assq_no_quit (QCantialias, extra); + + if (CONSP (indices)) + indices = XCDR (indices); + + /* If the font's indices is already available, open the font using + those instead. */ + + if (CONSP (indices) && FIXNUMP (XCAR (indices)) + && FIXNUMP (XCDR (indices))) + { + block_input (); + be_font = be_open_font_at_index (XFIXNUM (XCAR (indices)), + XFIXNUM (XCDR (indices)), x); + unblock_input (); + + if (!be_font) + return Qnil; + } + else + { + block_input (); + 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); + unblock_input (); + } + + block_input (); + + 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); + + if (CONSP (antialias)) + be_set_font_antialiasing (be_font, !NILP (XCDR (antialias))); + + 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; + + BFont_metrics (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) +{ + struct haikufont_info *info = (struct haikufont_info *) font; + int i; + + if (font_data_structures_may_be_ill_formed ()) + return; + + block_input (); + if (info && info->be_font) + BFont_close (info->be_font); + + for (i = 0; i < info->metrics_nrows; i++) + { + if (info->metrics[i]) + xfree (info->metrics[i]); + } + + if (info->metrics) + xfree (info->metrics); + + for (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; + + haiku_draw_background_rect (s, s->face, 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; +} + +/* List of boolean properties in font names accepted by this font + driver. */ +static const char *const haikufont_booleans[] = + { + ":antialias", + NULL, + }; + +/* List of non-boolean properties. Currently empty. */ +static const char *const haikufont_non_booleans[1]; + +static void +haikufont_filter_properties (Lisp_Object font, Lisp_Object alist) +{ + font_filter_properties (font, alist, haikufont_booleans, + haikufont_non_booleans); +} + +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, + .filter_properties = haikufont_filter_properties, + }; + +static bool +haikufont_should_quit_popup (void) +{ + return !NILP (Vquit_flag); +} + +DEFUN ("x-select-font", Fx_select_font, Sx_select_font, 0, 2, 0, + doc: /* Read a font using a native dialog. +Return a font spec describing the font chosen by the user. + +FRAME is the frame on which to pop up the font chooser. If omitted or +nil, it defaults to the selected frame. +If EXCLUDE-PROPORTIONAL is non-nil, exclude proportional fonts +in the font selection dialog. */) + (Lisp_Object frame, Lisp_Object exclude_proportional) +{ + struct frame *f; + struct font *font; + Lisp_Object font_object; + haiku_font_family_or_style family, style; + int rc, size, initial_family, initial_style, initial_size; + struct haiku_font_pattern pattern; + Lisp_Object lfamily, lweight, lslant, lwidth, ladstyle, lsize; + bool disable_antialiasing, initial_antialias; + + f = decode_window_system_frame (frame); + + if (popup_activated_p) + error ("Trying to use a menu from within a menu-entry"); + + initial_style = -1; + initial_family = -1; + initial_size = -1; + initial_antialias = true; + + font = FRAME_FONT (f); + + if (font) + { + XSETFONT (font_object, font); + + haikufont_pattern_from_object (&pattern, font_object); + be_find_font_indices (&pattern, &initial_family, + &initial_style); + haikufont_done_with_query_pattern (&pattern); + + initial_size = font->pixel_size; + + /* This field is safe to access even after + haikufont_done_with_query_pattern. */ + if (pattern.specified & FSPEC_ANTIALIAS) + initial_antialias = pattern.use_antialiasing; + } + + popup_activated_p++; + unrequest_sigio (); + rc = be_select_font (process_pending_signals, + haikufont_should_quit_popup, + &family, &style, &size, + !NILP (exclude_proportional), + initial_family, initial_style, + initial_size, initial_antialias, + &disable_antialiasing); + request_sigio (); + popup_activated_p--; + + if (!rc) + quit (); + + be_font_style_to_flags (style, &pattern); + + lfamily = build_string_from_utf8 (family); + lweight = (pattern.specified & FSPEC_WEIGHT + ? haikufont_weight_to_lisp (pattern.weight) : Qnil); + lslant = (pattern.specified & FSPEC_SLANT + ? haikufont_slant_to_lisp (pattern.slant) : Qnil); + lwidth = (pattern.specified & FSPEC_WIDTH + ? haikufont_width_to_lisp (pattern.width) : Qnil); + ladstyle = (pattern.specified & FSPEC_STYLE + ? intern (pattern.style) : Qnil); + lsize = (size >= 0 ? make_fixnum (size) : Qnil); + + if (disable_antialiasing) + return CALLN (Ffont_spec, QCfamily, lfamily, + QCweight, lweight, QCslant, lslant, + QCwidth, lwidth, QCadstyle, ladstyle, + QCsize, lsize, QCantialias, Qnil); + + return CALLN (Ffont_spec, QCfamily, lfamily, + QCweight, lweight, QCslant, lslant, + QCwidth, lwidth, QCadstyle, ladstyle, + QCsize, lsize); +} + +static void +syms_of_haikufont_for_pdumper (void) +{ + register_font_driver (&haikufont_driver, NULL); +} + +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 (Qregular, "regular"); + DEFSYM (Qzh, "zh"); + DEFSYM (Qko, "ko"); + DEFSYM (Qjp, "jp"); + + DEFSYM (QCindices, ":indices"); + +#ifdef USE_BE_CAIRO + Fput (Qhaiku, Qfont_driver_superseded_by, Qftcr); +#endif + pdumper_do_now_and_after_load (syms_of_haikufont_for_pdumper); + + font_cache = list (Qnil); + staticpro (&font_cache); + + defsubr (&Sx_select_font); + + be_init_font_data (); +} diff --git a/src/haikugui.h b/src/haikugui.h new file mode 100644 index 00000000000..0dc127e6b63 --- /dev/null +++ b/src/haikugui.h @@ -0,0 +1,203 @@ +/* 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; + +/* Cursor bitmaps. These are only used to create colored cursors when + the user specifies a mouse color. */ + +MAYBE_UNUSED static unsigned char cross_ptr_bits[] = + { + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x00, + 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x80, + 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, + 0x80, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf0, 0x1f, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, + 0x00, 0x80, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x80, 0x00, + 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x80, + 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 + }; + +MAYBE_UNUSED static unsigned char cross_ptrmask_bits[] = + { + 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0xc0, 0x01, + 0x00, 0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, + 0x01, 0x00, 0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x01, 0x00, 0x00, + 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x01, 0x00, + 0x00, 0x80, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0xfc, 0x07, 0xf0, 0x1f, 0xfe, 0x0f, 0xf8, 0x3f, 0xfc, 0x07, + 0xf0, 0x1f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x80, 0x00, 0x00, 0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x01, 0x00, + 0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x01, + 0x00, 0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, + 0x01, 0x00, 0x00, 0xc0, 0x01, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 + }; + +MAYBE_UNUSED static unsigned char ibeam_ptr_bits[] = + { + 0x00, 0x00, 0x00, 0x00, 0xfc, 0x1f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, + 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, + 0xc0, 0x01, 0xfc, 0x1f, 0x00, 0x00, 0x00, 0x00 + }; + +MAYBE_UNUSED static unsigned char ibeam_ptrmask_bits[] = + { + 0x00, 0x00, 0xfc, 0x1f, 0xfe, 0x3f, 0xfc, 0x1f, 0xe0, 0x03, 0xe0, + 0x03, 0xe0, 0x03, 0xe0, 0x03, 0xe0, 0x03, 0xe0, 0x03, 0xe0, 0x03, + 0xfc, 0x1f, 0xfe, 0x3f, 0xfc, 0x1f, 0x00, 0x00 + }; + +MAYBE_UNUSED static unsigned char hand_ptr_bits[] = + { + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xa0, 0x02, 0xa0, 0x02, 0xa0, + 0x02, 0xf0, 0x07, 0xf0, 0x07, 0xf0, 0x07, 0xf0, 0x07, 0xf0, 0x07, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 + }; + +MAYBE_UNUSED static unsigned char hand_ptrmask_bits[] = + { + 0x00, 0x00, 0x00, 0x00, 0xa0, 0x02, 0xf0, 0x07, 0xf0, 0x07, 0xf8, + 0x0f, 0xf8, 0x0f, 0xf8, 0x0f, 0xf8, 0x0f, 0xf8, 0x0f, 0xf8, 0x0f, + 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 + }; + +MAYBE_UNUSED static unsigned char horizd_ptr_bits[] = + { + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x04, 0x28, + 0x0a, 0xf4, 0x17, 0x02, 0x20, 0xf4, 0x17, 0x28, 0x0a, 0x10, 0x04, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 + }; + +MAYBE_UNUSED static unsigned char horizd_ptrmask_bits[] = + { + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x04, 0x38, + 0x0e, 0xfc, 0x1f, 0xfe, 0x3f, 0xfc, 0x1f, 0x38, 0x0e, 0x10, 0x04, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 + }; + +MAYBE_UNUSED static unsigned char vertd_ptr_bits[] = + { + 0x00, 0x00, 0x80, 0x00, 0x40, 0x01, 0x20, 0x02, 0x50, 0x05, 0x60, + 0x03, 0x40, 0x01, 0x40, 0x01, 0x40, 0x01, 0x60, 0x03, 0x50, 0x05, + 0x20, 0x02, 0x40, 0x01, 0x80, 0x00, 0x00, 0x00 + }; + +MAYBE_UNUSED static unsigned char vertd_ptrmask_bits[] = + { + 0x00, 0x00, 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xe0, + 0x03, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, + 0xe0, 0x03, 0xc0, 0x01, 0x80, 0x00, 0x00, 0x00 + }; + +MAYBE_UNUSED static unsigned char hourglass_bits[] = + { + 0x00, 0x00, 0x00, 0x00, 0xe0, 0x03, 0x10, 0x04, 0x08, 0x08, 0x24, + 0x10, 0x44, 0x10, 0x84, 0x10, 0x84, 0x10, 0x84, 0x10, 0x88, 0x08, + 0x10, 0x04, 0xe0, 0x03, 0x00, 0x00, 0x00, 0x00 + }; + +MAYBE_UNUSED static unsigned char hourglass_mask_bits[] = + { + 0x00, 0x00, 0x00, 0x00, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, + 0x1f, 0xfc, 0x1f, 0xfc, 0x1f, 0xfc, 0x1f, 0xfc, 0x1f, 0xf8, 0x0f, + 0xf0, 0x07, 0xe0, 0x03, 0x00, 0x00, 0x00, 0x00 + }; + +#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..929ed952105 --- /dev/null +++ b/src/haikumenu.c @@ -0,0 +1,843 @@ +/* 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, + bool is_menu_bar) +{ + void **menus, **panes; + ssize_t menu_len; + ssize_t pane_len; + int i, menu_depth; + void *menu, *window, *view; + Lisp_Object pane_name, prefix; + const char *pane_string; + Lisp_Object item_name, enable, descrip, def, selected, help; + + USE_SAFE_ALLOCA; + + menu_len = (menu_items_used + 1 - start) * sizeof *menus; + pane_len = (menu_items_used + 1 - start) * sizeof *panes; + menu = first_menu; + + i = start; + menu_depth = 0; + + menus = SAFE_ALLOCA (menu_len); + panes = SAFE_ALLOCA (pane_len); + memset (menus, 0, menu_len); + memset (panes, 0, pane_len); + menus[0] = first_menu; + + window = NULL; + 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)) + { + 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 + { + 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 (!is_menu_bar) + { + 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); + + SAFE_FREE (); +} + +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, submenu_depth, j; + void *view, *menu; + Lisp_Object *subprefix_stack; + Lisp_Object prefix, entry; + + USE_SAFE_ALLOCA; + + view = FRAME_HAIKU_VIEW (f); + i = 0; + submenu_depth = 0; + subprefix_stack + = SAFE_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"; + + SAFE_FREE (); + 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 (); + + unrequest_sigio (); + 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--; + request_sigio (); + + FRAME_DISPLAY_INFO (f)->grabbed = 0; + + if (menu_item_selection) + { + 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) + { + 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 (); + + SAFE_FREE (); + 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 (); + + SAFE_FREE (); + return Qnil; +} + +void +free_frame_menubar (struct frame *f) +{ + void *mbar; + + FRAME_MENU_BAR_LINES (f) = 0; + FRAME_MENU_BAR_HEIGHT (f) = 0; + FRAME_EXTERNAL_MENU_BAR (f) = 0; + + block_input (); + mbar = FRAME_HAIKU_MENU_BAR (f); + FRAME_HAIKU_MENU_BAR (f) = NULL; + + 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); + bool first_time_p = false; + + if (!mbar) + { + block_input (); + mbar = FRAME_HAIKU_MENU_BAR (f) = BMenuBar_new (view); + first_time_p = 1; + + /* Now wait for the MENU_BAR_RESIZE event informing us of the + initial dimensions of that menu bar. */ + if (FRAME_VISIBLE_P (f)) + haiku_wait_for_event (f, MENU_BAR_RESIZE); + + unblock_input (); + } + + 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) + { + 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. */ + 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); + + /* 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, vec, help; + + XSETFRAME (frame, f); + + block_input (); + 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)) + return; + + 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 +haiku_activate_menubar (struct frame *f) +{ + int rc; + + if (!FRAME_HAIKU_MENU_BAR (f)) + return; + + set_frame_menubar (f, true); + + if (FRAME_OUTPUT_DATA (f)->saved_menu_event) + { + block_input (); + rc = be_replay_menu_bar_event (FRAME_HAIKU_MENU_BAR (f), + FRAME_OUTPUT_DATA (f)->saved_menu_event); + xfree (FRAME_OUTPUT_DATA (f)->saved_menu_event); + FRAME_OUTPUT_DATA (f)->saved_menu_event = NULL; + unblock_input (); + + if (!rc) + return; + + FRAME_OUTPUT_DATA (f)->menu_bar_open_p = 1; + popup_activated_p += 1; + } + else + { + block_input (); + rc = BMenuBar_start_tracking (FRAME_HAIKU_MENU_BAR (f)); + unblock_input (); + + if (!rc) + return; + + FRAME_OUTPUT_DATA (f)->menu_bar_open_p = 1; + popup_activated_p += 1; + } +} + +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..dc0a7edf430 --- /dev/null +++ b/src/haikuselect.c @@ -0,0 +1,1149 @@ +/* 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 "keyboard.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; + +/* Whether or not to move the tip frame during drag-and-drop. */ +bool haiku_dnd_follow_tooltip; + +static void haiku_lisp_to_message (Lisp_Object, void *); + +static enum haiku_clipboard +haiku_get_clipboard_name (Lisp_Object clipboard) +{ + if (EQ (clipboard, QPRIMARY)) + return CLIPBOARD_PRIMARY; + + if (EQ (clipboard, QSECONDARY)) + return CLIPBOARD_SECONDARY; + + if (EQ (clipboard, QCLIPBOARD)) + return CLIPBOARD_CLIPBOARD; + + signal_error ("Invalid clipboard", clipboard); +} + +DEFUN ("haiku-selection-timestamp", Fhaiku_selection_timestamp, + Shaiku_selection_timestamp, 1, 1, 0, + doc: /* Retrieve the "timestamp" of the clipboard CLIPBOARD. +CLIPBOARD can either be the symbol `PRIMARY', `SECONDARY' or +`CLIPBOARD'. The timestamp is returned as a number describing the +number of times programs have put data into CLIPBOARD. */) + (Lisp_Object clipboard) +{ + enum haiku_clipboard clipboard_name; + int64 timestamp; + + clipboard_name = haiku_get_clipboard_name (clipboard); + timestamp = be_get_clipboard_count (clipboard_name); + + return INT_TO_INTEGER (timestamp); +} + +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); + clipboard_name = haiku_get_clipboard_name (clipboard); + + if (!NILP (name)) + { + CHECK_STRING (name); + + block_input (); + dat = be_find_clipboard_data (clipboard_name, + 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 (); + free (dat); + unblock_input (); + } + else + { + 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; + + CHECK_SYMBOL (clipboard); + clipboard_name = haiku_get_clipboard_name (clipboard); + + if (CONSP (name) || NILP (name)) + { + be_update_clipboard_count (clipboard_name); + + 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_STRING (name); + if (!NILP (data)) + CHECK_STRING (data); + + dat = !NILP (data) ? SSDATA (data) : NULL; + len = !NILP (data) ? SBYTES (data) : 0; + + be_set_clipboard_data (clipboard_name, SSDATA (name), dat, len, + !NILP (clear)); + 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'. */) + (Lisp_Object selection) +{ + bool value; + enum haiku_clipboard name; + + block_input (); + name = haiku_get_clipboard_name (selection); + value = be_clipboard_owner_p (name); + 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 = DECODE_FILE (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; + + case 'DBLE': + t1 = make_float (*(double *) buf); + break; + + case 'FLOT': + t1 = make_float (*(float *) 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; + + case 'DBLE': + t2 = Qdouble; + break; + + case 'FLOT': + t2 = Qfloat; + 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 if (EQ (obj, Qfloat)) + return 'FLOT'; + else if (EQ (obj, Qdouble)) + return 'DBLE'; + 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, float_data; + double double_data; + int rc; + specpdl_ref ref; + + tem = obj; + + FOR_EACH_TAIL (tem) + { + 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); + t2 = XCDR (t1); + FOR_EACH_TAIL (t2) + { + 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", data); + unbind_to (ref, Qnil); + break; + + case 'RREF': + CHECK_STRING (data); + + if (be_add_refs_data (message, SSDATA (name), + SSDATA (ENCODE_FILE (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 'FLOT': + CHECK_NUMBER (data); + float_data = XFLOATINT (data); + + rc = be_add_message_data (message, SSDATA (name), + type_code, &float_data, + sizeof float_data); + + if (rc) + signal_error ("Failed to add float", data); + break; + + case 'DBLE': + CHECK_NUMBER (data); + double_data = XFLOATINT (data); + + rc = be_add_message_data (message, SSDATA (name), + type_code, &double_data, + sizeof double_data); + + if (rc) + signal_error ("Failed to add double", 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, 4, 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 TYPE is `float', then DATA is a low-precision floating point +number, whose exact precision is not guaranteed. If TYPE is `double', +then DATA is a floating point number that can represent any value a +Lisp float can represent. + +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. + +FOLLOW-TOOLTIP, if non-nil, will cause any non-system tooltip +currently being displayed to move along with the mouse pointer. */) + (Lisp_Object frame, Lisp_Object message, Lisp_Object allow_same_frame, + Lisp_Object follow_tooltip) +{ + 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; + haiku_dnd_follow_tooltip = !NILP (follow_tooltip); + 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); + + /* Don't clear the mouse grab if the user decided to quit instead + of the drop finishing. */ + if (rc) + quit (); + + /* Now dismiss the tooltip, since the drop presumably succeeded. */ + if (!NILP (follow_tooltip)) + Fx_hide_tip (); + + FRAME_DISPLAY_INFO (f)->grabbed = 0; + + return unbind_to (idx, Qnil); +} + +DEFUN ("haiku-roster-launch", Fhaiku_roster_launch, Shaiku_roster_launch, + 2, 2, 0, + doc: /* Launch an application associated with FILE-OR-TYPE. +Return the process ID of any process created, the symbol +`already-running' if ARGS was sent to a program that's already +running, or nil if launching the application failed because no +application was found for FILE-OR-TYPE. + +Signal an error if FILE-OR-TYPE is invalid, or if ARGS is a message +but the application doesn't accept messages. + +FILE-OR-TYPE can either be a string denoting a MIME type, or a list +with one argument FILE, denoting a file whose associated application +will be launched. + +ARGS can either be a vector of strings containing the arguments that +will be passed to the application, or a system message in the form +accepted by `haiku-drag-message' that will be sent to the application +after it starts. */) + (Lisp_Object file_or_type, Lisp_Object args) +{ + char **cargs; + char *type, *file; + team_id team_id; + status_t rc; + ptrdiff_t i, nargs; + Lisp_Object tem, canonical; + void *message; + specpdl_ref depth; + + type = NULL; + file = NULL; + cargs = NULL; + message = NULL; + nargs = 0; + depth = SPECPDL_INDEX (); + + USE_SAFE_ALLOCA; + + if (STRINGP (file_or_type)) + SAFE_ALLOCA_STRING (type, file_or_type); + else + { + CHECK_LIST (file_or_type); + tem = XCAR (file_or_type); + canonical = Fexpand_file_name (tem, Qnil); + + CHECK_STRING (tem); + SAFE_ALLOCA_STRING (file, ENCODE_FILE (canonical)); + CHECK_LIST_END (XCDR (file_or_type), file_or_type); + } + + if (VECTORP (args)) + { + nargs = ASIZE (args); + cargs = SAFE_ALLOCA (nargs * sizeof *cargs); + + for (i = 0; i < nargs; ++i) + { + tem = AREF (args, i); + CHECK_STRING (tem); + maybe_quit (); + + cargs[i] = SAFE_ALLOCA (SBYTES (tem) + 1); + memcpy (cargs[i], SDATA (tem), SBYTES (tem) + 1); + } + } + else + { + message = be_create_simple_message (); + + record_unwind_protect_ptr (BMessage_delete, message); + haiku_lisp_to_message (args, message); + } + + block_input (); + rc = be_roster_launch (type, file, cargs, nargs, message, + &team_id); + unblock_input (); + + /* `be_roster_launch' can potentially take a while in IO, but + signals from async input will interrupt that operation. If the + user wanted to quit, act like it. */ + maybe_quit (); + + if (rc == B_OK) + return SAFE_FREE_UNBIND_TO (depth, + make_uint (team_id)); + else if (rc == B_ALREADY_RUNNING) + return Qalready_running; + else if (rc == B_BAD_VALUE) + signal_error ("Invalid type or bad arguments", + list2 (file_or_type, args)); + + return SAFE_FREE_UNBIND_TO (depth, Qnil); +} + +static void +haiku_dnd_compute_tip_xy (int *root_x, int *root_y) +{ + int min_x, min_y, max_x, max_y; + int width, height; + + width = FRAME_PIXEL_WIDTH (XFRAME (tip_frame)); + height = FRAME_PIXEL_HEIGHT (XFRAME (tip_frame)); + + min_x = 0; + min_y = 0; + be_get_screen_dimensions (&max_x, &max_y); + + if (*root_y + XFIXNUM (tip_dy) <= min_y) + *root_y = min_y; /* Can happen for negative dy */ + else if (*root_y + XFIXNUM (tip_dy) + height <= max_y) + /* It fits below the pointer */ + *root_y += XFIXNUM (tip_dy); + else if (height + XFIXNUM (tip_dy) + min_y <= *root_y) + /* It fits above the pointer. */ + *root_y -= height + XFIXNUM (tip_dy); + else + /* Put it on the top. */ + *root_y = min_y; + + if (*root_x + XFIXNUM (tip_dx) <= min_x) + *root_x = 0; /* Can happen for negative dx */ + else if (*root_x + XFIXNUM (tip_dx) + width <= max_x) + /* It fits to the right of the pointer. */ + *root_x += XFIXNUM (tip_dx); + else if (width + XFIXNUM (tip_dx) + min_x <= *root_x) + /* It fits to the left of the pointer. */ + *root_x -= width + XFIXNUM (tip_dx); + else + /* Put it left justified on the screen -- it ought to fit that way. */ + *root_x = min_x; +} + +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) +{ + struct frame *tip_f; + int x, y; + + if (FRAMEP (tip_frame) && haiku_dnd_follow_tooltip + && FIXNUMP (tip_dx) && FIXNUMP (tip_dy)) + { + tip_f = XFRAME (tip_frame); + + if (FRAME_LIVE_P (tip_f) && FRAME_VISIBLE_P (tip_f)) + { + BView_get_mouse (FRAME_HAIKU_VIEW (haiku_dnd_frame), + &x, &y); + BView_convert_to_screen (FRAME_HAIKU_VIEW (haiku_dnd_frame), + &x, &y); + + haiku_dnd_compute_tip_xy (&x, &y); + BWindow_set_offset (FRAME_HAIKU_WINDOW (tip_f), x, y); + } + } + + internal_catch_all (haiku_note_drag_motion_1, NULL, + haiku_note_drag_motion_2); +} + +void +init_haiku_select (void) +{ + be_clipboard_init (); +} + +void +haiku_handle_selection_clear (struct input_event *ie) +{ + enum haiku_clipboard id; + + id = haiku_get_clipboard_name (ie->arg); + + if (be_selection_outdated_p (id, ie->timestamp)) + return; + + CALLN (Frun_hook_with_args, + Qhaiku_lost_selection_functions, ie->arg); + + /* This is required for redisplay to happen if something changed the + display inside the selection loss functions. */ + redisplay_preserve_echo_area (20); +} + +void +haiku_selection_disowned (enum haiku_clipboard id, int64 count) +{ + struct input_event ie; + + EVENT_INIT (ie); + ie.kind = SELECTION_CLEAR_EVENT; + + switch (id) + { + case CLIPBOARD_CLIPBOARD: + ie.arg = QCLIPBOARD; + break; + + case CLIPBOARD_PRIMARY: + ie.arg = QPRIMARY; + break; + + case CLIPBOARD_SECONDARY: + ie.arg = QSECONDARY; + break; + } + + ie.timestamp = count; + kbd_buffer_store_event (&ie); +} + +void +haiku_start_watching_selections (void) +{ + be_start_watching_selection (CLIPBOARD_CLIPBOARD); + be_start_watching_selection (CLIPBOARD_PRIMARY); + be_start_watching_selection (CLIPBOARD_SECONDARY); +} + +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; + + DEFVAR_LISP ("haiku-lost-selection-functions", Vhaiku_lost_selection_functions, + doc: /* A list of functions to be called when Emacs loses an X selection. +These are only called if a connection to the Haiku display was opened. */); + Vhaiku_lost_selection_functions = Qnil; + + DEFSYM (QSECONDARY, "SECONDARY"); + DEFSYM (QCLIPBOARD, "CLIPBOARD"); + DEFSYM (QSTRING, "STRING"); + DEFSYM (QUTF8_STRING, "UTF8_STRING"); + DEFSYM (Qforeign_selection, "foreign-selection"); + DEFSYM (QTARGETS, "TARGETS"); + + DEFSYM (Qhaiku_lost_selection_functions, + "haiku-lost-selection-functions"); + + 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"); + DEFSYM (Qfloat, "float"); + DEFSYM (Qdouble, "double"); + DEFSYM (Qalready_running, "already-running"); + + defsubr (&Shaiku_selection_data); + defsubr (&Shaiku_selection_timestamp); + defsubr (&Shaiku_selection_put); + defsubr (&Shaiku_selection_owner_p); + defsubr (&Shaiku_drag_message); + defsubr (&Shaiku_roster_launch); + + haiku_dnd_frame = NULL; +} diff --git a/src/haikuselect.h b/src/haikuselect.h new file mode 100644 index 00000000000..42e9c93f7e9 --- /dev/null +++ b/src/haikuselect.h @@ -0,0 +1,79 @@ +/* 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> +#else +#include <stdio.h> +#endif + +#include <SupportDefs.h> + +enum haiku_clipboard + { + CLIPBOARD_PRIMARY, + CLIPBOARD_SECONDARY, + CLIPBOARD_CLIPBOARD + }; + +#ifdef __cplusplus +extern "C" +{ +#endif +/* Defined in haikuselect.c. */ +extern void haiku_selection_disowned (enum haiku_clipboard, int64); + +/* Defined in haiku_select.cc. */ +extern void be_clipboard_init (void); +extern char *be_find_clipboard_data (enum haiku_clipboard, const char *, ssize_t *); +extern void be_set_clipboard_data (enum haiku_clipboard, const char *, const char *, + ssize_t, bool); +extern bool be_clipboard_owner_p (enum haiku_clipboard); +extern void be_update_clipboard_count (enum haiku_clipboard); + +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); +extern void be_handle_clipboard_changed_message (void); +extern void be_start_watching_selection (enum haiku_clipboard); +extern bool be_selection_outdated_p (enum haiku_clipboard, int64); +extern int64 be_get_clipboard_count (enum haiku_clipboard); + +#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..bcb3af0e2c3 --- /dev/null +++ b/src/haikuterm.c @@ -0,0 +1,4672 @@ +/* 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 "haikuselect.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 + +/* The single Haiku display (if any). */ +struct haiku_display_info *x_display_list; + +/* This is used to determine when to evict the font lookup cache, + which we do every 50 updates. */ +static int up_to_date_count; + +/* List of defined fringe bitmaps. */ +static void **fringe_bmps; + +/* The amount of fringe bitmaps in that list. */ +static int max_fringe_bmp; + +/* Alist of resources to their values. */ +static Lisp_Object rdb; + +/* Non-zero means that a HELP_EVENT has been generated since Emacs + start. */ +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); + + *x -= FRAME_OUTPUT_DATA (p)->frame_x; + *y -= FRAME_OUTPUT_DATA (p)->frame_y; +} + +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 * +haiku_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) +{ + if (f->tooltip) + return; + + 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))); + 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); + BView_invalidate_region (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); + + up_to_date_count++; + if (up_to_date_count == 50) + { + be_evict_font_cache (); + up_to_date_count = 0; + } + 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; + int ascent, descent, unit; + + 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; + + 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); + + 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); + + 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 (!scroll_bar) + 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) +{ + int rc; + + rc = !haiku_get_color (name, color); + + if (rc && f->gamma && alloc) + gamma_correct (f, color); + + return rc; +} + +/* 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) +{ + double h, cs, l; + uint32_t rgbin; + struct haiku_output *di; + + if (s->face->use_box_color_for_shadows_p) + rgbin = s->face->box_color; + else if (s->first_glyph->type == IMAGE_GLYPH + && s->img->pixmap + && !IMAGE_BACKGROUND_TRANSPARENT (s->img, s->f, 0)) + rgbin = IMAGE_BACKGROUND (s->img, s->f, 0); + else + rgbin = s->face->background; + + di = FRAME_OUTPUT_DATA (s->f); + + if (s->hl == DRAW_CURSOR) + rgbin = FRAME_CURSOR_COLOR (s->f).pixel; + + if (di->relief_background != rgbin) + { + di->relief_background = rgbin & 0xffffffff; + + rgb_color_hsl (rgbin, &h, &cs, &l); + hsl_color_rgb (h, cs, fmin (1.0, fmax (0.2, l) * 0.6), + &di->black_relief_pixel); + hsl_color_rgb (h, cs, fmin (1.0, fmax (0.2, l) * 1.2), + &di->white_relief_pixel); + } + + *rgbout_w = di->white_relief_pixel; + *rgbout_b = di->black_relief_pixel; +} + +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) +{ + uint32_t color_white, color_black; + void *view; + + view = FRAME_HAIKU_VIEW (s->f); + haiku_calculate_relief_colors (s, &color_white, &color_black); + + 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, FRAME_BACKGROUND_PIXEL (s->f)); + + /* 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_get_scale_factor (int *scale_x, int *scale_y) +{ + struct haiku_display_info *dpyinfo = x_display_list; + + if (dpyinfo->resx > 96) + *scale_x = floor (dpyinfo->resx / 96); + if (dpyinfo->resy > 96) + *scale_y = floor (dpyinfo->resy / 96); +} + +static void +haiku_draw_underwave (struct glyph_string *s, int width, int x) +{ + int wave_height, wave_length; + int y, dx, dy, odd, xmax, scale_x, scale_y; + float ax, ay, bx, by; + void *view; + + scale_x = 1; + scale_y = 1; + haiku_get_scale_factor (&scale_x, &scale_y); + wave_height = 3 * scale_y; + wave_length = 2 * scale_x; + + dx = wave_length; + dy = wave_height - 1; + y = s->ybase - wave_height + 3; + xmax = x + width; + 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; + + BView_SetPenSize (view, scale_y); + + 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_SetPenSize (view, 1); + 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) || BASE_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) || BASE_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); +} + +static void +haiku_draw_plain_background (struct glyph_string *s, struct face *face, + int x, int y, int width, int height) +{ + 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, x, y, width, height); +} + +static struct haiku_bitmap_record * +haiku_get_bitmap_rec (struct frame *f, ptrdiff_t id) +{ + return &FRAME_DISPLAY_INFO (f)->bitmaps[id - 1]; +} + +static void +haiku_update_bitmap_rec (struct haiku_bitmap_record *rec, + uint32_t new_foreground, + uint32_t new_background) +{ + char *bits; + int x, y, bytes_per_line; + + if (new_foreground == rec->stipple_foreground + && new_background == rec->stipple_background) + return; + + bits = rec->stipple_bits; + bytes_per_line = (rec->width + 7) / 8; + + for (y = 0; y < rec->height; y++) + { + for (x = 0; x < rec->width; x++) + haiku_put_pixel (rec->img, x, y, + ((bits[x / 8] >> (x % 8)) & 1 + ? new_foreground : new_background)); + + bits += bytes_per_line; + } + + rec->stipple_foreground = new_foreground; + rec->stipple_background = new_background; +} + +static void +haiku_draw_stipple_background (struct glyph_string *s, struct face *face, + int x, int y, int width, int height, + bool explicit_colors_p, + uint32 explicit_background, + uint32 explicit_foreground) +{ + struct haiku_bitmap_record *rec; + unsigned long foreground, background; + void *view; + + view = FRAME_HAIKU_VIEW (s->f); + rec = haiku_get_bitmap_rec (s->f, s->face->stipple); + + if (explicit_colors_p) + { + background = explicit_background; + foreground = explicit_foreground; + } + else if (s->hl == DRAW_CURSOR) + haiku_merge_cursor_foreground (s, &foreground, &background); + else + { + foreground = s->face->foreground; + background = s->face->background; + } + + haiku_update_bitmap_rec (rec, foreground, background); + + BView_StartClip (view); + haiku_clip_to_string (s); + BView_ClipToRect (view, x, y, width, height); + BView_DrawBitmapTiled (view, rec->img, 0, 0, -1, -1, + 0, 0, x + width, y + height); + BView_EndClip (view); +} + +void +haiku_draw_background_rect (struct glyph_string *s, struct face *face, + int x, int y, int width, int height) +{ + if (!s->stippled_p) + haiku_draw_plain_background (s, face, x, y, width, height); + else + haiku_draw_stipple_background (s, face, x, y, width, height, + false, 0, 0); +} + +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) + { + haiku_draw_background_rect (s, s->face, s->x, s->y + box_line_width, + s->background_width, + s->height - 2 * box_line_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_SetPenSize (view, 1); + 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; + unsigned long color; + + /* 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) + { + if (s->hl == DRAW_CURSOR) + haiku_merge_cursor_foreground (s, NULL, &color); + else + color = s->face->foreground; + + BView_SetHighColor (FRAME_HAIKU_VIEW (s->f), color); + BView_SetPenSize (FRAME_HAIKU_VIEW (s->f), 1); + BView_StrokeRectangle (FRAME_HAIKU_VIEW (s->f), + x, s->ybase - glyph->ascent, + glyph->pixel_width, + glyph->ascent + glyph->descent); + } + x += glyph->pixel_width; + } +} + +static void +haiku_draw_stretch_glyph_string (struct glyph_string *s) +{ + struct face *face = s->face; + uint32_t bkg; + + 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; + + /* Draw stipples manually because we want the background + part of a stretch glyph to have a stipple even if the + cursor is visible on top. */ + if (!face->stipple) + { + 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->row->mouse_face_p && cursor_in_mouse_face_p (s->w)) + haiku_mouse_face_colors (s, NULL, &bkg); + else + bkg = face->background; + + haiku_draw_stipple_background (s, s->face, x, y, w, h, + true, bkg, face->foreground); + } + } + } + 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) + haiku_draw_background_rect (s, s->face, s->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_SetPenSize (view, 1); + BView_StrokeRectangle (view, s->x, s->y, + s->width, s->height); + } + 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); +} + +static void +haiku_translate_transform (double (*transform)[3], double dx, + double dy) +{ + transform[0][2] += dx; + transform[1][2] += dy; +} + +static void +haiku_draw_image_glyph_string (struct glyph_string *s) +{ + struct face *face = s->face; + void *view, *bitmap, *mask; + 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, height, width, relief; + struct haiku_rect nr; + Emacs_Rectangle cr, ir, r; + unsigned long background; + double image_transform[3][3]; + + 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; + + view = FRAME_HAIKU_VIEW (s->f); + bitmap = s->img->pixmap; + + s->stippled_p = face->stipple != 0; + + if (s->hl == DRAW_CURSOR) + haiku_merge_cursor_foreground (s, NULL, &background); + else + background = face->background; + + haiku_draw_background_rect (s, face, x, y, + width, height); + + if (bitmap) + { + 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; + + mask = s->img->mask; + + if (gui_intersect_rectangles (&cr, &ir, &r)) + { + memcpy (&image_transform, &s->img->transform, + sizeof image_transform); + + if (s->slice.x != x || s->slice.y != y + || s->slice.width != s->img->width + || s->slice.height != s->img->height) + { + BView_StartClip (view); + BView_ClipToRect (view, r.x, r.y, r.width, r.height); + } + + haiku_translate_transform (image_transform, + x - s->slice.x, + y - s->slice.y); + + be_apply_affine_transform (view, + image_transform[0][0], + image_transform[0][1], + image_transform[0][2], + image_transform[1][0], + image_transform[1][1], + image_transform[1][2]); + + if (!s->stippled_p || !mask) + { + BView_DrawBitmap (view, bitmap, 0, 0, + s->img->original_width, + s->img->original_height, + 0, 0, + s->img->original_width, + s->img->original_height, + s->img->use_bilinear_filtering); + + if (mask) + be_draw_image_mask (mask, view, 0, 0, + s->img->original_width, + s->img->original_height, + 0, 0, + s->img->original_width, + s->img->original_height, + background); + } + else + /* In order to make sure the stipple background remains + visible, use the mask for the alpha channel of BITMAP + and composite it onto the view instead. */ + be_draw_bitmap_with_mask (view, bitmap, mask, 0, 0, + s->img->original_width, + s->img->original_height, + 0, 0, + s->img->original_width, + s->img->original_height, + s->img->use_bilinear_filtering); + + if (s->slice.x != x || s->slice.y != y + || s->slice.width != s->img->width + || s->slice.height != s->img->height) + BView_EndClip (view); + + be_apply_affine_transform (view, 1, 0, 0, 0, 1, 0); + } + + 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) + { + relief = eabs (s->img->relief); + + BView_SetPenSize (view, 1); + BView_SetHighColor (view, FRAME_CURSOR_COLOR (s->f).pixel); + BView_StrokeRectangle (view, x - relief, y - relief, + s->slice.width + relief * 2, + s->slice.height + relief * 2); + } + } + } + + 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 = FRAME_HAIKU_VIEW (s->f);; + struct face *face = s->face; + + block_input (); + BView_draw_lock (view, false, 0, 0, 0, 0); + prepare_face_for_display (s->f, s->face); + + s->stippled_p = s->hl != DRAW_CURSOR && face->stipple; + + 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, next->face); + next->stippled_p + = next->hl != DRAW_CURSOR && next->face->stipple; + + haiku_start_clip (next); + haiku_clip_to_string (next); + if (next->first_glyph->type != STRETCH_GLYPH) + haiku_maybe_draw_background (next, true); + else + haiku_draw_stretch_glyph_string (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); + + /* Set the stipple_p flag indicating whether or not a stipple was + drawn in s->row. That is the case either when s is a stretch + glyph string and s->face->stipple is not NULL, or when + s->face->stipple exists and s->hl is not DRAW_CURSOR. */ + if (s->face->stipple + && (s->first_glyph->type == STRETCH_GLYPH + || s->hl != DRAW_CURSOR)) + s->row->stipple_p = true; + + 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 creation 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); + + if (FRAME_VISIBLE_P (f) + && (width != FRAME_PIXEL_WIDTH (f) + || height != FRAME_PIXEL_HEIGHT (f))) + haiku_wait_for_event (f, FRAME_RESIZED); + unblock_input (); + } + + do_pending_window_change (false); +} + +static void +haiku_draw_hollow_cursor (struct window *w, struct glyph_row *row) +{ + struct frame *f; + int x, y, wd, h; + struct glyph *cursor_glyph; + uint32_t foreground; + void *view; + + f = XFRAME (WINDOW_FRAME (w)); + view = FRAME_HAIKU_VIEW (f); + + /* 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; + + /* The foreground of cursor_gc is typically the same as the normal + background color, which can cause the cursor box to be invisible. */ + foreground = FRAME_CURSOR_COLOR (f).pixel; + + /* 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; + + /* Set clipping, draw the rectangle, and reset clipping again. + This also marks the region as invalidated. */ + + BView_draw_lock (view, true, x, y, wd, h); + BView_StartClip (view); + haiku_clip_to_row (w, row, TEXT_AREA); + + /* Now set the foreground color and pen size. */ + BView_SetHighColor (view, foreground); + BView_SetPenSize (view, 1); + + /* Actually draw the rectangle. */ + BView_StrokeRectangle (view, x, y, wd, h); + + /* Reset clipping. */ + BView_EndClip (view); + BView_draw_unlock (view); +} + +static void +haiku_draw_bar_cursor (struct window *w, struct glyph_row *row, + int width, enum text_cursor_kinds kind) +{ + struct frame *f; + struct glyph *cursor_glyph; + struct glyph_row *r; + struct face *face; + uint32_t foreground; + void *view; + int x, y, dummy_x, dummy_y, dummy_h; + + f = XFRAME (w->frame); + + /* 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; + + /* 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) + { + r = MATRIX_ROW (w->current_matrix, w->phys_cursor.vpos); + draw_phys_cursor_glyph (w, r, DRAW_CURSOR); + } + else + { + view = FRAME_HAIKU_VIEW (f); + face = FACE_FROM_ID (f, cursor_glyph->face_id); + + /* 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_CURSOR_COLOR (f).pixel) + foreground = face->foreground; + else + foreground = FRAME_CURSOR_COLOR (f).pixel; + + BView_draw_lock (view, false, 0, 0, 0, 0); + BView_StartClip (view); + BView_SetHighColor (view, foreground); + haiku_clip_to_row (w, row, TEXT_AREA); + + if (kind == BAR_CURSOR) + { + x = WINDOW_TEXT_TO_FRAME_PIXEL_X (w, w->phys_cursor.x); + y = WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y); + + 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; + + BView_FillRectangle (view, x, y, width, row->height); + BView_invalidate_region (view, x, y, width, row->height); + } + else /* HBAR_CURSOR */ + { + x = WINDOW_TEXT_TO_FRAME_PIXEL_X (w, w->phys_cursor.x); + y = WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y + + row->height - width); + + 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; + + BView_FillRectangle (view, x, y, w->phys_cursor_width - 1, + width); + BView_invalidate_region (view, x, y, w->phys_cursor_width - 1, + width); + } + + BView_EndClip (view); + BView_draw_unlock (view); + } +} + +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) +{ + 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: + haiku_draw_hollow_cursor (w, glyph_row); + break; + + case FILLED_BOX_CURSOR: + draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); + break; + + case BAR_CURSOR: + haiku_draw_bar_cursor (w, glyph_row, cursor_width, BAR_CURSOR); + break; + + case HBAR_CURSOR: + haiku_draw_bar_cursor (w, glyph_row, cursor_width, HBAR_CURSOR); + break; + + case NO_CURSOR: + w->phys_cursor_width = 0; + break; + + default: + emacs_abort (); + } + } + } +} + +static void +haiku_show_hourglass (struct frame *f) +{ + if (FRAME_TOOLTIP_P (f) + || 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_TOOLTIP_P (f) + || !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, size; + + unit = FRAME_COLUMN_WIDTH (f); + size = BScrollBar_default_size (0) + 1; + + FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = size; + FRAME_CONFIG_SCROLL_BAR_COLS (f) = (size + unit - 1) / unit; +} + +static void +haiku_set_scroll_bar_default_height (struct frame *f) +{ + int height, size; + + height = FRAME_LINE_HEIGHT (f); + size = BScrollBar_default_size (true) + 1; + + FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = size; + FRAME_CONFIG_SCROLL_BAR_LINES (f) = (size + 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; + Lisp_Object barobj; + struct scroll_bar *bar; + void *scroll_bar; + void *view; + + f = XFRAME (WINDOW_FRAME (w)); + view = FRAME_HAIKU_VIEW (f); + + block_input (); + 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; + + scroll_bar = be_make_scroll_bar_for_view (view, horizontal_p, + left, top, left + width - 1, + top + height - 1); + BView_publish_scroll_bar (view, left, top, width, height); + + bar->next = FRAME_SCROLL_BARS (f); + bar->prev = Qnil; + bar->scroll_bar = scroll_bar; + 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) +{ + Lisp_Object barobj; + struct scroll_bar *bar; + int top, height, left, width; + int window_x, window_width; + void *view; + + eassert (WINDOW_HAS_HORIZONTAL_SCROLL_BAR (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_CONFIG_SCROLL_BAR_HEIGHT (w); + view = FRAME_HAIKU_VIEW (WINDOW_XFRAME (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) + { + 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) +{ + Lisp_Object barobj; + struct scroll_bar *bar; + int top, height, left, width; + int window_y, window_height; + void *view; + + eassert (WINDOW_HAS_VERTICAL_SCROLL_BAR (w)); + + /* 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); + + view = FRAME_HAIKU_VIEW (WINDOW_XFRAME (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) + { + 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) +{ + struct face *face; + struct frame *f; + struct haiku_bitmap_record *rec; + void *view, *bitmap; + uint32 col; + + f = XFRAME (WINDOW_FRAME (w)); + view = FRAME_HAIKU_VIEW (f); + face = p->face; + + block_input (); + BView_draw_lock (view, true, 0, 0, 0, 0); + BView_StartClip (view); + + if (p->wd && p->h) + BView_invalidate_region (view, p->x, p->y, p->wd, p->h); + + haiku_clip_to_row (w, row, ANY_AREA); + + if (p->bx >= 0 && !p->overlay_p) + { + BView_invalidate_region (view, p->bx, p->by, p->nx, p->ny); + + if (!face->stipple) + { + BView_SetHighColor (view, face->background); + BView_FillRectangle (view, p->bx, p->by, p->nx, p->ny); + } + else + { + rec = haiku_get_bitmap_rec (f, face->stipple); + haiku_update_bitmap_rec (rec, face->foreground, + face->background); + + BView_StartClip (view); + haiku_clip_to_row (w, row, ANY_AREA); + BView_ClipToRect (view, p->bx, p->by, p->nx, p->ny); + BView_DrawBitmapTiled (view, rec->img, 0, 0, -1, -1, + 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)); + BView_EndClip (view); + + row->stipple_p = true; + } + } + + if (p->which + && p->which < max_fringe_bmp + && p->which < max_used_fringe_bitmap) + { + 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]; + } + + 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_nowhere; + + /* 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 (FRAME_TOOLTIP_P (f)) + 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_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 (BASE_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, /* update_window_begin */ + NULL, /* 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, + NULL, /* 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; + struct haiku_output *output; + + output = FRAME_OUTPUT_DATA (f); + + if (output->fullscreen_mode == FULLSCREEN_MODE_BOTH) + lval = Qfullboth; + else if (output->fullscreen_mode == FULLSCREEN_MODE_WIDTH) + lval = Qfullwidth; + else if (output->fullscreen_mode == FULLSCREEN_MODE_HEIGHT) + lval = Qfullheight; + else if (output->fullscreen_mode == FULLSCREEN_MODE_MAXIMIZED) + lval = Qmaximized; + else + lval = Qnil; + + store_frame_param (f, Qfullscreen, lval); +} + +static void +haiku_flush_dirty_back_buffer_on (struct frame *f) +{ + if (!FRAME_GARBAGED_P (f) + && !buffer_flipping_blocked_p () + && FRAME_DIRTY_P (f)) + haiku_flip_buffers (f); +} + +/* N.B. that support for TYPE must be explicitly added to + haiku_read_socket. */ +void +haiku_wait_for_event (struct frame *f, int type) +{ + int input_blocked_to; + object_wait_info info; + specpdl_ref depth; + + input_blocked_to = interrupt_input_blocked; + info.object = port_application_to_emacs; + info.type = B_OBJECT_TYPE_PORT; + info.events = B_EVENT_READ; + + depth = SPECPDL_INDEX (); + specbind (Qinhibit_quit, Qt); + + FRAME_OUTPUT_DATA (f)->wait_for_event_type = type; + + while (FRAME_OUTPUT_DATA (f)->wait_for_event_type == type) + { + if (wait_for_objects (&info, 1) < B_OK) + continue; + + pending_signals = true; + /* This will call the read_socket_hook. */ + totally_unblock_input (); + interrupt_input_blocked = input_blocked_to; + info.events = B_EVENT_READ; + } + + unbind_to (depth, Qnil); +} + +static int +haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) +{ + int message_count; + void *buf; + ssize_t b_size; + int button_or_motion_p, do_help; + enum haiku_event_type type; + struct input_event inev, inev2; + + message_count = 0; + button_or_motion_p = 0; + do_help = 0; + + buf = alloca (200); + + block_input (); + 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->width); + int height = lrint (b->height); + + if (FRAME_OUTPUT_DATA (f)->wait_for_event_type + == FRAME_RESIZED) + FRAME_OUTPUT_DATA (f)->wait_for_event_type = -1; + + 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); + + /* Flush the frame and flip buffers here. It is + necessary for tooltips displayed inside menus, as + redisplay cannot happen. */ + haiku_flush (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; + haiku_flush_dirty_back_buffer_on (f); + } + + 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 (except when drag-and-drop is in + progress and we are trying to move the tooltip + along with the mouse pointer). FIXME: for some + reason we don't get leave notification events for + this. */ + + if (any_help_event_p + && !(be_drag_and_drop_in_progress () + && haiku_dnd_follow_tooltip) + && !((EQ (track_mouse, Qdrag_source) + || EQ (track_mouse, Qdropping)) + && gui_mouse_grabbed (x_display_list))) + 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); + haiku_flush_dirty_back_buffer_on (f); + } + + 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; + + haiku_flush_dirty_back_buffer_on (f); + } + + 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 + && !((EQ (track_mouse, Qdrag_source) + || EQ (track_mouse, Qdropping)) + && gui_mouse_grabbed (x_display_list))) + 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 crossing event might be sent out-of-order with + regard 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. + + Work around the problem 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; + 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. */ + + if (any_help_event_p || do_help) + 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)) + haiku_flush_dirty_back_buffer_on (f); + 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; + struct scroll_bar *bar; + + if (popup_activated_p || !f) + continue; + + inev.modifiers = haiku_modifiers_to_emacs (b->modifiers); + bar = haiku_scroll_bar_from_widget (b->scroll_bar, b->window); + + 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); + haiku_flush_dirty_back_buffer_on (f); + } + } + + 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); + haiku_flush_dirty_back_buffer_on (f); + } + } + + if (type == BUTTON_UP) + { + inev.modifiers |= up_modifier; + up_okay_p = (x_display_list->grabbed & (1 << b->btn_no)); + x_display_list->grabbed &= ~(1 << b->btn_no); + } + else + { + up_okay_p = true; + inev.modifiers |= down_modifier; + x_display_list->last_mouse_frame = f; + x_display_list->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 (bar) + { + inev.kind = (bar->horizontal + ? HORIZONTAL_SCROLL_BAR_CLICK_EVENT + : SCROLL_BAR_CLICK_EVENT); + inev.part = (bar->horizontal + ? scroll_bar_horizontal_handle + : scroll_bar_handle); + } + else 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; + + if (bar) + { + if (bar->horizontal) + { + XSETINT (inev.x, min (max (0, b->x - bar->left), + bar->width)); + XSETINT (inev.y, bar->width); + } + else + { + XSETINT (inev.x, min (max (0, b->y - bar->top), + bar->height)); + XSETINT (inev.y, bar->height); + } + + inev.frame_or_window = bar->window; + } + else + { + 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); + int top, left; + struct frame *p; + + if (!f) + continue; + + FRAME_OUTPUT_DATA (f)->frame_x = b->x; + FRAME_OUTPUT_DATA (f)->frame_y = b->y; + + if (FRAME_PARENT_FRAME (f)) + haiku_coords_from_parent (f, &b->x, &b->y); + + left = b->x - b->decorator_width; + top = b->y - b->decorator_height; + + if (left != f->left_pos || top != f->top_pos) + { + inev.kind = MOVE_FRAME_EVENT; + + XSETINT (inev.x, left); + XSETINT (inev.y, top); + + f->left_pos = left; + f->top_pos = top; + + p = FRAME_PARENT_FRAME (f); + + if (p) + EmacsWindow_move_weak_child (FRAME_HAIKU_WINDOW (p), + b->window, left, top); + + 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; + + if (FRAME_OUTPUT_DATA (f)->wait_for_event_type + == MENU_BAR_RESIZE) + FRAME_OUTPUT_DATA (f)->wait_for_event_type = -1; + + int old_height = FRAME_MENU_BAR_HEIGHT (f); + + FRAME_MENU_BAR_HEIGHT (f) = b->height; + 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_CLICK: + { + struct haiku_menu_bar_click_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)->saved_menu_event) + FRAME_OUTPUT_DATA (f)->saved_menu_event = xmalloc (sizeof *b); + *FRAME_OUTPUT_DATA (f)->saved_menu_event = *b; + inev.kind = MENU_BAR_ACTIVATE_EVENT; + XSETFRAME (inev.frame_or_window, 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); + + if (!f || !FRAME_EXTERNAL_MENU_BAR (f)) + continue; + + if (type == MENU_BAR_OPEN) + { + FRAME_OUTPUT_DATA (f)->menu_bar_open_p = 1; + popup_activated_p += 1; + } + 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; + + find_and_call_menu_selection (f, f->menu_bar_items_used, + f->menu_bar_vector, b->ptr); + 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; + + if (b->fullscreen_mode == FULLSCREEN_MODE_MAXIMIZED) + f->want_fullscreen = FULLSCREEN_NONE; + else + f->want_fullscreen = FULLSCREEN_MAXIMIZED; + + FRAME_TERMINAL (f)->fullscreen_hook (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 SCREEN_CHANGED_EVENT: + { + struct haiku_screen_changed_event *b = buf; + + inev.kind = MONITORS_CHANGED_EVENT; + XSETTERMINAL (inev.arg, x_display_list->terminal); + inev.timestamp = b->when / 1000; + break; + } + case CLIPBOARD_CHANGED_EVENT: + be_handle_clipboard_changed_message (); + break; + case APP_QUIT_REQUESTED_EVENT: + inev.kind = SAVE_SESSION_EVENT; + inev.arg = Qt; + break; + 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; + } + } + + 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); + } + } + + unblock_input (); + + return message_count; +} + +static Lisp_Object +haiku_get_focus_frame (struct frame *f) +{ + Lisp_Object lisp_focus; + struct frame *focus; + + focus = FRAME_DISPLAY_INFO (f)->focused_frame; + + if (!focus) + return Qnil; + + XSETFRAME (lisp_focus, focus); + return lisp_focus; +} + +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 && !FRAME_TOOLTIP_P (f)) + { + 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) +{ + enum haiku_fullscreen_mode mode; + + /* 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) + mode = FULLSCREEN_MODE_MAXIMIZED; + else if (f->want_fullscreen == FULLSCREEN_BOTH) + mode = FULLSCREEN_MODE_BOTH; + else if (f->want_fullscreen == FULLSCREEN_WIDTH) + mode = FULLSCREEN_MODE_WIDTH; + else if (f->want_fullscreen == FULLSCREEN_HEIGHT) + mode = FULLSCREEN_MODE_HEIGHT; + else + mode = FULLSCREEN_MODE_NONE; + + f->want_fullscreen = FULLSCREEN_NONE; + be_set_window_fullscreen_mode (FRAME_HAIKU_WINDOW (f), mode); + FRAME_OUTPUT_DATA (f)->fullscreen_mode = mode; + + haiku_update_size_hints (f); + haiku_make_fullscreen_consistent (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 = haiku_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; + terminal->activate_menubar_hook = haiku_activate_menubar; + terminal->get_focus_frame = haiku_get_focus_frame; + + return terminal; +} + +struct haiku_display_info * +haiku_term_init (void) +{ + struct haiku_display_info *dpyinfo; + struct terminal *terminal; + Lisp_Object color_file, color_map, system_name; + ptrdiff_t nbytes; + void *name_buffer; + + block_input (); + + Fset_input_interrupt_mode (Qt); + baud_rate = 19200; + dpyinfo = xzalloc (sizeof *dpyinfo); + haiku_io_init (); + + if (port_application_to_emacs < B_OK + || port_emacs_to_session_manager < 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 (); + dpyinfo->next = x_display_list; + dpyinfo->n_planes = be_get_display_planes (); + be_get_display_resolution (&dpyinfo->resx, &dpyinfo->resy); + + 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, cursor_id) \ + (dpyinfo->cursor = be_create_cursor_from_id (cursor_id)) + ASSIGN_CURSOR (text_cursor, CURSOR_ID_I_BEAM); + ASSIGN_CURSOR (nontext_cursor, CURSOR_ID_SYSTEM_DEFAULT); + ASSIGN_CURSOR (modeline_cursor, CURSOR_ID_CONTEXT_MENU); + ASSIGN_CURSOR (hand_cursor, CURSOR_ID_GRAB); + ASSIGN_CURSOR (hourglass_cursor, CURSOR_ID_PROGRESS); + ASSIGN_CURSOR (horizontal_drag_cursor, CURSOR_ID_RESIZE_EAST_WEST); + ASSIGN_CURSOR (vertical_drag_cursor, CURSOR_ID_RESIZE_NORTH_SOUTH); + ASSIGN_CURSOR (left_edge_cursor, CURSOR_ID_RESIZE_WEST); + ASSIGN_CURSOR (top_left_corner_cursor, CURSOR_ID_RESIZE_NORTH_WEST); + ASSIGN_CURSOR (top_edge_cursor, CURSOR_ID_RESIZE_NORTH); + ASSIGN_CURSOR (top_right_corner_cursor, CURSOR_ID_RESIZE_NORTH_EAST); + ASSIGN_CURSOR (right_edge_cursor, CURSOR_ID_RESIZE_EAST); + ASSIGN_CURSOR (bottom_right_corner_cursor, CURSOR_ID_RESIZE_SOUTH_EAST); + ASSIGN_CURSOR (bottom_edge_cursor, CURSOR_ID_RESIZE_SOUTH); + ASSIGN_CURSOR (bottom_left_corner_cursor, CURSOR_ID_RESIZE_SOUTH_WEST); + ASSIGN_CURSOR (no_cursor, CURSOR_ID_NO_CURSOR); +#undef ASSIGN_CURSOR + + system_name = Fsystem_name (); + + if (STRINGP (system_name)) + { + nbytes = sizeof "GNU Emacs" + sizeof " at "; + + if (INT_ADD_WRAPV (nbytes, SBYTES (system_name), &nbytes)) + memory_full (SIZE_MAX); + + name_buffer = alloca (nbytes); + sprintf (name_buffer, "%s%s%s", "GNU Emacs", + " at ", SDATA (system_name)); + dpyinfo->default_name = build_string (name_buffer); + } + else + dpyinfo->default_name = build_string ("GNU Emacs"); + + haiku_start_watching_selections (); + 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); + mark_object (x_display_list->default_name); + } +} + +void +haiku_scroll_bar_remove (struct scroll_bar *bar) +{ + void *view; + struct frame *f; + + f = WINDOW_XFRAME (XWINDOW (bar->window)); + view = FRAME_HAIKU_VIEW (f); + + block_input (); + 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) +{ + Lisp_Object lframe; + + /* Don't allow moving a fullscreen frame: the semantics of that are + unclear. */ + + XSETFRAME (lframe, frame); + if (EQ (Fframe_parameter (lframe, Qfullscreen), Qfullboth) + /* Only do this if the fullscreen status has actually been + applied. */ + && frame->want_fullscreen == FULLSCREEN_NONE + /* And if the configury during frame creation has been + completed. Otherwise, there will be no valid "old position" + to go back to. */ + && FRAME_OUTPUT_DATA (frame)->configury_done) + return; + + 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..46a2218e492 --- /dev/null +++ b/src/haikuterm.h @@ -0,0 +1,362 @@ +/* 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; + + uint32_t stipple_foreground; + uint32_t stipple_background; + void *stipple_bits; +}; + +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; + Lisp_Object default_name; + + 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; + + 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 fontset; + int baseline_offset; + + /* Whether or not the hourglass cursor is currently being + displayed. */ + bool_bf hourglass_p : 1; + + /* Whether or not the menu bar is open. */ + bool_bf menu_bar_open_p : 1; + + /* Whether or not there is data in a back buffer that hasn't been + displayed yet. */ + bool_bf dirty_p : 1; + + 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; + + /* If non-NULL, the last menu bar click event received. */ + struct haiku_menu_bar_click_event *saved_menu_event; + + /* The type of any event that's being waited for. */ + int wait_for_event_type; + + /* The "dark" color of the current relief. */ + uint32_t black_relief_pixel; + + /* The "light" color of the current relief. */ + uint32_t white_relief_pixel; + + /* The background for which the relief colors above were computed. + They are changed only when a different background is involved. + -1 means no color has been computed. */ + long relief_background; + + /* The absolute position of this frame. This differs from left_pos + and top_pos in that the decorator and parent frames are not taken + into account. */ + int frame_x, frame_y; + + /* The current fullscreen mode of this frame. This should be `enum + haiku_fullscreen_mode', but that isn't available here. */ + int fullscreen_mode; +}; + +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 Lisp_Object tip_dx; +extern Lisp_Object tip_dy; + +extern struct frame *haiku_dnd_frame; +extern bool haiku_dnd_follow_tooltip; + +extern frame_parm_handler haiku_frame_parm_handlers[]; + +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_free_custom_cursors (struct frame *); + +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_activate_menubar (struct frame *); +extern void haiku_wait_for_event (struct frame *, int); +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 + +extern void haiku_draw_background_rect (struct glyph_string *, struct face *, + int, int, int, int); + +#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 *); +extern void haiku_handle_selection_clear (struct input_event *); +extern void haiku_start_watching_selections (void); +#endif /* _HAIKU_TERM_H_ */ diff --git a/src/image.c b/src/image.c index c2e76d5bfcd..c0a7b85cb3b 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,72 @@ 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, *stipple; + int bytes_per_line, x, y; + + bitmap = BBitmap_new (width, height, false); + + if (!bitmap) + return -1; + + bytes_per_line = (width + 7) / 8; + stipple = xmalloc (height * bytes_per_line); + memcpy (stipple, bits, height * bytes_per_line); + + for (y = 0; y < height; y++) + { + for (x = 0; x < width; x++) + PUT_PIXEL (bitmap, x, y, ((bits[8] >> (x % 8)) & 1 + ? f->foreground_pixel + : f->background_pixel)); + bits += bytes_per_line; + } +#endif + id = image_allocate_bitmap_record (f); #ifdef HAVE_NS @@ -437,6 +571,23 @@ 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; + dpyinfo->bitmaps[id - 1].stipple_bits = stipple; + dpyinfo->bitmaps[id - 1].stipple_foreground + = f->foreground_pixel & 0xffffffff; + dpyinfo->bitmaps[id - 1].stipple_background + = f->background_pixel & 0xffffffff; +#endif + dpyinfo->bitmaps[id - 1].file = NULL; dpyinfo->bitmaps[id - 1].height = height; dpyinfo->bitmaps[id - 1].width = width; @@ -460,24 +611,55 @@ image_create_bitmap_from_data (struct frame *f, char *bits, return id; } +#if defined HAVE_HAIKU || defined HAVE_NS +static char *slurp_file (int, ptrdiff_t *); +static Lisp_Object image_find_image_fd (Lisp_Object, int *); +static bool xbm_read_bitmap_data (struct frame *, char *, char *, + int *, int *, char **, bool); +#endif + /* Create bitmap from file FILE for frame F. */ ptrdiff_t image_create_bitmap_from_file (struct frame *f, Lisp_Object file) { -#ifdef HAVE_NTGUI +#if defined (HAVE_NTGUI) return -1; /* W32_TODO : bitmap support */ #else Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f); #endif #ifdef HAVE_NS - ptrdiff_t id; - void *bitmap = ns_image_from_file (file); + ptrdiff_t id, size; + int fd, width, height, rc; + char *contents, *data; + void *bitmap; - if (!bitmap) + if (!STRINGP (image_find_image_fd (file, &fd))) + return -1; + + contents = slurp_file (fd, &size); + + if (!contents) + return -1; + + rc = xbm_read_bitmap_data (f, contents, contents + size, + &width, &height, &data, 0); + + if (!rc) + { + xfree (contents); return -1; + } + + bitmap = ns_image_from_XBM (data, width, height, 0, 0); + if (!bitmap) + { + xfree (contents); + xfree (data); + return -1; + } id = image_allocate_bitmap_record (f); dpyinfo->bitmaps[id - 1].img = bitmap; @@ -486,6 +668,32 @@ image_create_bitmap_from_file (struct frame *f, Lisp_Object file) dpyinfo->bitmaps[id - 1].depth = 1; dpyinfo->bitmaps[id - 1].height = ns_image_width (bitmap); dpyinfo->bitmaps[id - 1].width = ns_image_height (bitmap); + + xfree (contents); + xfree (data); + 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].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 @@ -536,6 +744,89 @@ image_create_bitmap_from_file (struct frame *f, Lisp_Object file) return id; #endif /* HAVE_X_WINDOWS */ + +#ifdef HAVE_HAIKU + ptrdiff_t id, size; + int fd, width, height, rc, bytes_per_line, x, y; + char *contents, *data, *tmp; + void *bitmap; + Lisp_Object found; + + /* Look for an existing bitmap with the same name. */ + for (id = 0; id < dpyinfo->bitmaps_last; ++id) + { + if (dpyinfo->bitmaps[id].refcount + && dpyinfo->bitmaps[id].file + && !strcmp (dpyinfo->bitmaps[id].file, SSDATA (file))) + { + ++dpyinfo->bitmaps[id].refcount; + return id + 1; + } + } + + /* Search bitmap-file-path for the file, if appropriate. */ + if (openp (Vx_bitmap_file_path, file, Qnil, &found, + make_fixnum (R_OK), false, false) + < 0) + return -1; + + if (!STRINGP (image_find_image_fd (file, &fd)) + && !STRINGP (image_find_image_fd (found, &fd))) + return -1; + + contents = slurp_file (fd, &size); + + if (!contents) + return -1; + + rc = xbm_read_bitmap_data (f, contents, contents + size, + &width, &height, &data, 0); + + if (!rc) + { + xfree (contents); + return -1; + } + + bitmap = BBitmap_new (width, height, false); + + if (!bitmap) + { + xfree (contents); + xfree (data); + return -1; + } + + id = image_allocate_bitmap_record (f); + + dpyinfo->bitmaps[id - 1].img = bitmap; + dpyinfo->bitmaps[id - 1].depth = 1; + dpyinfo->bitmaps[id - 1].file = xlispstrdup (file); + dpyinfo->bitmaps[id - 1].height = height; + dpyinfo->bitmaps[id - 1].width = width; + dpyinfo->bitmaps[id - 1].refcount = 1; + dpyinfo->bitmaps[id - 1].stipple_foreground + = f->foreground_pixel & 0xffffffff; + dpyinfo->bitmaps[id - 1].stipple_background + = f->background_pixel & 0xffffffff; + dpyinfo->bitmaps[id - 1].stipple_bits = data; + + bytes_per_line = (width + 7) / 8; + tmp = data; + + for (y = 0; y < height; y++) + { + for (x = 0; x < width; x++) + PUT_PIXEL (bitmap, x, y, ((tmp[x / 8] >> (x % 8)) & 1 + ? f->foreground_pixel + : f->background_pixel)); + + tmp += bytes_per_line; + } + + xfree (contents); + return id; +#endif } /* Free bitmap B. */ @@ -561,6 +852,18 @@ 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); + + if (bm->stipple_bits) + xfree (bm->stipple_bits); +#endif + if (bm->file) { xfree (bm->file); @@ -1016,7 +1319,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 +1624,6 @@ image_ascent (struct image *img, struct face *face, struct glyph_slice *slice) return ascent; } - /* Image background colors. */ @@ -1345,6 +1647,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 +1934,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 +2174,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; @@ -1964,8 +2309,8 @@ postprocess_image (struct frame *f, struct image *img) tem = XCDR (conversion); if (CONSP (tem)) image_edge_detection (f, img, - Fplist_get (tem, QCmatrix), - Fplist_get (tem, QCcolor_adjustment)); + plist_get (tem, QCmatrix), + plist_get (tem, QCcolor_adjustment)); } } } @@ -1975,14 +2320,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 +2350,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; @@ -2163,10 +2503,11 @@ compute_image_size (size_t width, size_t height, finally move the origin back to the top left of the image, which may now be a different corner. - Note that different GUI backends (X, Cairo, w32, NS) want the - transform matrix defined as transform from the original image to - the transformed image, while others want the matrix to describe the - transform of the space, which boils down to inverting the matrix. + Note that different GUI backends (X, Cairo, w32, NS, Haiku) want + the transform matrix defined as transform from the original image + to the transformed image, while others want the matrix to describe + the transform of the space, which boils down to inverting the + matrix. It's possible to pre-calculate the matrix multiplications and just generate one transform matrix that will do everything we need in a @@ -2211,7 +2552,24 @@ compute_image_rotation (struct image *img, double *rotation) static void image_set_transform (struct frame *f, struct image *img) { -# ifdef HAVE_IMAGEMAGICK + bool flip; + +#if defined HAVE_HAIKU + matrix3x3 identity = { + { 1, 0, 0 }, + { 0, 1, 0 }, + { 0, 0, 1 }, + }; + + img->original_width = img->width; + img->original_height = img->height; + img->use_bilinear_filtering = false; + + memcpy (&img->transform, identity, sizeof identity); +#endif + +# 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,7 +2602,10 @@ image_set_transform (struct frame *f, struct image *img) double rotation = 0.0; compute_image_rotation (img, &rotation); -# if defined USE_CAIRO || defined HAVE_XRENDER || defined HAVE_NS + /* Determine flipping. */ + flip = !NILP (image_spec_value (img->spec, QCflip, NULL)); + +# if defined USE_CAIRO || defined HAVE_XRENDER || defined HAVE_NS || defined HAVE_HAIKU /* We want scale up operations to use a nearest neighbor filter to show real pixels instead of munging them, but scale down operations to use a blended filter, to avoid aliasing and the like. @@ -2258,6 +2619,10 @@ image_set_transform (struct frame *f, struct image *img) smoothing = !NILP (s); # endif +#ifdef HAVE_HAIKU + img->use_bilinear_filtering = smoothing; +#endif + /* Perform scale transformation. */ matrix3x3 matrix @@ -2267,7 +2632,7 @@ image_set_transform (struct frame *f, struct image *img) : img->width / (double) width), [1][1] = (!IEEE_FLOATING_POINT && height == 0 ? DBL_MAX : img->height / (double) height), -# elif defined HAVE_NTGUI || defined HAVE_NS +# elif defined HAVE_NTGUI || defined HAVE_NS || defined HAVE_HAIKU [0][0] = (!IEEE_FLOATING_POINT && img->width == 0 ? DBL_MAX : width / (double) img->width), [1][1] = (!IEEE_FLOATING_POINT && img->height == 0 ? DBL_MAX @@ -2282,26 +2647,65 @@ image_set_transform (struct frame *f, struct image *img) /* Perform rotation transformation. */ int rotate_flag = -1; - if (rotation == 0) + + /* Haiku needs this, since the transformation is done on the basis + of the view, and not the image. */ +#ifdef HAVE_HAIKU + int extra_tx, extra_ty; + + extra_tx = 0; + extra_ty = 0; +#endif + + if (rotation == 0 && !flip) rotate_flag = 0; else { # if (defined USE_CAIRO || defined HAVE_XRENDER \ - || defined HAVE_NTGUI || defined HAVE_NS) + || defined HAVE_NTGUI || defined HAVE_NS \ + || defined HAVE_HAIKU) int cos_r, sin_r; - if (rotation == 90) + if (rotation == 0) + { + /* FLIP is always true here. As this will rotate by 0 + degrees, it has no visible effect. Applying only + translation matrix to the image would be sufficient for + horizontal flipping, but writing special handling for + this case would increase code complexity somewhat. */ + cos_r = 1; + sin_r = 0; + rotate_flag = 1; + +#ifdef HAVE_HAIKU + extra_tx = width; + extra_ty = 0; +#endif + } + else if (rotation == 90) { width = img->height; height = img->width; cos_r = 0; sin_r = 1; rotate_flag = 1; + +#ifdef HAVE_HAIKU + if (!flip) + extra_ty = height; + extra_tx = 0; +#endif } else if (rotation == 180) { cos_r = -1; sin_r = 0; rotate_flag = 1; + +#ifdef HAVE_HAIKU + if (!flip) + extra_tx = width; + extra_ty = height; +#endif } else if (rotation == 270) { @@ -2310,6 +2714,13 @@ image_set_transform (struct frame *f, struct image *img) cos_r = 0; sin_r = -1; rotate_flag = 1; + +#ifdef HAVE_HAIKU + extra_tx = width; + + if (flip) + extra_ty = height; +#endif } if (0 < rotate_flag) @@ -2330,9 +2741,14 @@ image_set_transform (struct frame *f, struct image *img) matrix3x3 v; matrix3x3_mult (rot, u, v); - /* 3. Translate back. */ + /* 3. Translate back. Flip horizontally if requested. */ t[2][0] = width * -.5; t[2][1] = height * -.5; + if (flip) + { + t[0][0] = -t[0][0]; + t[2][0] = -t[2][0]; + } matrix3x3_mult (t, v, matrix); # else /* 1. Translate so (0, 0) is in the center of the image. */ @@ -2350,9 +2766,10 @@ image_set_transform (struct frame *f, struct image *img) matrix3x3 v; matrix3x3_mult (u, rot, v); - /* 3. Translate back. */ + /* 3. Translate back. Flip horizontally if requested. */ t[2][0] = width * .5; t[2][1] = height * .5; + if (flip) t[0][0] = -t[0][0]; matrix3x3_mult (v, t, matrix); # endif img->width = width; @@ -2413,7 +2830,17 @@ image_set_transform (struct frame *f, struct image *img) img->xform.eM22 = matrix[1][1]; img->xform.eDx = matrix[2][0]; img->xform.eDy = matrix[2][1]; -# endif +# elif defined HAVE_HAIKU + /* Store the transform in the struct image for later. */ + memcpy (&img->transform, &matrix, sizeof matrix); + + /* Also add the extra translations. */ + if (rotate_flag) + { + img->transform[0][2] = extra_tx; + img->transform[1][2] = extra_ty; + } +#endif } #endif /* HAVE_IMAGEMAGICK || HAVE_NATIVE_TRANSFORMS */ @@ -2435,8 +2862,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 +2873,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 +3012,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 +3124,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 +3173,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 +3230,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 +3336,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 +3500,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 +3512,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 +3619,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 +3726,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 @@ -3246,6 +3778,8 @@ enum xbm_keyword_index XBM_ALGORITHM, XBM_HEURISTIC_MASK, XBM_MASK, + XBM_DATA_WIDTH, + XBM_DATA_HEIGHT, XBM_LAST }; @@ -3267,7 +3801,9 @@ static const struct image_keyword xbm_format[XBM_LAST] = {":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} + {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}, + {":data-width", IMAGE_POSITIVE_INTEGER_VALUE, 0}, + {":data-height", IMAGE_POSITIVE_INTEGER_VALUE, 0} }; /* Tokens returned from xbm_scan. */ @@ -3289,8 +3825,8 @@ enum xbm_token an entry `:file FILENAME' where FILENAME is a string. If the specification is for a bitmap loaded from memory it must - contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where - WIDTH and HEIGHT are integers > 0. DATA may be: + contain `:data-width WIDTH', `:data-height HEIGHT', and `:data DATA', + where WIDTH and HEIGHT are integers > 0. DATA may be: 1. a string large enough to hold the bitmap data, i.e. it must have a size >= (WIDTH + 7) / 8 * HEIGHT @@ -3300,9 +3836,7 @@ enum xbm_token 3. a vector of strings or bool-vectors, one for each line of the bitmap. - 4. a string containing an in-memory XBM file. WIDTH and HEIGHT - may not be specified in this case because they are defined in the - XBM file. + 4. a string containing an in-memory XBM file. Both the file and data forms may contain the additional entries `:background COLOR' and `:foreground COLOR'. If not present, @@ -3322,13 +3856,13 @@ xbm_image_p (Lisp_Object object) if (kw[XBM_FILE].count) { - if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_DATA].count) + if (kw[XBM_DATA].count) return 0; } else if (kw[XBM_DATA].count && xbm_file_p (kw[XBM_DATA].value)) { /* In-memory XBM file. */ - if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_FILE].count) + if (kw[XBM_FILE].count) return 0; } else @@ -3337,14 +3871,14 @@ xbm_image_p (Lisp_Object object) int width, height, stride; /* Entries for `:width', `:height' and `:data' must be present. */ - if (!kw[XBM_WIDTH].count - || !kw[XBM_HEIGHT].count + if (!kw[XBM_DATA_WIDTH].count + || !kw[XBM_DATA_HEIGHT].count || !kw[XBM_DATA].count) return 0; data = kw[XBM_DATA].value; - width = XFIXNAT (kw[XBM_WIDTH].value); - height = XFIXNAT (kw[XBM_HEIGHT].value); + width = XFIXNAT (kw[XBM_DATA_WIDTH].value); + height = XFIXNAT (kw[XBM_DATA_HEIGHT].value); if (!kw[XBM_STRIDE].count) stride = width; @@ -3470,6 +4004,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 +4123,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 +4169,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 +4184,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 +4383,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; @@ -3912,8 +4502,8 @@ xbm_load (struct frame *f, struct image *img) /* Get specified width, and height. */ if (!in_memory_file_p) { - img->width = XFIXNAT (fmt[XBM_WIDTH].value); - img->height = XFIXNAT (fmt[XBM_HEIGHT].value); + img->width = XFIXNAT (fmt[XBM_DATA_WIDTH].value); + img->height = XFIXNAT (fmt[XBM_DATA_HEIGHT].value); eassert (img->width > 0 && img->height > 0); if (!check_image_size (f, img->width, img->height)) { @@ -4015,6 +4605,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 +4635,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 +4655,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 +4673,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 +4713,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 +4897,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 +4933,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 +5016,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 +5306,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 +5507,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 +6047,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 +6120,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 +6128,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); @@ -5763,7 +6364,7 @@ image_edge_detection (struct frame *f, struct image *img, } -#if defined HAVE_X_WINDOWS || defined USE_CAIRO +#if defined HAVE_X_WINDOWS || defined USE_CAIRO || defined HAVE_HAIKU static void image_pixmap_draw_cross (struct frame *f, Emacs_Pixmap pixmap, int x, int y, unsigned int width, unsigned int height, @@ -5797,9 +6398,11 @@ image_pixmap_draw_cross (struct frame *f, Emacs_Pixmap pixmap, XDrawLine (dpy, pixmap, gc, x, y, x + width - 1, y + height - 1); XDrawLine (dpy, pixmap, gc, x, y + height - 1, x + width - 1, y); XFreeGC (dpy, gc); -#endif /* HAVE_X_WINDOWS */ +#elif HAVE_HAIKU + be_draw_cross_on_pixmap (pixmap, x, y, width, height, color); +#endif } -#endif /* HAVE_X_WINDOWS || USE_CAIRO */ +#endif /* HAVE_X_WINDOWS || USE_CAIRO || HAVE_HAIKU */ /* Transform image IMG on frame F so that it looks disabled. */ @@ -5842,17 +6445,17 @@ 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 USE_CAIRO +#if !defined USE_CAIRO && !defined HAVE_HAIKU #define CrossForeground(f) BLACK_PIX_DEFAULT (f) #define MaskForeground(f) WHITE_PIX_DEFAULT (f) -#else /* USE_CAIRO */ +#else /* USE_CAIRO || HAVE_HAIKU */ #define CrossForeground(f) 0 #define MaskForeground(f) PIX_MASK_DRAW -#endif /* USE_CAIRO */ +#endif /* USE_CAIRO || HAVE_HAIKU */ -#ifndef USE_CAIRO +#if !defined USE_CAIRO && !defined HAVE_HAIKU image_sync_to_pixmaps (f, img); -#endif /* !USE_CAIRO */ +#endif /* !USE_CAIRO && !HAVE_HAIKU */ image_pixmap_draw_cross (f, img->pixmap, 0, 0, img->width, img->height, CrossForeground (f)); if (img->mask) @@ -6415,15 +7018,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 +7093,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 +8840,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 +8886,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 +8905,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 +8918,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 +8988,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 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 - if (!gif) + 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 initialize 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 +9184,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 +9215,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 +9248,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 +9286,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 +9355,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 +9369,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 +9412,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 +9424,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 +9450,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 +10050,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 +10272,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 +10397,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 +10447,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 +10466,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 +10504,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 +10598,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 +10835,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 +10846,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 +10902,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 +10948,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 +10986,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 +11227,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) - { - 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) + if (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 +11511,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 +11653,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 +11726,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 +11757,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 +11825,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 +11913,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 }, }; @@ -10801,6 +11995,7 @@ non-numeric, there is no explicit limit on the size of images. */); DEFSYM (QCtransform_smoothing, ":transform-smoothing"); DEFSYM (QCcolor_adjustment, ":color-adjustment"); DEFSYM (QCmask, ":mask"); + DEFSYM (QCflip, ":flip"); /* Other symbols. */ DEFSYM (Qlaplace, "laplace"); @@ -10867,7 +12062,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 +12088,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 +12116,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 +12151,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 f5a2a078b98..d4ef075f001 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 = plist_get (plist, QCwidth), + RANGED_FIXNUMP (0, prop, INT_MAX)) + || (prop = plist_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 = plist_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 (plist_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; } @@ -1193,7 +1204,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, /* Negative width means use all available text columns. */ if (width < 0) { - width = window_body_width (win, 0); + width = window_body_width (win, WINDOW_BODY_IN_CANONICAL_CHARS); /* We must make room for continuation marks if we don't have fringes. */ #ifdef HAVE_WINDOW_SYSTEM if (!FRAME_WINDOW_P (XFRAME (win->frame))) @@ -1803,7 +1814,7 @@ visible section of the buffer, and pass LINE and COL as TOPOS. */) ? window_internal_height (w) : XFIXNUM (XCDR (topos))), (NILP (topos) - ? (window_body_width (w, 0) + ? (window_body_width (w, WINDOW_BODY_IN_CANONICAL_CHARS) - ( #ifdef HAVE_WINDOW_SYSTEM FRAME_WINDOW_P (XFRAME (w->frame)) ? 0 : @@ -1850,7 +1861,7 @@ vmotion (ptrdiff_t from, ptrdiff_t from_byte, /* If the window contains this buffer, use it for getting text properties. Otherwise use the current buffer as arg for doing that. */ - if (EQ (w->contents, Fcurrent_buffer ())) + if (BASE_EQ (w->contents, Fcurrent_buffer ())) text_prop_object = window; else text_prop_object = Fcurrent_buffer (); @@ -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)) @@ -2165,6 +2177,8 @@ whether or not it is currently displayed in some window. */) line_number_display_width (w, &lnum_width, &lnum_pixel_width); SET_TEXT_POS (pt, PT, PT_BYTE); itdata = bidi_shelve_cache (); + record_unwind_protect_void (unwind_display_working_on_window); + display_working_on_window_p = true; start_display (&it, w, pt); it.lnum_width = lnum_width; first_x = it.first_visible_x; diff --git a/src/inotify.c b/src/inotify.c index e92ad40abcc..16d20e7e925 100644 --- a/src/inotify.c +++ b/src/inotify.c @@ -217,7 +217,7 @@ add_watch (int wd, Lisp_Object filename, /* Assign a watch ID that is not already in use, by looking for a gap in the existing sorted list. */ for (; ! NILP (XCDR (tail)); tail = XCDR (tail), id++) - if (!EQ (XCAR (XCAR (XCDR (tail))), make_fixnum (id))) + if (!BASE_EQ (XCAR (XCAR (XCDR (tail))), make_fixnum (id))) break; if (MOST_POSITIVE_FIXNUM < id) emacs_abort (); 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..85152c58a5d 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -121,7 +121,6 @@ copy_properties (INTERVAL source, INTERVAL target) { if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target)) return; - eassume (source && target); COPY_INTERVAL_CACHE (source, target); set_interval_plist (target, Fcopy_sequence (source->plist)); @@ -166,10 +165,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 +204,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 +219,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. @@ -1728,11 +1737,11 @@ lookup_char_property (Lisp_Object plist, Lisp_Object prop, bool textprop) { tail = XCDR (tail); for (; NILP (fallback) && CONSP (tail); tail = XCDR (tail)) - fallback = Fplist_get (plist, XCAR (tail)); + fallback = plist_get (plist, XCAR (tail)); } if (textprop && NILP (fallback) && CONSP (Vdefault_text_properties)) - fallback = Fplist_get (Vdefault_text_properties, prop); + fallback = plist_get (Vdefault_text_properties, prop); return fallback; } @@ -2170,7 +2179,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 +2300,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/intervals.h b/src/intervals.h index 484fca2e756..0ce581208e3 100644 --- a/src/intervals.h +++ b/src/intervals.h @@ -251,7 +251,7 @@ extern void traverse_intervals_noorder (INTERVAL, void (*) (INTERVAL, void *), void *); extern INTERVAL split_interval_right (INTERVAL, ptrdiff_t) ATTRIBUTE_RETURNS_NONNULL; -extern INTERVAL split_interval_left (INTERVAL, ptrdiff_t); +extern INTERVAL split_interval_left (INTERVAL, ptrdiff_t) ATTRIBUTE_RETURNS_NONNULL; extern INTERVAL find_interval (INTERVAL, ptrdiff_t); extern INTERVAL next_interval (INTERVAL); extern INTERVAL previous_interval (INTERVAL); diff --git a/src/json.c b/src/json.c index 21a6df67857..9a455f507b4 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)) { @@ -364,7 +364,7 @@ lisp_to_json_nonscalar_1 (Lisp_Object lisp, for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i) { Lisp_Object key = HASH_KEY (h, i); - if (!EQ (key, Qunbound)) + if (!BASE_EQ (key, Qunbound)) { CHECK_STRING (key); Lisp_Object ekey = json_encode (key); @@ -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) @@ -975,7 +975,7 @@ usage: (json-parse-string STRING &rest ARGS) */) json_error_t error; json_t *object - = json_loads (SSDATA (encoded), JSON_DECODE_ANY, &error); + = json_loads (SSDATA (encoded), JSON_DECODE_ANY | JSON_ALLOW_NUL, &error); if (object == NULL) json_parse_error (&error); @@ -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) @@ -1071,7 +1071,9 @@ usage: (json-parse-buffer &rest args) */) json_error_t error; json_t *object = json_load_callback (json_read_buffer_callback, &data, - JSON_DECODE_ANY | JSON_DISABLE_EOF_CHECK, + JSON_DECODE_ANY + | JSON_DISABLE_EOF_CHECK + | JSON_ALLOW_NUL, &error); if (object == NULL) diff --git a/src/keyboard.c b/src/keyboard.c index 9865bc9add3..c729d5dfb3e 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> @@ -94,8 +95,6 @@ volatile int interrupt_input_blocked; The maybe_quit function checks this. */ volatile bool pending_signals; -enum { KBD_BUFFER_SIZE = 4096 }; - KBOARD *initial_kboard; KBOARD *current_kboard; static KBOARD *all_kboards; @@ -289,14 +288,14 @@ bool input_was_pending; /* Circular buffer for pre-read keyboard input. */ -static union buffered_input_event kbd_buffer[KBD_BUFFER_SIZE]; +union buffered_input_event kbd_buffer[KBD_BUFFER_SIZE]; /* Pointer to next available character in kbd_buffer. If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty. */ -static union buffered_input_event *kbd_fetch_ptr; +union buffered_input_event *kbd_fetch_ptr; /* Pointer to next place to store character in kbd_buffer. */ -static union buffered_input_event *kbd_store_ptr; +union buffered_input_event *kbd_store_ptr; /* The above pair of variables forms a "queue empty" flag. When we enqueue a non-hook event, we increment kbd_store_ptr. When we @@ -335,6 +334,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 +379,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. */ @@ -384,14 +389,6 @@ next_kbd_event (union buffered_input_event *ptr) return ptr == kbd_buffer + KBD_BUFFER_SIZE - 1 ? kbd_buffer : ptr + 1; } -#ifdef HAVE_X11 -static union buffered_input_event * -prev_kbd_event (union buffered_input_event *ptr) -{ - return ptr == kbd_buffer ? kbd_buffer + KBD_BUFFER_SIZE - 1 : ptr - 1; -} -#endif - /* Like EVENT_START, but assume EVENT is an event. This pacifies gcc -Wnull-dereference, which might otherwise complain about earlier checks that EVENT is indeed an event. */ @@ -680,13 +677,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 +771,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 +934,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)]; @@ -1050,7 +1049,7 @@ Default value of `command-error-function'. */) print_error_message (data, Qexternal_debugging_output, SSDATA (context), signal); Fterpri (Qexternal_debugging_output, Qnil); - Fkill_emacs (make_fixnum (-1)); + Fkill_emacs (make_fixnum (-1), Qnil); } else { @@ -1113,7 +1112,7 @@ command_loop (void) /* End of file in -batch run causes exit here. */ if (noninteractive) - Fkill_emacs (Qt); + Fkill_emacs (Qt, Qnil); } } @@ -1228,7 +1227,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); @@ -1306,9 +1305,6 @@ command_loop_1 (void) /* If there are warnings waiting, process them. */ if (!NILP (Vdelayed_warnings_list)) safe_run_hooks (Qdelayed_warnings_hook); - - if (!NILP (Vdeferred_action_list)) - safe_run_hooks (Qdeferred_action_function); } /* Do this after running Vpost_command_hook, for consistency. */ @@ -1322,7 +1318,7 @@ command_loop_1 (void) Lisp_Object cmd; if (! FRAME_LIVE_P (XFRAME (selected_frame))) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); /* Make sure the current window's buffer is selected. */ set_buffer_internal (XBUFFER (XWINDOW (selected_window)->contents)); @@ -1346,12 +1342,12 @@ command_loop_1 (void) if (minibuf_level && !NILP (echo_area_buffer[0]) - && EQ (minibuf_window, echo_area_window) + && BASE_EQ (minibuf_window, echo_area_window) && NUMBERP (Vminibuffer_message_timeout)) { /* 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); @@ -1375,12 +1371,6 @@ command_loop_1 (void) } } - /* If it has changed current-menubar from previous value, - really recompute the menubar from the value. */ - if (! NILP (Vlucid_menu_bar_dirty_flag) - && !NILP (Ffboundp (Qrecompute_lucid_menubar))) - call0 (Qrecompute_lucid_menubar); - Vthis_command = Qnil; Vreal_this_command = Qnil; Vthis_original_command = Qnil; @@ -1393,7 +1383,7 @@ command_loop_1 (void) /* A filter may have run while we were reading the input. */ if (! FRAME_LIVE_P (XFRAME (selected_frame))) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); set_buffer_internal (XBUFFER (XWINDOW (selected_window)->contents)); ++num_input_keys; @@ -1483,7 +1473,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)) @@ -1502,7 +1492,14 @@ command_loop_1 (void) point_before_last_command_or_undo = PT; buffer_before_last_command_or_undo = current_buffer; + /* Restart our counting of redisplay ticks before + executing the command, so that we don't blame the new + command for the sins of the previous one. */ + update_redisplay_ticks (0, NULL); + display_working_on_window_p = false; + call1 (Qcommand_execute, Vthis_command); + display_working_on_window_p = false; #ifdef HAVE_WINDOW_SYSTEM /* Do not check display_hourglass_p here, because @@ -1531,8 +1528,6 @@ command_loop_1 (void) if (!NILP (Vdelayed_warnings_list)) safe_run_hooks (Qdelayed_warnings_hook); - safe_run_hooks (Qdeferred_action_function); - kset_last_command (current_kboard, Vthis_command); kset_real_last_command (current_kboard, Vreal_this_command); if (!CONSP (last_command_event)) @@ -1568,9 +1563,15 @@ command_loop_1 (void) call0 (Qdeactivate_mark); else { + Lisp_Object symval; /* Even if not deactivating the mark, set PRIMARY if `select-active-regions' is non-nil. */ - if (!NILP (Fwindow_system (Qnil)) + if ((!NILP (Fwindow_system (Qnil)) + || ((symval = + find_symbol_value (Qtty_select_active_regions), + (!EQ (symval, Qunbound) && !NILP (symval))) + && !NILP (Fterminal_parameter (Qnil, + Qxterm__set_selection)))) /* Even if mark_active is non-nil, the actual buffer marker may not have been set yet (Bug#7044). */ && XMARKER (BVAR (current_buffer, mark))->buffer @@ -1583,9 +1584,12 @@ command_loop_1 (void) { Lisp_Object txt = call1 (Vregion_extract_function, Qnil); + if (XFIXNUM (Flength (txt)) > 0) /* Don't set empty selections. */ call2 (Qgui_set_selection, QPRIMARY, txt); + + CALLN (Frun_hook_with_args, Qpost_select_region_hook, txt); } if (current_buffer != prev_buffer || MODIFF != prev_modiff) @@ -1599,23 +1603,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 +1643,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. */ @@ -1641,7 +1655,7 @@ read_menu_command (void) unbind_to (count, Qnil); if (! FRAME_LIVE_P (XFRAME (selected_frame))) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); if (i == 0 || i == -1) return Qt; @@ -1874,7 +1888,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 +1907,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 +1951,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 +2030,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 +2221,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); @@ -2222,7 +2254,7 @@ read_event_from_main_queue (struct timespec *end_time, /* Terminate Emacs in batch mode if at eof. */ if (noninteractive && FIXNUMP (c) && XFIXNUM (c) < 0) - Fkill_emacs (make_fixnum (1)); + Fkill_emacs (make_fixnum (1), Qnil); if (FIXNUMP (c)) { @@ -2391,7 +2423,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 +2460,7 @@ read_char (int commandflag, Lisp_Object map, else reread = false; + Vlast_event_device = Qnil; if (CONSP (Vunread_command_events)) { @@ -2549,7 +2581,7 @@ read_char (int commandflag, Lisp_Object map, && (input_was_pending || !redisplay_dont_pause))) { input_was_pending = input_pending; - if (help_echo_showing_p && !EQ (selected_window, minibuf_window)) + if (help_echo_showing_p && !BASE_EQ (selected_window, minibuf_window)) redisplay_preserve_echo_area (5); else redisplay (); @@ -2633,7 +2665,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 +2748,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 +2825,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); @@ -2897,7 +2929,7 @@ read_char (int commandflag, Lisp_Object map, goto exit; } - if (EQ (c, make_fixnum (-2))) + if (BASE_EQ (c, make_fixnum (-2))) return c; if (CONSP (c) && EQ (XCAR (c), Qt)) @@ -2943,20 +2975,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 +3108,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 +3233,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), @@ -3234,7 +3254,7 @@ read_char (int commandflag, Lisp_Object map, unbind_to (count, Qnil); redisplay (); - if (EQ (c, make_fixnum (040))) + if (BASE_EQ (c, make_fixnum (040))) { cancel_echoing (); do @@ -3292,6 +3312,11 @@ help_char_p (Lisp_Object c) static void record_char (Lisp_Object c) { + /* subr.el/read-passwd binds inhibit_record_char to avoid recording + passwords. */ + if (!record_all_keys && inhibit_record_char) + return; + int recorded = 0; if (CONSP (c) && (EQ (XCAR (c), Qhelp_echo) || EQ (XCAR (c), Qmouse_movement))) @@ -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 @@ -3497,6 +3530,11 @@ readable_events (int flags) return 1; } +#ifdef HAVE_X_WINDOWS + if (x_detect_pending_selection_requests ()) + return 1; +#endif + if (!(flags & READABLE_EVENTS_IGNORE_SQUEEZABLES) && some_mouse_moved ()) return 1; if (single_kboard) @@ -3661,51 +3699,13 @@ 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; } - -#ifdef HAVE_X11 - -/* Put a selection input event back in the head of the event queue. */ - -void -kbd_buffer_unget_event (struct selection_input_event *event) -{ - /* Don't let the very last slot in the buffer become full, */ - union buffered_input_event *kp = prev_kbd_event (kbd_fetch_ptr); - if (kp != kbd_store_ptr) - { - kp->sie = *event; - kbd_fetch_ptr = kp; - } -} - -#endif - /* Limit help event positions to this range, to avoid overflow problems. */ #define INPUT_EVENT_POS_MAX \ ((ptrdiff_t) min (PTRDIFF_MAX, min (TYPE_MAXIMUM (Time) / 2, \ @@ -3730,7 +3730,7 @@ Time_to_position (Time encoded_pos) { if (encoded_pos <= INPUT_EVENT_POS_MAX) return encoded_pos; - Time encoded_pos_min = INPUT_EVENT_POS_MIN; + Time encoded_pos_min = position_to_Time (INPUT_EVENT_POS_MIN); eassert (encoded_pos_min <= encoded_pos); ptrdiff_t notpos = -1 - encoded_pos; return -1 - notpos; @@ -3752,6 +3752,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 +3770,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 +3829,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 +3861,12 @@ kbd_buffer_get_event (KBOARD **kbp, bool *used_mouse_menu, struct timespec *end_time) { - Lisp_Object obj; + Lisp_Object obj, str; +#ifdef HAVE_X_WINDOWS + bool had_pending_selection_requests; + + had_pending_selection_requests = false; +#endif #ifdef subprocesses if (kbd_on_hold_p () && kbd_buffer_nr_stored () < KBD_BUFFER_SIZE / 4) @@ -3865,6 +3892,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,13 +3916,21 @@ 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) break; if (some_mouse_moved ()) break; +#ifdef HAVE_X_WINDOWS + if (x_detect_pending_selection_requests ()) + { + had_pending_selection_requests = true; + break; + } +#endif if (end_time) { struct timespec now = current_timespec (); @@ -3930,6 +3967,16 @@ kbd_buffer_get_event (KBOARD **kbp, gobble_input (); } +#ifdef HAVE_X_WINDOWS + /* Handle pending selection requests. This can happen if Emacs + enters a recursive edit inside a nested event loop (probably + because the debugger opened) or someone called + `read-char'. */ + + if (had_pending_selection_requests) + x_handle_pending_selection_requests (); +#endif + if (CONSP (Vunread_command_events)) { Lisp_Object first; @@ -3957,24 +4004,56 @@ kbd_buffer_get_event (KBOARD **kbp, We return nil for them. */ switch (event->kind) { +#ifndef HAVE_HAIKU case SELECTION_REQUEST_EVENT: case SELECTION_CLEAR_EVENT: { -#ifdef HAVE_X11 +#if defined HAVE_X11 || HAVE_PGTK /* Remove it from the buffer before processing it, since otherwise swallow_events will see it and process it again. */ struct selection_input_event copy = event->sie; kbd_fetch_ptr = next_kbd_event (event); input_pending = readable_events (0); + +#ifdef HAVE_X11 x_handle_selection_event (©); #else + pgtk_handle_selection_event (©); +#endif +#else /* We're getting selection request events, but we don't have a window system. */ emacs_abort (); #endif } break; +#else + case SELECTION_REQUEST_EVENT: + emacs_abort (); + + case SELECTION_CLEAR_EVENT: + { + struct input_event copy = event->ie; + + kbd_fetch_ptr = next_kbd_event (event); + input_pending = readable_events (0); + haiku_handle_selection_clear (©); + } + break; +#endif + + case MONITORS_CHANGED_EVENT: + { + kbd_fetch_ptr = next_kbd_event (event); + input_pending = readable_events (0); + + CALLN (Frun_hook_with_args, + Qdisplay_monitors_changed_functions, + event->ie.arg); + + break; + } #ifdef HAVE_EXT_MENU_BAR case MENU_BAR_ACTIVATE_EVENT: @@ -3994,6 +4073,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 +4095,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 +4132,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 +4267,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 +4283,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,7 +4324,16 @@ 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); } +#ifdef HAVE_X_WINDOWS + else if (had_pending_selection_requests) + obj = Qnil; +#endif else /* We were promised by the above while loop that there was something for us to read! */ @@ -4146,14 +4352,24 @@ kbd_buffer_get_event (KBOARD **kbp, static void process_special_events (void) { - for (union buffered_input_event *event = kbd_fetch_ptr; - event != kbd_store_ptr; event = next_kbd_event (event)) + union buffered_input_event *event; +#if defined HAVE_X11 || defined HAVE_PGTK || defined HAVE_HAIKU +#ifndef HAVE_HAIKU + struct selection_input_event copy; +#else + struct input_event copy; +#endif + int moved_events; +#endif + + for (event = kbd_fetch_ptr; event != kbd_store_ptr; + event = next_kbd_event (event)) { /* If we find a stored X selection request, handle it now. */ if (event->kind == SELECTION_REQUEST_EVENT || event->kind == SELECTION_CLEAR_EVENT) { -#ifdef HAVE_X11 +#if defined HAVE_X11 || defined HAVE_PGTK /* Remove the event from the fifo buffer before processing; otherwise swallow_events called recursively could see it @@ -4161,8 +4377,7 @@ process_special_events (void) between kbd_fetch_ptr and EVENT one slot to the right, cyclically. */ - struct selection_input_event copy = event->sie; - int moved_events; + copy = event->sie; if (event < kbd_fetch_ptr) { @@ -4178,8 +4393,34 @@ process_special_events (void) moved_events * sizeof *kbd_fetch_ptr); kbd_fetch_ptr = next_kbd_event (kbd_fetch_ptr); input_pending = readable_events (0); + +#ifdef HAVE_X11 x_handle_selection_event (©); #else + pgtk_handle_selection_event (©); +#endif +#elif defined HAVE_HAIKU + if (event->ie.kind != SELECTION_CLEAR_EVENT) + emacs_abort (); + + copy = event->ie; + + if (event < kbd_fetch_ptr) + { + memmove (kbd_buffer + 1, kbd_buffer, + (event - kbd_buffer) * sizeof *kbd_buffer); + kbd_buffer[0] = kbd_buffer[KBD_BUFFER_SIZE - 1]; + moved_events = kbd_buffer + KBD_BUFFER_SIZE - 1 - kbd_fetch_ptr; + } + else + moved_events = event - kbd_fetch_ptr; + + memmove (kbd_fetch_ptr + 1, kbd_fetch_ptr, + moved_events * sizeof *kbd_fetch_ptr); + kbd_fetch_ptr = next_kbd_event (kbd_fetch_ptr); + input_pending = readable_events (0); + haiku_handle_selection_clear (©); +#else /* We're getting selection request events, but we don't have a window system. */ emacs_abort (); @@ -4383,7 +4624,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 @@ -4437,6 +4678,8 @@ timer_check (void) Lisp_Object tem = Vinhibit_quit; Vinhibit_quit = Qt; + block_input (); + turn_on_atimers (false); /* We use copies of the timers' lists to allow a timer to add itself again, without locking up Emacs if the newly added timer is @@ -4450,6 +4693,8 @@ timer_check (void) else idle_timers = Qnil; + turn_on_atimers (true); + unblock_input (); Vinhibit_quit = tem; do @@ -4484,6 +4729,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 +5165,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 +5358,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 +5393,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) @@ -5330,7 +5592,7 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, if (IMAGEP (object)) { Lisp_Object image_map, hotspot; - if ((image_map = Fplist_get (XCDR (object), QCmap), + if ((image_map = plist_get (XCDR (object), QCmap), !NILP (image_map)) && (hotspot = find_hot_spot (image_map, dx, dy), CONSP (hotspot)) @@ -5373,9 +5635,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 +6271,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 +6284,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 +6489,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 +6519,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 (); @@ -6921,7 +7265,10 @@ lucid_event_type_list_p (Lisp_Object object) If READABLE_EVENTS_FILTER_EVENTS is set in FLAGS, ignore internal events (FOCUS_IN_EVENT). If READABLE_EVENTS_IGNORE_SQUEEZABLES is set in FLAGS, ignore mouse - movements and toolkit scroll bar thumb drags. */ + movements and toolkit scroll bar thumb drags. + + On X, this also returns if the selection event chain is full, since + that's also "keyboard input". */ static bool get_input_pending (int flags) @@ -7205,7 +7552,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 +7615,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 +7631,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 +7701,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 +8067,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 +8204,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))) @@ -9168,7 +9517,7 @@ read_char_minibuf_menu_prompt (int commandflag, if (!FIXNUMP (obj) || XFIXNUM (obj) == -2 || (! EQ (obj, menu_prompt_more_char) && (!FIXNUMP (menu_prompt_more_char) - || ! EQ (obj, make_fixnum (Ctl (XFIXNUM (menu_prompt_more_char))))))) + || ! BASE_EQ (obj, make_fixnum (Ctl (XFIXNUM (menu_prompt_more_char))))))) { if (!NILP (KVAR (current_kboard, defining_kbd_macro))) store_kbd_macro_char (obj); @@ -9385,7 +9734,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; @@ -9742,7 +10091,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, if (fix_current_buffer) { if (! FRAME_LIVE_P (XFRAME (selected_frame))) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); if (XBUFFER (XWINDOW (selected_window)->contents) != current_buffer) Fset_buffer (XWINDOW (selected_window)->contents); @@ -9866,7 +10215,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, record_unwind_current_buffer (); if (! FRAME_LIVE_P (XFRAME (selected_frame))) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); set_buffer_internal (XBUFFER (XWINDOW (window)->contents)); goto replay_sequence; } @@ -10185,7 +10534,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 +10587,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 +10670,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 +11138,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; @@ -11093,7 +11445,7 @@ quit_throw_to_read_char (bool from_signal) /* When not called from a signal handler it is safe to call Lisp. */ if (!from_signal && EQ (Vquit_flag, Qkill_emacs)) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); /* Prevent another signal from doing this before we finish. */ clear_waiting_for_input (); @@ -11104,7 +11456,7 @@ quit_throw_to_read_char (bool from_signal) if (FRAMEP (internal_last_event_frame) && !EQ (internal_last_event_frame, selected_frame)) do_switch_frame (make_lispy_switch_frame (internal_last_event_frame), - 0, 0, Qnil); + 0, Qnil); sys_longjmp (getcjmp, 1); } @@ -11119,7 +11471,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 +11482,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 +11884,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 +11917,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 +11978,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 @@ -11671,11 +12077,13 @@ syms_of_keyboard (void) DEFSYM (Qpre_command_hook, "pre-command-hook"); DEFSYM (Qpost_command_hook, "post-command-hook"); + /* Hook run after the region is selected. */ + DEFSYM (Qpost_select_region_hook, "post-select-region-hook"); + DEFSYM (Qundo_auto__add_boundary, "undo-auto--add-boundary"); DEFSYM (Qundo_auto__undoably_changed_buffers, "undo-auto--undoably-changed-buffers"); - DEFSYM (Qdeferred_action_function, "deferred-action-function"); DEFSYM (Qdelayed_warnings_hook, "delayed-warnings-hook"); DEFSYM (Qfunction_key, "function-key"); @@ -11704,12 +12112,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"); @@ -11767,12 +12178,13 @@ syms_of_keyboard (void) apply_modifiers. */ DEFSYM (Qmodifier_cache, "modifier-cache"); - DEFSYM (Qrecompute_lucid_menubar, "recompute-lucid-menubar"); DEFSYM (Qactivate_menubar_hook, "activate-menubar-hook"); DEFSYM (Qpolling_period, "polling-period"); DEFSYM (Qgui_set_selection, "gui-set-selection"); + DEFSYM (Qxterm__set_selection, "xterm--set-selection"); + DEFSYM (Qtty_select_active_regions, "tty-select-active-regions"); /* The primary selection. */ DEFSYM (QPRIMARY, "PRIMARY"); @@ -11829,6 +12241,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 +12283,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 +12306,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,18 +12474,21 @@ 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. Measured in milliseconds. The value nil means disable double-click recognition; t means double-clicks have no time limit and are detected -by position only. */); +by position only. + +In Lisp, you might want to use `mouse-double-click-time' instead of +reading the value of this variable directly. */); Vdouble_click_time = make_fixnum (500); DEFVAR_INT ("double-click-fuzz", double_click_fuzz, @@ -12087,6 +12518,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,11 +12647,25 @@ 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 (Qdisplay_monitors_changed_functions, + "display-monitors-changed-functions"); + + DEFSYM (Qcoding, "coding"); + Fset (Qecho_area_clear_hook, Qnil); - DEFVAR_LISP ("lucid-menu-bar-dirty-flag", Vlucid_menu_bar_dirty_flag, - doc: /* Non-nil means menu bar, specified Lucid style, needs to be recomputed. */); - Vlucid_menu_bar_dirty_flag = Qnil; +#ifdef USE_LUCID + DEFVAR_BOOL ("lucid--menu-grab-keyboard", + lucid__menu_grab_keyboard, + doc: /* If non-nil, grab keyboard during menu operations. +This is only relevant when using the Lucid X toolkit. It can be +convenient to disable this for debugging purposes. */); + lucid__menu_grab_keyboard = true; +#endif DEFVAR_LISP ("menu-bar-final-items", Vmenu_bar_final_items, doc: /* List of menu bar items to move to the end of the menu bar. @@ -12262,12 +12718,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 @@ -12337,17 +12796,6 @@ This keymap works like `input-decode-map', but comes after `function-key-map'. Another difference is that it is global rather than terminal-local. */); Vkey_translation_map = Fmake_sparse_keymap (Qnil); - DEFVAR_LISP ("deferred-action-list", Vdeferred_action_list, - doc: /* List of deferred actions to be performed at a later time. -The precise format isn't relevant here; we just check whether it is nil. */); - Vdeferred_action_list = Qnil; - - DEFVAR_LISP ("deferred-action-function", Vdeferred_action_function, - doc: /* Function to call to handle deferred actions, after each command. -This function is called with no arguments after each command -whenever `deferred-action-list' is non-nil. */); - Vdeferred_action_function = Qnil; - DEFVAR_LISP ("delayed-warnings-list", Vdelayed_warnings_list, doc: /* List of warnings to be displayed after this command. Each element must be a list (TYPE MESSAGE [LEVEL [BUFFER-NAME]]), @@ -12439,6 +12887,14 @@ Called with three arguments: - the context (a string which normally goes at the start of the message), - the Lisp function within which the error was signaled. +For instance, to make error messages stand out more in the echo area, +you could say something like: + + (setq command-error-function + (lambda (data _ _) + (message "%s" (propertize (error-message-string data) + \\='face \\='error)))) + Also see `set-message-function' (which controls how non-error messages are displayed). */); Vcommand_error_function = intern ("command-error-default-function"); @@ -12453,11 +12909,12 @@ and tool-bar buttons. */); DEFVAR_LISP ("select-active-regions", Vselect_active_regions, - doc: /* If non-nil, an active region automatically sets the primary selection. -If the value is `only', only temporarily active regions (usually made -by mouse-dragging or shift-selection) set the window selection. + doc: /* If non-nil, any active region automatically sets the primary selection. +This variable only has an effect when Transient Mark mode is enabled. -This takes effect only when Transient Mark mode is enabled. */); +If the value is `only', only temporarily active regions (usually made +by mouse-dragging or shift-selection) set the window system's primary +selection. */); Vselect_active_regions = Qt; DEFVAR_LISP ("saved-region-selection", @@ -12512,7 +12969,65 @@ 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; + + DEFVAR_LISP ("display-monitors-changed-functions", Vdisplay_monitors_changed_functions, + doc: /* Abnormal hook run when the monitor configuration changes. +This can happen if a monitor is rotated, moved, plugged in or removed +from a multi-monitor setup, if the primary monitor changes, or if the +resolution of a monitor changes. The hook should accept a single +argument, which is the terminal on which the monitor configuration +changed. */); + Vdisplay_monitors_changed_functions = Qnil; + + DEFVAR_BOOL ("inhibit--record-char", + inhibit_record_char, + doc: /* If non-nil, don't record input events. +This inhibits recording input events for the purposes of keyboard +macros, dribble file, and `recent-keys'. +Internal use only. */); + inhibit_record_char = false; + + DEFVAR_BOOL ("record-all-keys", record_all_keys, + doc: /* Non-nil means record all keys you type. +When nil, the default, characters typed as part of passwords are +not recorded. The non-nil value countermands `inhibit--record-char', +which see. */); + record_all_keys = false; + + DEFVAR_LISP ("post-select-region-hook", Vpost_select_region_hook, + doc: /* Abnormal hook run after the region is selected. +This usually happens as a result of `select-active-regions'. The hook +is called with one argument, the string that was selected. */);; + Vpost_select_region_hook = Qnil; pdumper_do_now_and_after_load (syms_of_keyboard_for_pdumper); } @@ -12541,7 +13056,6 @@ syms_of_keyboard_for_pdumper (void) PDUMPER_RESET (num_input_keys, 0); PDUMPER_RESET (num_nonmacro_input_events, 0); PDUMPER_RESET_LV (Vlast_event_frame, Qnil); - PDUMPER_RESET_LV (Vdeferred_action_list, Qnil); PDUMPER_RESET_LV (Vdelayed_warnings_list, Qnil); /* Create the initial keyboard. Qt means 'unset'. */ @@ -12663,12 +13177,21 @@ mark_kboards (void) { /* These two special event types have no Lisp_Objects to mark. */ if (event->kind != SELECTION_REQUEST_EVENT - && event->kind != SELECTION_CLEAR_EVENT) +#ifndef HAVE_HAIKU + && event->kind != SELECTION_CLEAR_EVENT +#endif + ) { mark_object (event->ie.x); 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..507d80c2975 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -27,6 +27,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ # include "xterm.h" /* for struct selection_input_event */ #endif +#ifdef HAVE_PGTK +#include "pgtkterm.h" /* for struct selection_input_event */ +#endif + INLINE_HEADER_BEGIN /* Most code should use this macro to access Lisp fields in struct kboard. */ @@ -226,7 +230,7 @@ union buffered_input_event { ENUM_BF (event_kind) kind : EVENT_KIND_WIDTH; struct input_event ie; -#ifdef HAVE_X11 +#if defined HAVE_X11 || defined HAVE_PGTK struct selection_input_event sie; #endif }; @@ -358,6 +362,11 @@ enum menu_item_idx MENU_ITEMS_ITEM_LENGTH }; +enum + { + KBD_BUFFER_SIZE = 4096 + }; + extern void unuse_menu_items (void); /* This is how to deal with multibyte text if HAVE_MULTILINGUAL_MENU @@ -419,6 +428,10 @@ extern void unuse_menu_items (void); happens. */ extern struct timespec *input_available_clear_time; +extern union buffered_input_event kbd_buffer[KBD_BUFFER_SIZE]; +extern union buffered_input_event *kbd_fetch_ptr; +extern union buffered_input_event *kbd_store_ptr; + extern bool ignore_mouse_drag_p; extern Lisp_Object parse_modifiers (Lisp_Object); @@ -472,9 +485,6 @@ kbd_buffer_store_event_hold (struct input_event *event, kbd_buffer_store_buffered_event ((union buffered_input_event *) event, hold_quit); } -#ifdef HAVE_X11 -extern void kbd_buffer_unget_event (struct selection_input_event *); -#endif extern void poll_for_input_1 (void); extern void show_help_echo (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); @@ -486,12 +496,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..506b755e5da 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, @@ -390,7 +395,7 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx, if (noinherit || NILP (retval)) /* If NOINHERIT, stop here, the rest is inherited. */ break; - else if (!EQ (retval, Qunbound)) + else if (!BASE_EQ (retval, Qunbound)) { Lisp_Object parent_entry; eassert (KEYMAPP (retval)); @@ -449,7 +454,7 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx, } /* If we found a binding, clean it up and return it. */ - if (!EQ (val, Qunbound)) + if (!BASE_EQ (val, Qunbound)) { if (EQ (val, Qt)) /* A Qt binding is just like an explicit nil binding @@ -461,12 +466,12 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx, if (!KEYMAPP (val)) { - if (NILP (retval) || EQ (retval, Qunbound)) + if (NILP (retval) || BASE_EQ (retval, Qunbound)) retval = val; if (!NILP (val)) break; /* Shadows everything that follows. */ } - else if (NILP (retval) || EQ (retval, Qunbound)) + else if (NILP (retval) || BASE_EQ (retval, Qunbound)) retval = val; else if (CONSP (retval_tail)) { @@ -482,7 +487,8 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx, maybe_quit (); } - return EQ (Qunbound, retval) ? get_keyelt (t_binding, autoload) : retval; + return BASE_EQ (Qunbound, retval) + ? get_keyelt (t_binding, autoload) : retval; } } @@ -491,7 +497,7 @@ access_keymap (Lisp_Object map, Lisp_Object idx, bool t_ok, bool noinherit, bool autoload) { Lisp_Object val = access_keymap_1 (map, idx, t_ok, noinherit, autoload); - return EQ (val, Qunbound) ? Qnil : val; + return BASE_EQ (val, Qunbound) ? Qnil : val; } static void @@ -726,7 +732,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 +809,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 +847,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 +865,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; } @@ -1006,8 +1026,14 @@ DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0, doc: /* Return a copy of the keymap KEYMAP. Note that this is almost never needed. If you want a keymap that's like -another yet with a few changes, you should use map inheritance rather -than copying. I.e. something like: +another yet with a few changes, you should use keymap inheritance rather +than copying. That is, something like: + + (defvar-keymap foo-map + :parent <theirmap> + ...) + +Or, if you need to support Emacs versions older than 29: (let ((map (make-sparse-keymap))) (set-keymap-parent map <theirmap>) @@ -1027,10 +1053,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 +1101,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 +1144,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 +1187,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 +1256,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 +1292,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 +1317,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 +1448,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; } @@ -1404,7 +1557,7 @@ current_minor_maps (Lisp_Object **modeptr, Lisp_Object **mapptr) for ( ; CONSP (alist); alist = XCDR (alist)) if ((assoc = XCAR (alist), CONSP (assoc)) && (var = XCAR (assoc), SYMBOLP (var)) - && (val = find_symbol_value (var), !EQ (val, Qunbound)) + && (val = find_symbol_value (var), !BASE_EQ (val, Qunbound)) && !NILP (val)) { Lisp_Object temp; @@ -1504,7 +1657,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); @@ -2449,7 +2602,10 @@ The optional 5th arg NO-REMAP alters how command remapping is handled: - If DEFINITION is remapped to OTHER-COMMAND, normally return the bindings for OTHER-COMMAND. But if NO-REMAP is non-nil, return the - bindings for DEFINITION instead, ignoring its remapping. */) + bindings for DEFINITION instead, ignoring its remapping. + +Keys that are represented as events that have a `non-key-event' non-nil +symbol property are ignored. */) (Lisp_Object definition, Lisp_Object keymap, Lisp_Object firstonly, Lisp_Object noindirect, Lisp_Object no_remap) { /* The keymaps in which to search. */ @@ -2573,7 +2729,12 @@ The optional 5th arg NO-REMAP alters how command remapping is handled: /* It is a true unshadowed match. Record it, unless it's already been seen (as could happen when inheriting keymaps). */ - if (NILP (Fmember (sequence, found))) + if (NILP (Fmember (sequence, found)) + /* Filter out non key events. */ + && !(VECTORP (sequence) + && ASIZE (sequence) == 1 + && SYMBOLP (AREF (sequence, 0)) + && !NILP (Fget (AREF (sequence, 0), Qnon_key_event)))) found = Fcons (sequence, found); /* If firstonly is Qnon_ascii, then we can return the first @@ -2721,7 +2882,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, Vkey_translation_map, Qnil, Qnil, prefix, - msg, nomenu, Qt, Qnil, Qnil); + msg, nomenu, Qt, Qnil, Qnil, buffer); } /* Print the (major mode) local map. */ @@ -2735,7 +2896,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, start1, Qt, shadow, prefix, - msg, nomenu, Qnil, Qnil, Qnil); + msg, nomenu, Qnil, Qnil, Qnil, buffer); shadow = Fcons (start1, shadow); start1 = Qnil; } @@ -2748,7 +2909,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, start1, Qt, shadow, prefix, - msg, nomenu, Qnil, Qnil, Qnil); + msg, nomenu, Qnil, Qnil, Qnil, buffer); shadow = Fcons (start1, shadow); } else @@ -2771,7 +2932,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, start1, Qt, shadow, prefix, - msg, nomenu, Qnil, Qnil, Qnil); + msg, nomenu, Qnil, Qnil, Qnil, buffer); shadow = Fcons (start1, shadow); } @@ -2804,7 +2965,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, maps[i], Qt, shadow, prefix, - msg, nomenu, Qnil, Qnil, Qnil); + msg, nomenu, Qnil, Qnil, Qnil, buffer); shadow = Fcons (maps[i], shadow); SAFE_FREE (); } @@ -2815,11 +2976,14 @@ 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, - msg, nomenu, Qnil, Qnil, Qnil); + msg, nomenu, Qnil, Qnil, Qnil, buffer); } else { @@ -2827,7 +2991,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, start1, Qt, shadow, prefix, - msg, nomenu, Qnil, Qnil, Qnil); + msg, nomenu, Qnil, Qnil, Qnil, buffer); } shadow = Fcons (start1, shadow); @@ -2838,7 +3002,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, current_global_map, Qt, shadow, prefix, - msg, nomenu, Qnil, Qt, Qnil); + msg, nomenu, Qnil, Qt, Qnil, buffer); /* Print the function-key-map translations under this prefix. */ if (!NILP (KVAR (current_kboard, Vlocal_function_key_map))) @@ -2847,7 +3011,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, KVAR (current_kboard, Vlocal_function_key_map), Qnil, Qnil, prefix, - msg, nomenu, Qt, Qnil, Qnil); + msg, nomenu, Qt, Qnil, Qnil, buffer); } /* Print the input-decode-map translations under this prefix. */ @@ -2857,7 +3021,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, KVAR (current_kboard, Vinput_decode_map), Qnil, Qnil, prefix, - msg, nomenu, Qt, Qnil, Qnil); + msg, nomenu, Qt, Qnil, Qnil, buffer); } return Qnil; } @@ -2882,7 +3046,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 +3092,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 +3472,9 @@ 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"); + + DEFSYM (Qnon_key_event, "non-key-event"); } diff --git a/src/kqueue.c b/src/kqueue.c index c3c4631784d..99a9434cc2e 100644 --- a/src/kqueue.c +++ b/src/kqueue.c @@ -159,8 +159,8 @@ kqueue_compare_dir_list (Lisp_Object watch_object) (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (old_entry)), Qnil); /* Status change time has been changed, the file attributes have changed. */ - if (NILP (Fequal (Fnth (make_fixnum (3), old_entry), - Fnth (make_fixnum (3), new_entry)))) + if (NILP (Fequal (Fnth (make_fixnum (3), old_entry), + Fnth (make_fixnum (3), new_entry)))) kqueue_generate_event (watch_object, Fcons (Qattrib, Qnil), XCAR (XCDR (old_entry)), Qnil); diff --git a/src/lisp.h b/src/lisp.h index ab0be3b281b..dc496cc1658 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, @@ -344,6 +342,7 @@ typedef EMACS_INT Lisp_Word; # define lisp_h_XIL(i) (i) # define lisp_h_XLP(o) ((void *) (uintptr_t) (o)) # endif +# define lisp_h_Qnil 0 #else # if LISP_WORDS_ARE_POINTERS # define lisp_h_XLI(o) ((EMACS_INT) (o).i) @@ -354,20 +353,49 @@ typedef EMACS_INT Lisp_Word; # define lisp_h_XIL(i) ((Lisp_Object) {i}) # define lisp_h_XLP(o) ((void *) (uintptr_t) (o).i) # endif +# define lisp_h_Qnil {0} #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)) +#define lisp_h_BASE2_EQ(x, y) \ + (BASE_EQ (x, y) \ + || (symbols_with_pos_enabled \ + && SYMBOL_WITH_POS_P (x) \ + && BASE_EQ (XSYMBOL_WITH_POS (x)->sym, 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 +404,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 +452,13 @@ 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 BASE2_EQ(x, y) lisp_h_BASE2_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 +466,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) @@ -595,6 +628,8 @@ extern void char_table_set (Lisp_Object, int, Lisp_Object); 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 +976,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 +1011,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) -{ - 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) +struct Lisp_Symbol_With_Pos { - 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 +1041,7 @@ enum pvec_type PVEC_MARKER, PVEC_OVERLAY, PVEC_FINALIZER, + PVEC_SYMBOL_WITH_POS, PVEC_MISC_PTR, PVEC_USER_PTR, PVEC_PROCESS, @@ -1070,6 +1061,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 +1101,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 +1318,22 @@ 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 X to be the + same as a bare symbol Y if X is Y with position. */ +INLINE bool +(BASE2_EQ) (Lisp_Object x, Lisp_Object y) +{ + return lisp_h_BASE2_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 +1575,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; @@ -1545,13 +1640,13 @@ STRING_MULTIBYTE (Lisp_Object str) /* Mark STR as a multibyte string. Assure that STR contains only ASCII characters in advance. */ -#define STRING_SET_MULTIBYTE(STR) \ - do { \ - if (XSTRING (STR)->u.s.size == 0) \ - (STR) = empty_multibyte_string; \ - else \ - XSTRING (STR)->u.s.size_byte = XSTRING (STR)->u.s.size; \ - } while (false) +INLINE void +STRING_SET_MULTIBYTE (Lisp_Object str) +{ + /* The 0-length strings are unique&shared so we can't modify them. */ + eassert (XSTRING (str)->u.s.size > 0); + XSTRING (str)->u.s.size_byte = XSTRING (str)->u.s.size; +} /* Convenience functions for dealing with Lisp strings. */ @@ -1630,6 +1725,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 +1808,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 @@ -2018,19 +2105,17 @@ XSUB_CHAR_TABLE (Lisp_Object a) INLINE Lisp_Object CHAR_TABLE_REF_ASCII (Lisp_Object ct, ptrdiff_t idx) { - struct Lisp_Char_Table *tbl = NULL; - Lisp_Object val; - do + for (struct Lisp_Char_Table *tbl = XCHAR_TABLE (ct); ; + tbl = XCHAR_TABLE (tbl->parent)) { - tbl = tbl ? XCHAR_TABLE (tbl->parent) : XCHAR_TABLE (ct); - val = (! SUB_CHAR_TABLE_P (tbl->ascii) ? tbl->ascii - : XSUB_CHAR_TABLE (tbl->ascii)->contents[idx]); + Lisp_Object val = (SUB_CHAR_TABLE_P (tbl->ascii) + ? XSUB_CHAR_TABLE (tbl->ascii)->contents[idx] + : tbl->ascii); if (NILP (val)) val = tbl->defalt; + if (!NILP (val) || NILP (tbl->parent)) + return val; } - while (NILP (val) && ! NILP (tbl->parent)); - - return val; } /* Almost equivalent to Faref (CT, IDX) with optimization for ASCII @@ -2079,9 +2164,10 @@ struct Lisp_Subr short min_args, max_args; const char *symbol_name; union { - const char *intspec; - Lisp_Object native_intspec; - }; + const char *string; + Lisp_Object native; + } intspec; + Lisp_Object command_modes; EMACS_INT doc; #ifdef HAVE_NATIVE_COMP Lisp_Object native_comp_u; @@ -2110,6 +2196,16 @@ XSUBR (Lisp_Object a) return &XUNTAG (a, Lisp_Vectorlike, union Aligned_Lisp_Subr)->s; } +/* Return whether a value might be a valid docstring. + Used to distinguish the presence of non-docstring in the docstring slot, + as in the case of OClosures. */ +INLINE bool +VALID_DOCSTRING_P (Lisp_Object doc) +{ + return FIXNUMP (doc) || STRINGP (doc) + || (CONSP (doc) && STRINGP (XCAR (doc)) && FIXNUMP (XCDR (doc))); +} + enum char_table_specials { /* This is the number of slots that every char table must have. This @@ -2557,6 +2653,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 +2728,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 +2758,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); @@ -3048,12 +3196,12 @@ CHECK_SUBR (Lisp_Object x) /* This version of DEFUN declares a function prototype with the right arguments, so we can catch errors with maxargs at compile-time. */ -#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \ - SUBR_SECTION_ATTRIBUTE \ - static union Aligned_Lisp_Subr sname = \ - {{{ PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \ - { .a ## maxargs = fnname }, \ - minargs, maxargs, lname, {intspec}, 0}}; \ +#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \ + SUBR_SECTION_ATTRIBUTE \ + static union Aligned_Lisp_Subr sname = \ + {{{ PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \ + { .a ## maxargs = fnname }, \ + minargs, maxargs, lname, {intspec}, lisp_h_Qnil}}; \ Lisp_Object fnname /* defsubr (Sname); @@ -3077,6 +3225,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 +3380,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 +3409,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 +3435,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 +3445,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 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 +3641,46 @@ 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; + +#ifdef HAVE_X_WINDOWS + int x_error_handler_depth; +#endif }; 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 +3710,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 +4008,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 +4023,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); @@ -3659,8 +4034,15 @@ extern ptrdiff_t string_char_to_byte (Lisp_Object, ptrdiff_t); extern ptrdiff_t string_byte_to_char (Lisp_Object, ptrdiff_t); extern Lisp_Object string_to_multibyte (Lisp_Object); extern Lisp_Object string_make_unibyte (Lisp_Object); +extern Lisp_Object plist_get (Lisp_Object plist, Lisp_Object prop); +extern Lisp_Object plist_put (Lisp_Object plist, Lisp_Object prop, + Lisp_Object val); +extern Lisp_Object plist_member (Lisp_Object plist, Lisp_Object prop); 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 +4162,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 +4190,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 +4315,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 +4336,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 +4350,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 +4383,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 +4410,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. */ @@ -4115,6 +4506,7 @@ extern void dir_warning (const char *, Lisp_Object); extern void init_obarray_once (void); extern void init_lread (void); extern void syms_of_lread (void); +extern void mark_lread (void); INLINE Lisp_Object intern (const char *str) @@ -4163,51 +4555,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 +4601,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 +4712,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, @@ -4345,6 +4733,7 @@ extern bool internal_delete_file (Lisp_Object); extern Lisp_Object check_emacs_readlinkat (int, Lisp_Object, char const *); extern bool file_directory_p (Lisp_Object); extern bool file_accessible_directory_p (Lisp_Object); +extern Lisp_Object buffer_visited_file_modtime (struct buffer *); extern void init_fileio (void); extern void syms_of_fileio (void); @@ -4426,7 +4815,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; @@ -4453,7 +4842,7 @@ extern void syms_of_indent (void); /* Defined in frame.c. */ extern void store_frame_param (struct frame *, Lisp_Object, Lisp_Object); extern void store_in_alist (Lisp_Object *, Lisp_Object, Lisp_Object); -extern Lisp_Object do_switch_frame (Lisp_Object, int, int, Lisp_Object); +extern Lisp_Object do_switch_frame (Lisp_Object, int, Lisp_Object); extern Lisp_Object get_frame_param (struct frame *, Lisp_Object); extern void frames_discard_buffer (Lisp_Object); extern void init_frame_once (void); @@ -4481,7 +4870,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 +4936,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 +4950,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 +5022,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); @@ -4709,9 +5114,7 @@ extern void syms_of_w32cygwinx (void); extern Lisp_Object Vface_alternative_font_family_alist; extern Lisp_Object Vface_alternative_font_registry_alist; extern void syms_of_xfaces (void); -#ifdef HAVE_PDUMPER extern void init_xfaces (void); -#endif #ifdef HAVE_X_WINDOWS /* Defined in xfns.c. */ @@ -4816,17 +5219,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 +5286,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 +5329,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 +5357,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); } @@ -5106,7 +5517,7 @@ struct for_each_tail_internal intended for use only by the above macros. Use Brent’s teleporting tortoise-hare algorithm. See: - Brent RP. BIT. 1980;20(2):176-84. doi:10.1007/BF01933190 + Brent RP. BIT. 1980;20(2):176-184. doi:10.1007/BF01933190 https://maths-people.anu.edu.au/~brent/pd/rpb051i.pdf This macro uses maybe_quit because of an excess of caution. The @@ -5123,7 +5534,7 @@ struct for_each_tail_internal || ((check_quit) ? maybe_quit () : (void) 0, 0 < --li.n) \ || (li.q = li.n = li.max <<= 1, li.n >>= USHRT_WIDTH, \ li.tortoise = (tail), false)) \ - && EQ (tail, li.tortoise)) \ + && BASE_EQ (tail, li.tortoise)) \ ? (cycle) : (void) 0)) /* Do a `for' loop over alist values. */ diff --git a/src/lread.c b/src/lread.c index d3e0a63ccdc..759cc08946d 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,8 @@ 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); - -static Lisp_Object read_list (bool, Lisp_Object); -static Lisp_Object read_vector (Lisp_Object, bool); + Lisp_Object, bool); +static Lisp_Object read0 (Lisp_Object, bool); static Lisp_Object substitute_object_recurse (struct subst *, Lisp_Object); static void substitute_in_interval (INTERVAL, void *); @@ -933,7 +936,7 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun) ch = READCHAR; if (ch == '\n') ch = READCHAR; /* It is OK to leave the position after a #! line, since - that is what read1 does. */ + that is what read0 does. */ } if (ch != ';') @@ -1045,12 +1048,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 +1077,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 +1173,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 +1230,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; @@ -1226,10 +1244,9 @@ Return t if the file exists and loads successfully. */) CHECK_STRING (file); /* If file name is magic, call the handler. */ - /* This shouldn't be necessary any more now that `openp' handles it right. - handler = Ffind_file_name_handler (file, Qload); - if (!NILP (handler)) - return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */ + handler = Ffind_file_name_handler (file, Qload); + if (!NILP (handler)) + return call5 (handler, Qload, file, noerror, nomessage, nosuffix); /* The presence of this call is the result of a historical accident: it used to be in every file-operation and when it got removed @@ -1407,7 +1424,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 +1433,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 +1554,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 +1562,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 +1573,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 +1636,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 +1664,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; @@ -1723,13 +1735,24 @@ maybe_swap_for_eln (bool no_native, Lisp_Object *filename, int *fd, { if (!NILP (find_symbol_value ( Qnative_comp_warning_on_missing_source))) - call2 (intern_c_string ("display-warning"), - Qcomp, - CALLN (Fformat, - build_string ("Cannot look-up eln file as no source " - "file was found for %s"), - *filename)); - return; + { + /* If we have an installation without any .el files, + there's really no point in giving a warning here, + because that will trigger a cascade of warnings. So + just do a sanity check and refuse to do anything if we + can't find even central .el files. */ + if (NILP (Flocate_file_internal (build_string ("simple.el"), + Vload_path, + Qnil, Qnil))) + return; + call2 (intern_c_string ("display-warning"), + Qcomp, + CALLN (Fformat, + build_string ("Cannot look up eln file as " + "no source file was found for %s"), + *filename)); + return; + } } } Lisp_Object eln_rel_name = Fcomp_el_to_eln_rel_filename (src_name); @@ -2160,7 +2183,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 +2193,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 +2219,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); @@ -2202,20 +2227,21 @@ readevalloop (Lisp_Object readcharfun, lexical environment, otherwise, turn off lexical binding. */ lex_bound = find_symbol_value (Qlexical_binding); specbind (Qinternal_interpreter_environment, - (NILP (lex_bound) || EQ (lex_bound, Qunbound) + (NILP (lex_bound) || BASE_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"); @@ -2266,6 +2292,7 @@ readevalloop (Lisp_Object readcharfun, if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r' || c == NO_BREAK_SPACE) goto read_next; + UNREAD (c); if (! HASH_TABLE_P (read_objects_map) || XHASH_TABLE (read_objects_map)->count) @@ -2280,12 +2307,9 @@ readevalloop (Lisp_Object readcharfun, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, Qnil, false); if (!NILP (Vpurify_flag) && c == '(') - { - val = read_list (0, readcharfun); - } + val = read0 (readcharfun, false); else { - UNREAD (c); if (!NILP (readfun)) { val = call1 (readfun, readcharfun); @@ -2303,7 +2327,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) @@ -2329,7 +2353,7 @@ readevalloop (Lisp_Object readcharfun, { Vvalues = Fcons (val, Vvalues); if (EQ (Vstandard_output, Qt)) - Fprin1 (val, Qnil); + Fprin1 (val, Qnil, Qnil); else Fprint (val, Qnil); } @@ -2370,7 +2394,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 +2439,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 +2485,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 +2529,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 +2556,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 +2576,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; @@ -2538,24 +2586,6 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end) return retval; } - -/* Use this for recursive reads, in contexts where internal tokens - are not allowed. */ - -static Lisp_Object -read0 (Lisp_Object readcharfun) -{ - register Lisp_Object val; - int c; - - val = read1 (readcharfun, &c, 0); - if (!c) - return val; - - invalid_syntax_lisp (Fmake_string (make_fixnum (1), make_fixnum (c), Qnil), - readcharfun); -} - /* Grow a read buffer BUF that contains OFFSET useful bytes of data, by at least MAX_MULTIBYTE_LENGTH bytes. Update *BUF_ADDR and *BUF_SIZE accordingly; 0 <= OFFSET <= *BUF_SIZE. If *BUF_ADDR is @@ -2566,7 +2596,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) @@ -2614,7 +2644,7 @@ enum { UNICODE_CHARACTER_NAME_LENGTH_BOUND = 200 }; If the escape sequence forces unibyte, return eight-bit char. */ static int -read_escape (Lisp_Object readcharfun, bool stringp) +read_escape (Lisp_Object readcharfun) { int c = READCHAR; /* \u allows up to four hex digits, \U up to eight. Default to the @@ -2644,12 +2674,10 @@ read_escape (Lisp_Object readcharfun, bool stringp) return '\t'; case 'v': return '\v'; + case '\n': - return -1; - case ' ': - if (stringp) - return -1; - return ' '; + /* ?\LF is an error; it's probably a user mistake. */ + error ("Invalid escape character syntax"); case 'M': c = READCHAR; @@ -2657,7 +2685,7 @@ read_escape (Lisp_Object readcharfun, bool stringp) error ("Invalid escape character syntax"); c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0); + c = read_escape (readcharfun); return c | meta_modifier; case 'S': @@ -2666,7 +2694,7 @@ read_escape (Lisp_Object readcharfun, bool stringp) error ("Invalid escape character syntax"); c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0); + c = read_escape (readcharfun); return c | shift_modifier; case 'H': @@ -2675,7 +2703,7 @@ read_escape (Lisp_Object readcharfun, bool stringp) error ("Invalid escape character syntax"); c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0); + c = read_escape (readcharfun); return c | hyper_modifier; case 'A': @@ -2684,19 +2712,19 @@ read_escape (Lisp_Object readcharfun, bool stringp) error ("Invalid escape character syntax"); c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0); + c = read_escape (readcharfun); return c | alt_modifier; case 's': c = READCHAR; - if (stringp || c != '-') + if (c != '-') { UNREAD (c); return ' '; } c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0); + c = read_escape (readcharfun); return c | super_modifier; case 'C': @@ -2707,10 +2735,10 @@ read_escape (Lisp_Object readcharfun, bool stringp) case '^': c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0); + c = read_escape (readcharfun); 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. */ @@ -2858,8 +2886,8 @@ read_escape (Lisp_Object readcharfun, bool stringp) invalid_syntax ("Empty character name", readcharfun); name[length] = '\0'; - /* character_name_to_code can invoke read1, recursively. - This is why read1's buffer is not static. */ + /* character_name_to_code can invoke read0, recursively. + This is why read0's buffer is not static. */ return character_name_to_code (name, length, readcharfun); } @@ -2888,20 +2916,17 @@ digit_to_number (int character, int base) return digit < base ? digit : -1; } -static char const invalid_radix_integer_format[] = "integer, radix %"pI"d"; - -/* Small, as read1 is recursive (Bug#31995). But big enough to hold - the invalid_radix_integer string. */ -enum { stackbufsize = max (64, - (sizeof invalid_radix_integer_format - - sizeof "%"pI"d" - + INT_STRLEN_BOUND (EMACS_INT) + 1)) }; +/* Size of the fixed-size buffer used during reading. + It should be at least big enough for `invalid_radix_integer' but + can usefully be much bigger than that. */ +enum { stackbufsize = 1024 }; static void invalid_radix_integer (EMACS_INT radix, char stackbuf[VLA_ELEMS (stackbufsize)], Lisp_Object readcharfun) { - sprintf (stackbuf, invalid_radix_integer_format, radix); + int n = snprintf (stackbuf, stackbufsize, "integer, radix %"pI"d", radix); + eassert (n < stackbufsize); invalid_syntax (stackbuf, readcharfun); } @@ -2919,7 +2944,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 == '+') @@ -2967,778 +2992,1114 @@ read_integer (Lisp_Object readcharfun, int radix, *p = '\0'; return unbind_to (count, string_to_number (read_buffer, radix, NULL)); } + -/* If the next token is ')' or ']' or '.', we store that character - in *PCH and the return value is not interesting. Else, we store - zero in *PCH and we read and return one lisp object. - - FIRST_IN_LIST is true if this is the first element of a list. */ - +/* Read a character literal (preceded by `?'). */ static Lisp_Object -read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) +read_char_literal (Lisp_Object readcharfun) { - int c; - bool uninterned_symbol = false; - bool skip_shorthand = false; - bool multibyte; - char stackbuf[stackbufsize]; - current_thread->stack_top = stackbuf; + int ch = READCHAR; + if (ch < 0) + end_of_file_error (); - *pch = 0; + /* Accept `single space' syntax like (list ? x) where the + whitespace character is SPC or TAB. + Other literal whitespace like NL, CR, and FF are not accepted, + as there are well-established escape sequences for these. */ + if (ch == ' ' || ch == '\t') + return make_fixnum (ch); - retry: + if ( ch == '(' || ch == ')' || ch == '[' || ch == ']' + || ch == '"' || ch == ';') + { + CHECK_LIST (Vlread_unescaped_character_literals); + Lisp_Object char_obj = make_fixed_natnum (ch); + if (NILP (Fmemq (char_obj, Vlread_unescaped_character_literals))) + Vlread_unescaped_character_literals = + Fcons (char_obj, Vlread_unescaped_character_literals); + } - c = READCHAR_REPORT_MULTIBYTE (&multibyte); - if (c < 0) - end_of_file_error (); + if (ch == '\\') + ch = read_escape (readcharfun); - switch (c) - { - case '(': - return read_list (0, readcharfun); + int modifiers = ch & CHAR_MODIFIER_MASK; + ch &= ~CHAR_MODIFIER_MASK; + if (CHAR_BYTE8_P (ch)) + ch = CHAR_TO_BYTE8 (ch); + ch |= modifiers; - case '[': - return read_vector (readcharfun, 0); + int nch = READCHAR; + UNREAD (nch); + if (nch <= 32 + || nch == '"' || nch == '\'' || nch == ';' || nch == '(' + || nch == ')' || nch == '[' || nch == ']' || nch == '#' + || nch == '?' || nch == '`' || nch == ',' || nch == '.') + return make_fixnum (ch); - case ')': - case ']': - { - *pch = c; - return Qnil; - } + invalid_syntax ("?", readcharfun); +} - case '#': - c = READCHAR; - if (c == 's') +/* Read a string literal (preceded by '"'). */ +static Lisp_Object +read_string_literal (char stackbuf[VLA_ELEMS (stackbufsize)], + Lisp_Object readcharfun) +{ + char *read_buffer = stackbuf; + ptrdiff_t read_buffer_size = stackbufsize; + specpdl_ref count = SPECPDL_INDEX (); + char *heapbuf = NULL; + char *p = read_buffer; + char *end = read_buffer + read_buffer_size; + /* True if we saw an escape sequence specifying + a multibyte character. */ + bool force_multibyte = false; + /* True if we saw an escape sequence specifying + a single-byte character. */ + bool force_singlebyte = false; + bool cancel = false; + ptrdiff_t nchars = 0; + + int ch; + while ((ch = READCHAR) >= 0 && ch != '\"') + { + if (end - p < MAX_MULTIBYTE_LENGTH) { - c = READCHAR; - if (c == '(') + ptrdiff_t offset = p - read_buffer; + read_buffer = grow_read_buffer (read_buffer, offset, + &heapbuf, &read_buffer_size, + count); + p = read_buffer + offset; + end = read_buffer + read_buffer_size; + } + + if (ch == '\\') + { + /* First apply string-specific escape rules: */ + ch = READCHAR; + switch (ch) { - /* 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 head = CAR_SAFE (tmp); - Lisp_Object data = Qnil; - Lisp_Object val = Qnil; - /* The size is 2 * number of allowed keywords to - make-hash-table. */ - Lisp_Object params[12]; - Lisp_Object ht; - Lisp_Object key = Qnil; - int param_count = 0; - - if (!EQ (head, Qhash_table)) + case 's': + /* `\s' is always a space in strings. */ + ch = ' '; + break; + case ' ': + case '\n': + /* `\SPC' and `\LF' generate no characters at all. */ + if (p == read_buffer) + cancel = true; + continue; + default: + UNREAD (ch); + ch = read_escape (readcharfun); + break; + } + + int modifiers = ch & CHAR_MODIFIER_MASK; + ch &= ~CHAR_MODIFIER_MASK; + + if (CHAR_BYTE8_P (ch)) + force_singlebyte = true; + else if (! ASCII_CHAR_P (ch)) + force_multibyte = true; + else /* I.e. ASCII_CHAR_P (ch). */ + { + /* Allow `\C-SPC' and `\^SPC'. This is done here because + the literals ?\C-SPC and ?\^SPC (rather inconsistently) + yield (' ' | CHAR_CTL); see bug#55738. */ + if (modifiers == CHAR_CTL && ch == ' ') + { + ch = 0; + modifiers = 0; + } + if (modifiers & CHAR_SHIFT) { - ptrdiff_t size = XFIXNUM (Flength (tmp)); - Lisp_Object record = Fmake_record (CAR_SAFE (tmp), - make_fixnum (size - 1), - Qnil); - for (int i = 1; i < size; i++) + /* Shift modifier is valid only with [A-Za-z]. */ + if (ch >= 'A' && ch <= 'Z') + modifiers &= ~CHAR_SHIFT; + else if (ch >= 'a' && ch <= 'z') { - tmp = Fcdr (tmp); - ASET (record, i, Fcar (tmp)); + ch -= ('a' - 'A'); + modifiers &= ~CHAR_SHIFT; } - return record; } - tmp = CDR_SAFE (tmp); + if (modifiers & CHAR_META) + { + /* Move the meta bit to the right place for a + string. */ + modifiers &= ~CHAR_META; + ch = BYTE8_TO_CHAR (ch | 0x80); + force_singlebyte = true; + } + } - /* This is repetitive but fast and simple. */ - params[param_count] = QCsize; - params[param_count + 1] = Fplist_get (tmp, Qsize); - if (!NILP (params[param_count + 1])) - param_count += 2; + /* Any modifiers remaining are invalid. */ + if (modifiers) + invalid_syntax ("Invalid modifier in string", readcharfun); + p += CHAR_STRING (ch, (unsigned char *) p); + } + else + { + p += CHAR_STRING (ch, (unsigned char *) p); + if (CHAR_BYTE8_P (ch)) + force_singlebyte = true; + else if (! ASCII_CHAR_P (ch)) + force_multibyte = true; + } + nchars++; + } - params[param_count] = QCtest; - params[param_count + 1] = Fplist_get (tmp, Qtest); - if (!NILP (params[param_count + 1])) - param_count += 2; + if (ch < 0) + end_of_file_error (); - params[param_count] = QCweakness; - params[param_count + 1] = Fplist_get (tmp, Qweakness); - if (!NILP (params[param_count + 1])) - param_count += 2; + /* If purifying, and string starts with \ newline, + return zero instead. This is for doc strings + that we are really going to find in etc/DOC.nn.nn. */ + if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel) + { + unbind_to (count, Qnil); + return make_fixnum (0); + } - params[param_count] = QCrehash_size; - params[param_count + 1] = Fplist_get (tmp, Qrehash_size); - if (!NILP (params[param_count + 1])) - param_count += 2; + if (!force_multibyte && force_singlebyte) + { + /* READ_BUFFER contains raw 8-bit bytes and no multibyte + forms. Convert it to unibyte. */ + nchars = str_as_unibyte ((unsigned char *) read_buffer, + p - read_buffer); + p = read_buffer + nchars; + } - params[param_count] = QCrehash_threshold; - params[param_count + 1] = Fplist_get (tmp, Qrehash_threshold); - if (!NILP (params[param_count + 1])) - param_count += 2; + Lisp_Object obj = make_specified_string (read_buffer, nchars, p - read_buffer, + (force_multibyte + || (p - read_buffer != nchars))); + return unbind_to (count, obj); +} - params[param_count] = QCpurecopy; - params[param_count + 1] = Fplist_get (tmp, Qpurecopy); - if (!NILP (params[param_count + 1])) - param_count += 2; +/* Make a hash table from the constructor plist. */ +static Lisp_Object +hash_table_from_plist (Lisp_Object plist) +{ + Lisp_Object params[12]; + Lisp_Object *par = params; + + /* This is repetitive but fast and simple. */ +#define ADDPARAM(name) \ + do { \ + Lisp_Object val = plist_get (plist, Q ## name); \ + if (!NILP (val)) \ + { \ + *par++ = QC ## name; \ + *par++ = val; \ + } \ + } while (0) + + ADDPARAM (size); + ADDPARAM (test); + ADDPARAM (weakness); + ADDPARAM (rehash_size); + ADDPARAM (rehash_threshold); + ADDPARAM (purecopy); + + Lisp_Object data = plist_get (plist, Qdata); + + /* Now use params to make a new hash table and fill it. */ + Lisp_Object ht = Fmake_hash_table (par - params, params); + + Lisp_Object last = data; + FOR_EACH_TAIL_SAFE (data) + { + Lisp_Object key = XCAR (data); + data = XCDR (data); + if (!CONSP (data)) + break; + Lisp_Object val = XCAR (data); + last = XCDR (data); + Fputhash (key, val, ht); + } + if (!NILP (last)) + error ("Hash table data is not a list of even length"); - /* This is the hash table data. */ - data = Fplist_get (tmp, Qdata); + return ht; +} - /* Now use params to make a new hash table and fill it. */ - ht = Fmake_hash_table (param_count, params); +static Lisp_Object +record_from_list (Lisp_Object elems) +{ + ptrdiff_t size = list_length (elems); + Lisp_Object obj = Fmake_record (XCAR (elems), + make_fixnum (size - 1), + Qnil); + Lisp_Object tl = XCDR (elems); + for (int i = 1; i < size; i++) + { + ASET (obj, i, XCAR (tl)); + tl = XCDR (tl); + } + return obj; +} - Lisp_Object last = data; - FOR_EACH_TAIL_SAFE (data) - { - key = XCAR (data); - data = XCDR (data); - if (!CONSP (data)) - break; - val = XCAR (data); - last = XCDR (data); - Fputhash (key, val, ht); - } - if (!NILP (last)) - error ("Hash table data is not a list of even length"); +/* Turn a reversed list into a vector. */ +static Lisp_Object +vector_from_rev_list (Lisp_Object elems) +{ + ptrdiff_t size = list_length (elems); + Lisp_Object obj = make_nil_vector (size); + Lisp_Object *vec = XVECTOR (obj)->contents; + for (ptrdiff_t i = size - 1; i >= 0; i--) + { + vec[i] = XCAR (elems); + Lisp_Object next = XCDR (elems); + free_cons (XCONS (elems)); + elems = next; + } + return obj; +} - return ht; - } - UNREAD (c); - invalid_syntax ("#", readcharfun); - } - if (c == '^') - { - c = READCHAR; - if (c == '[') - { - Lisp_Object tmp; - tmp = read_vector (readcharfun, 0); - if (ASIZE (tmp) < CHAR_TABLE_STANDARD_SLOTS) - error ("Invalid size char-table"); - XSETPVECTYPE (XVECTOR (tmp), PVEC_CHAR_TABLE); - return tmp; - } - else if (c == '^') - { - c = READCHAR; - if (c == '[') - { - /* 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); - ptrdiff_t size = list_length (tmp); - int i, depth, min_char; - struct Lisp_Cons *cell; - - if (size == 0) - error ("Zero-sized sub char-table"); - - if (! RANGED_FIXNUMP (1, XCAR (tmp), 3)) - error ("Invalid depth in sub char-table"); - depth = XFIXNUM (XCAR (tmp)); - if (chartab_size[depth] != size - 2) - error ("Invalid size in sub char-table"); - cell = XCONS (tmp), tmp = XCDR (tmp), size--; - free_cons (cell); - - if (! RANGED_FIXNUMP (0, XCAR (tmp), MAX_CHAR)) - error ("Invalid minimum character in sub-char-table"); - min_char = XFIXNUM (XCAR (tmp)); - cell = XCONS (tmp), tmp = XCDR (tmp), size--; - free_cons (cell); - - tbl = make_uninit_sub_char_table (depth, min_char); - for (i = 0; i < size; i++) - { - XSUB_CHAR_TABLE (tbl)->contents[i] = XCAR (tmp); - cell = XCONS (tmp), tmp = XCDR (tmp); - free_cons (cell); - } - return tbl; - } - invalid_syntax ("#^^", readcharfun); - } - invalid_syntax ("#^", readcharfun); - } - if (c == '&') +static Lisp_Object +bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun) +{ + Lisp_Object obj = vector_from_rev_list (elems); + Lisp_Object *vec = XVECTOR (obj)->contents; + ptrdiff_t size = ASIZE (obj); + + if (!(size >= COMPILED_STACK_DEPTH + 1 && size <= COMPILED_INTERACTIVE + 1 + && (FIXNUMP (vec[COMPILED_ARGLIST]) + || CONSP (vec[COMPILED_ARGLIST]) + || NILP (vec[COMPILED_ARGLIST])) + && FIXNATP (vec[COMPILED_STACK_DEPTH]))) + invalid_syntax ("Invalid byte-code object", readcharfun); + + if (load_force_doc_strings + && NILP (vec[COMPILED_CONSTANTS]) + && STRINGP (vec[COMPILED_BYTECODE])) + { + /* Lazily-loaded bytecode is represented by the constant slot being nil + and the bytecode slot a (lazily loaded) string containing the + print representation of (BYTECODE . CONSTANTS). Unpack the + pieces by coerceing the string to unibyte and reading the result. */ + Lisp_Object enc = vec[COMPILED_BYTECODE]; + Lisp_Object pair = Fread (Fcons (enc, readcharfun)); + if (!CONSP (pair)) + invalid_syntax ("Invalid byte-code object", readcharfun); + + vec[COMPILED_BYTECODE] = XCAR (pair); + vec[COMPILED_CONSTANTS] = XCDR (pair); + } + + if (!((STRINGP (vec[COMPILED_BYTECODE]) + && VECTORP (vec[COMPILED_CONSTANTS])) + || CONSP (vec[COMPILED_BYTECODE]))) + invalid_syntax ("Invalid byte-code object", readcharfun); + + if (STRINGP (vec[COMPILED_BYTECODE])) + { + if (STRING_MULTIBYTE (vec[COMPILED_BYTECODE])) { - Lisp_Object length; - length = read1 (readcharfun, pch, first_in_list); - c = READCHAR; - if (c == '"') - { - Lisp_Object tmp, val; - EMACS_INT size_in_chars = bool_vector_bytes (XFIXNAT (length)); - unsigned char *data; - - UNREAD (c); - tmp = read1 (readcharfun, pch, first_in_list); - if (STRING_MULTIBYTE (tmp) - || (size_in_chars != SCHARS (tmp) - /* We used to print 1 char too many - when the number of bits was a multiple of 8. - Accept such input in case it came from an old - version. */ - && ! (XFIXNAT (length) - == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR))) - invalid_syntax ("#&...", readcharfun); - - val = make_uninit_bool_vector (XFIXNAT (length)); - data = bool_vector_uchar_data (val); - memcpy (data, SDATA (tmp), size_in_chars); - /* Clear the extraneous bits in the last byte. */ - if (XFIXNUM (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR) - data[size_in_chars - 1] - &= (1 << (XFIXNUM (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1; - return val; - } - invalid_syntax ("#&...", readcharfun); + /* 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. */ + vec[COMPILED_BYTECODE] = Fstring_as_unibyte (vec[COMPILED_BYTECODE]); } - if (c == '[') - { - /* Accept compiled functions at read-time so that we don't have to - build them using function calls. */ - Lisp_Object tmp; - struct Lisp_Vector *vec; - tmp = read_vector (readcharfun, 1); - vec = XVECTOR (tmp); - if (! (COMPILED_STACK_DEPTH < ASIZE (tmp) - && (FIXNUMP (AREF (tmp, COMPILED_ARGLIST)) - || CONSP (AREF (tmp, COMPILED_ARGLIST)) - || NILP (AREF (tmp, COMPILED_ARGLIST))) - && ((STRINGP (AREF (tmp, COMPILED_BYTECODE)) - && VECTORP (AREF (tmp, COMPILED_CONSTANTS))) - || CONSP (AREF (tmp, COMPILED_BYTECODE))) - && 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))); - } + // Bytecode must be immovable. + pin_string (vec[COMPILED_BYTECODE]); + } - if (COMPILED_DOC_STRING < ASIZE (tmp) - && EQ (AREF (tmp, COMPILED_DOC_STRING), make_fixnum (0))) - { - /* read_list found a docstring like '(#$ . 5521)' and treated it - as 0. This placeholder 0 would lead to accidental sharing in - purecopy's hash-consing, so replace it with a (hopefully) - unique integer placeholder, which is negative so that it is - not confused with a DOC file offset (the USE_LSB_TAG shift - relies on the fact that VALMASK is one bit narrower than - INTMASK). Eventually Snarf-documentation should replace the - placeholder with the actual docstring. */ - verify (INTMASK & ~VALMASK); - EMACS_UINT hash = ((XHASH (tmp) >> USE_LSB_TAG) - | (INTMASK - INTMASK / 2)); - ASET (tmp, COMPILED_DOC_STRING, make_ufixnum (hash)); - } + XSETPVECTYPE (XVECTOR (obj), PVEC_COMPILED); + return obj; +} - XSETPVECTYPE (vec, PVEC_COMPILED); - return tmp; - } - if (c == '(') - { - Lisp_Object tmp; - int ch; - - /* Read the string itself. */ - tmp = read1 (readcharfun, &ch, 0); - if (ch != 0 || !STRINGP (tmp)) - invalid_syntax ("#", readcharfun); - /* Read the intervals and their properties. */ - while (1) - { - Lisp_Object beg, end, plist; +static Lisp_Object +char_table_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun) +{ + Lisp_Object obj = vector_from_rev_list (elems); + if (ASIZE (obj) < CHAR_TABLE_STANDARD_SLOTS) + invalid_syntax ("Invalid size char-table", readcharfun); + XSETPVECTYPE (XVECTOR (obj), PVEC_CHAR_TABLE); + return obj; - beg = read1 (readcharfun, &ch, 0); - end = plist = Qnil; - if (ch == ')') - break; - if (ch == 0) - end = read1 (readcharfun, &ch, 0); - if (ch == 0) - plist = read1 (readcharfun, &ch, 0); - if (ch) - invalid_syntax ("Invalid string property list", readcharfun); - Fset_text_properties (beg, end, plist, tmp); - } +} - return tmp; - } +static Lisp_Object +sub_char_table_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun) +{ + /* A sub-char-table can't be read as a regular vector because of two + C integer fields. */ + elems = Fnreverse (elems); + ptrdiff_t size = list_length (elems); + if (size < 2) + error ("Invalid size of sub-char-table"); + + if (!RANGED_FIXNUMP (1, XCAR (elems), 3)) + error ("Invalid depth in sub-char-table"); + int depth = XFIXNUM (XCAR (elems)); + + if (chartab_size[depth] != size - 2) + error ("Invalid size in sub-char-table"); + elems = XCDR (elems); + + if (!RANGED_FIXNUMP (0, XCAR (elems), MAX_CHAR)) + error ("Invalid minimum character in sub-char-table"); + int min_char = XFIXNUM (XCAR (elems)); + elems = XCDR (elems); + + Lisp_Object tbl = make_uninit_sub_char_table (depth, min_char); + for (int i = 0; i < size - 2; i++) + { + XSUB_CHAR_TABLE (tbl)->contents[i] = XCAR (elems); + elems = XCDR (elems); + } + return tbl; +} - /* #@NUMBER is used to skip NUMBER following bytes. - That's used in .elc files to skip over doc strings - and function definitions. */ - if (c == '@') +static Lisp_Object +string_props_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun) +{ + elems = Fnreverse (elems); + if (NILP (elems) || !STRINGP (XCAR (elems))) + invalid_syntax ("#", readcharfun); + Lisp_Object obj = XCAR (elems); + for (Lisp_Object tl = XCDR (elems); !NILP (tl);) + { + Lisp_Object beg = XCAR (tl); + tl = XCDR (tl); + if (NILP (tl)) + invalid_syntax ("Invalid string property list", readcharfun); + Lisp_Object end = XCAR (tl); + tl = XCDR (tl); + if (NILP (tl)) + invalid_syntax ("Invalid string property list", readcharfun); + Lisp_Object plist = XCAR (tl); + tl = XCDR (tl); + Fset_text_properties (beg, end, plist, obj); + } + return obj; +} + +/* Read a bool vector (preceded by "#&"). */ +static Lisp_Object +read_bool_vector (char stackbuf[VLA_ELEMS (stackbufsize)], + Lisp_Object readcharfun) +{ + ptrdiff_t length = 0; + for (;;) + { + int c = READCHAR; + if (c < '0' || c > '9') { - enum { extra = 100 }; - ptrdiff_t i, nskip = 0, digits = 0; + if (c != '"') + invalid_syntax ("#&", readcharfun); + break; + } + if (INT_MULTIPLY_WRAPV (length, 10, &length) + | INT_ADD_WRAPV (length, c - '0', &length)) + invalid_syntax ("#&", readcharfun); + } - /* Read a decimal integer. */ - while ((c = READCHAR) >= 0 - && c >= '0' && c <= '9') - { - if ((STRING_BYTES_BOUND - extra) / 10 <= nskip) - string_overflow (); - digits++; - nskip *= 10; - nskip += c - '0'; - if (digits == 2 && nskip == 0) - { /* We've just seen #@00, which means "skip to end". */ - skip_dyn_eof (readcharfun); - return Qnil; - } - } + ptrdiff_t size_in_chars = bool_vector_bytes (length); + Lisp_Object str = read_string_literal (stackbuf, readcharfun); + if (STRING_MULTIBYTE (str) + || !(size_in_chars == SCHARS (str) + /* We used to print 1 char too many when the number of bits + was a multiple of 8. Accept such input in case it came + from an old version. */ + || length == (SCHARS (str) - 1) * BOOL_VECTOR_BITS_PER_CHAR)) + invalid_syntax ("#&...", readcharfun); + + Lisp_Object obj = make_uninit_bool_vector (length); + unsigned char *data = bool_vector_uchar_data (obj); + memcpy (data, SDATA (str), size_in_chars); + /* Clear the extraneous bits in the last byte. */ + if (length != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR) + data[size_in_chars - 1] &= (1 << (length % BOOL_VECTOR_BITS_PER_CHAR)) - 1; + return obj; +} + +/* Skip (and optionally remember) a lazily-loaded string + preceded by "#@". */ +static void +skip_lazy_string (Lisp_Object readcharfun) +{ + ptrdiff_t nskip = 0; + ptrdiff_t digits = 0; + for (;;) + { + int c = READCHAR; + if (c < '0' || c > '9') + { if (nskip > 0) /* We can't use UNREAD here, because in the code below we side-step - READCHAR. Instead, assume the first char after #@NNN occupies - a single byte, which is the case normally since it's just - a space. */ + READCHAR. Instead, assume the first char after #@NNN occupies + a single byte, which is the case normally since it's just + a space. */ nskip--; else UNREAD (c); - - if (load_force_doc_strings - && (FROM_FILE_P (readcharfun))) - { - /* If we are supposed to force doc strings into core right now, - record the last string that we skipped, - and record where in the file it comes from. */ - - /* But first exchange saved_doc_string - with prev_saved_doc_string, so we save two strings. */ - { - char *temp = saved_doc_string; - ptrdiff_t temp_size = saved_doc_string_size; - file_offset temp_pos = saved_doc_string_position; - ptrdiff_t temp_len = saved_doc_string_length; - - saved_doc_string = prev_saved_doc_string; - saved_doc_string_size = prev_saved_doc_string_size; - saved_doc_string_position = prev_saved_doc_string_position; - saved_doc_string_length = prev_saved_doc_string_length; - - prev_saved_doc_string = temp; - prev_saved_doc_string_size = temp_size; - prev_saved_doc_string_position = temp_pos; - prev_saved_doc_string_length = temp_len; - } - - if (saved_doc_string_size == 0) - { - saved_doc_string = xmalloc (nskip + extra); - saved_doc_string_size = nskip + extra; - } - if (nskip > saved_doc_string_size) - { - saved_doc_string = xrealloc (saved_doc_string, nskip + extra); - saved_doc_string_size = nskip + extra; - } - - FILE *instream = infile->stream; - saved_doc_string_position = (file_tell (instream) - - infile->lookahead); - - /* Copy that many bytes into saved_doc_string. */ - i = 0; - for (int n = min (nskip, infile->lookahead); 0 < n; n--) - saved_doc_string[i++] - = c = infile->buf[--infile->lookahead]; - block_input (); - for (; i < nskip && 0 <= c; i++) - saved_doc_string[i] = c = getc (instream); - unblock_input (); - - saved_doc_string_length = i; - } - else - /* Skip that many bytes. */ - skip_dyn_bytes (readcharfun, nskip); - - goto retry; + break; } - if (c == '!') + if (INT_MULTIPLY_WRAPV (nskip, 10, &nskip) + | INT_ADD_WRAPV (nskip, c - '0', &nskip)) + invalid_syntax ("#@", readcharfun); + digits++; + if (digits == 2 && nskip == 0) { - /* #! appears at the beginning of an executable file. - Skip the first line. */ - while (c != '\n' && c >= 0) - c = READCHAR; - goto retry; + /* #@00 means "skip to end" */ + skip_dyn_eof (readcharfun); + return; } - if (c == '$') - return Vload_file_name; - if (c == '\'') - return list2 (Qfunction, read0 (readcharfun)); - /* #:foo is the uninterned symbol named foo. */ - if (c == ':') + } + + if (load_force_doc_strings && FROM_FILE_P (readcharfun)) + { + /* If we are supposed to force doc strings into core right now, + record the last string that we skipped, + and record where in the file it comes from. */ + + /* But first exchange saved_doc_string + with prev_saved_doc_string, so we save two strings. */ + { + char *temp = saved_doc_string; + ptrdiff_t temp_size = saved_doc_string_size; + file_offset temp_pos = saved_doc_string_position; + ptrdiff_t temp_len = saved_doc_string_length; + + saved_doc_string = prev_saved_doc_string; + saved_doc_string_size = prev_saved_doc_string_size; + saved_doc_string_position = prev_saved_doc_string_position; + saved_doc_string_length = prev_saved_doc_string_length; + + prev_saved_doc_string = temp; + prev_saved_doc_string_size = temp_size; + prev_saved_doc_string_position = temp_pos; + prev_saved_doc_string_length = temp_len; + } + + enum { extra = 100 }; + if (saved_doc_string_size == 0) { - uninterned_symbol = true; - read_hash_prefixed_symbol: - c = READCHAR; - if (!(c > 040 - && c != NO_BREAK_SPACE - && (c >= 0200 - || strchr ("\"';()[]#`,", c) == NULL))) - { - /* No symbol character follows, this is the empty - symbol. */ - UNREAD (c); - return Fmake_symbol (empty_unibyte_string); - } - goto read_symbol; + saved_doc_string = xmalloc (nskip + extra); + saved_doc_string_size = nskip + extra; } - /* #_foo is really the symbol foo, regardless of shorthands */ - if (c == '_') + if (nskip > saved_doc_string_size) { - skip_shorthand = true; - goto read_hash_prefixed_symbol; + saved_doc_string = xrealloc (saved_doc_string, nskip + extra); + saved_doc_string_size = nskip + extra; } - /* ## is the empty symbol. */ - if (c == '#') - return Fintern (empty_unibyte_string, Qnil); - if (c >= '0' && c <= '9') - { - EMACS_INT n = c - '0'; - bool overflow = false; + FILE *instream = infile->stream; + saved_doc_string_position = (file_tell (instream) - infile->lookahead); - /* Read a non-negative integer. */ - while ('0' <= (c = READCHAR) && c <= '9') - { - overflow |= INT_MULTIPLY_WRAPV (n, 10, &n); - overflow |= INT_ADD_WRAPV (n, c - '0', &n); - } + /* Copy that many bytes into saved_doc_string. */ + ptrdiff_t i = 0; + int c = 0; + for (int n = min (nskip, infile->lookahead); n > 0; n--) + saved_doc_string[i++] = c = infile->buf[--infile->lookahead]; + block_input (); + for (; i < nskip && c >= 0; i++) + saved_doc_string[i] = c = getc (instream); + unblock_input (); - if (!overflow) - { - if (c == 'r' || c == 'R') - { - if (! (2 <= n && n <= 36)) - invalid_radix_integer (n, stackbuf, readcharfun); - return read_integer (readcharfun, n, stackbuf); - } + saved_doc_string_length = i; + } + else + /* Skip that many bytes. */ + skip_dyn_bytes (readcharfun, nskip); +} - if (n <= MOST_POSITIVE_FIXNUM && ! NILP (Vread_circle)) - { - /* Reader forms that can reuse previously read objects. */ - /* #n=object returns object, but associates it with - n for #n#. */ - if (c == '=') - { - /* Make a placeholder for #n# to use temporarily. */ - /* Note: We used to use AUTO_CONS to allocate - placeholder, but that is a bad idea, since it - will place a stack-allocated cons cell into - the list in read_objects_map, which is a - staticpro'd global variable, and thus each of - its elements is marked during each GC. A - stack-allocated object will become garbled - when its stack slot goes out of scope, and - some other function reuses it for entirely - different purposes, which will cause crashes - in GC. */ - Lisp_Object placeholder = Fcons (Qnil, Qnil); - struct Lisp_Hash_Table *h - = XHASH_TABLE (read_objects_map); - Lisp_Object number = make_fixnum (n), hash; - - ptrdiff_t i = hash_lookup (h, number, &hash); - if (i >= 0) - /* Not normal, but input could be malformed. */ - set_hash_value_slot (h, i, placeholder); - else - hash_put (h, number, placeholder, hash); - - /* Read the object itself. */ - Lisp_Object tem = read0 (readcharfun); - - /* If it can be recursive, remember it for - future substitutions. */ - if (! SYMBOLP (tem) - && ! NUMBERP (tem) - && ! (STRINGP (tem) && !string_intervals (tem))) - { - struct Lisp_Hash_Table *h2 - = XHASH_TABLE (read_objects_completed); - i = hash_lookup (h2, tem, &hash); - eassert (i < 0); - hash_put (h2, tem, Qnil, hash); - } - - /* 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); - - /* ...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; - } - } +/* Length of prefix only consisting of symbol constituent characters. */ +static ptrdiff_t +symbol_char_span (const char *s) +{ + const char *p = s; + while ( *p == '^' || *p == '*' || *p == '+' || *p == '-' || *p == '/' + || *p == '<' || *p == '=' || *p == '>' || *p == '_' || *p == '|') + p++; + return p - s; +} - /* #n# returns a previously read object. */ - if (c == '#') - { - struct Lisp_Hash_Table *h - = XHASH_TABLE (read_objects_map); - ptrdiff_t i = hash_lookup (h, make_fixnum (n), NULL); - if (i >= 0) - return HASH_VALUE (h, i); - } - } - } - /* Fall through to error message. */ +static void +skip_space_and_comments (Lisp_Object readcharfun) +{ + int c; + do + { + c = READCHAR; + if (c == ';') + do + c = READCHAR; + while (c >= 0 && c != '\n'); + if (c < 0) + end_of_file_error (); + } + while (c <= 32 || c == NO_BREAK_SPACE); + UNREAD (c); +} + +/* When an object is read, the type of the top read stack entry indicates + the syntactic context. */ +enum read_entry_type +{ + /* preceding syntactic context */ + RE_list_start, /* "(" */ + + RE_list, /* "(" (+ OBJECT) */ + RE_list_dot, /* "(" (+ OBJECT) "." */ + + RE_vector, /* "[" (* OBJECT) */ + RE_record, /* "#s(" (* OBJECT) */ + RE_char_table, /* "#^[" (* OBJECT) */ + RE_sub_char_table, /* "#^^[" (* OBJECT) */ + RE_byte_code, /* "#[" (* OBJECT) */ + RE_string_props, /* "#(" (* OBJECT) */ + + RE_special, /* "'" | "#'" | "`" | "," | ",@" */ + + RE_numbered, /* "#" (+ DIGIT) "=" */ +}; + +struct read_stack_entry +{ + enum read_entry_type type; + union { + /* RE_list, RE_list_dot */ + struct { + Lisp_Object head; /* first cons of list */ + Lisp_Object tail; /* last cons of list */ + } list; + + /* RE_vector, RE_record, RE_char_table, RE_sub_char_table, + RE_byte_code, RE_string_props */ + struct { + Lisp_Object elems; /* list of elements in reverse order */ + bool old_locate_syms; /* old value of locate_syms */ + } vector; + + /* RE_special */ + struct { + Lisp_Object symbol; /* symbol from special syntax */ + } special; + + /* RE_numbered */ + struct { + Lisp_Object number; /* number as a fixnum */ + Lisp_Object placeholder; /* placeholder object */ + } numbered; + } u; +}; + +struct read_stack +{ + struct read_stack_entry *stack; /* base of stack */ + ptrdiff_t size; /* allocated size in entries */ + ptrdiff_t sp; /* current number of entries */ +}; + +static struct read_stack rdstack = {NULL, 0, 0}; + +void +mark_lread (void) +{ + /* Mark the read stack, which may contain data not otherwise traced */ + for (ptrdiff_t i = 0; i < rdstack.sp; i++) + { + struct read_stack_entry *e = &rdstack.stack[i]; + switch (e->type) + { + case RE_list_start: + break; + case RE_list: + case RE_list_dot: + mark_object (e->u.list.head); + mark_object (e->u.list.tail); + break; + case RE_vector: + case RE_record: + case RE_char_table: + case RE_sub_char_table: + case RE_byte_code: + case RE_string_props: + mark_object (e->u.vector.elems); + break; + case RE_special: + mark_object (e->u.special.symbol); + break; + case RE_numbered: + mark_object (e->u.numbered.number); + mark_object (e->u.numbered.placeholder); + break; } - else if (c == 'x' || c == 'X') - return read_integer (readcharfun, 16, stackbuf); - else if (c == 'o' || c == 'O') - return read_integer (readcharfun, 8, stackbuf); - else if (c == 'b' || c == 'B') - return read_integer (readcharfun, 2, stackbuf); + } +} - UNREAD (c); - invalid_syntax ("#", readcharfun); +static inline struct read_stack_entry * +read_stack_top (void) +{ + eassume (rdstack.sp > 0); + return &rdstack.stack[rdstack.sp - 1]; +} - case ';': - while ((c = READCHAR) >= 0 && c != '\n'); - goto retry; +static inline struct read_stack_entry * +read_stack_pop (void) +{ + eassume (rdstack.sp > 0); + return &rdstack.stack[--rdstack.sp]; +} - case '\'': - return list2 (Qquote, read0 (readcharfun)); +static inline bool +read_stack_empty_p (ptrdiff_t base_sp) +{ + return rdstack.sp <= base_sp; +} - case '`': - return list2 (Qbackquote, read0 (readcharfun)); +NO_INLINE static void +grow_read_stack (void) +{ + struct read_stack *rs = &rdstack; + eassert (rs->sp == rs->size); + rs->stack = xpalloc (rs->stack, &rs->size, 1, -1, sizeof *rs->stack); + eassert (rs->sp < rs->size); +} - case ',': - { - Lisp_Object comma_type = Qnil; - Lisp_Object value; - int ch = READCHAR; +static inline void +read_stack_push (struct read_stack_entry e) +{ + if (rdstack.sp >= rdstack.size) + grow_read_stack (); + rdstack.stack[rdstack.sp++] = e; +} - if (ch == '@') - comma_type = Qcomma_at; - else - { - if (ch >= 0) UNREAD (ch); - comma_type = Qcomma; - } - value = read0 (readcharfun); - return list2 (comma_type, value); - } - case '?': - { - int modifiers; - int next_char; - bool ok; +/* Read a Lisp object. + If LOCATE_SYMS is true, symbols are read with position. */ +static Lisp_Object +read0 (Lisp_Object readcharfun, bool locate_syms) +{ + char stackbuf[stackbufsize]; + char *read_buffer = stackbuf; + ptrdiff_t read_buffer_size = sizeof stackbuf; + char *heapbuf = NULL; + specpdl_ref count = SPECPDL_INDEX (); - c = READCHAR; - if (c < 0) - end_of_file_error (); - - /* Accept `single space' syntax like (list ? x) where the - whitespace character is SPC or TAB. - Other literal whitespace like NL, CR, and FF are not accepted, - as there are well-established escape sequences for these. */ - if (c == ' ' || c == '\t') - return make_fixnum (c); - - if (c == '(' || c == ')' || c == '[' || c == ']' - || c == '"' || c == ';') + ptrdiff_t base_sp = rdstack.sp; + + bool uninterned_symbol; + bool skip_shorthand; + + /* Read an object into `obj'. */ + read_obj: ; + Lisp_Object obj; + bool multibyte; + int c = READCHAR_REPORT_MULTIBYTE (&multibyte); + if (c < 0) + end_of_file_error (); + + switch (c) + { + case '(': + read_stack_push ((struct read_stack_entry) {.type = RE_list_start}); + goto read_obj; + + case ')': + if (read_stack_empty_p (base_sp)) + invalid_syntax (")", readcharfun); + switch (read_stack_top ()->type) + { + case RE_list_start: + read_stack_pop (); + obj = Qnil; + break; + case RE_list: + obj = read_stack_pop ()->u.list.head; + break; + case RE_record: { - CHECK_LIST (Vlread_unescaped_character_literals); - Lisp_Object char_obj = make_fixed_natnum (c); - if (NILP (Fmemq (char_obj, Vlread_unescaped_character_literals))) - Vlread_unescaped_character_literals = - Fcons (char_obj, Vlread_unescaped_character_literals); + locate_syms = read_stack_top ()->u.vector.old_locate_syms; + Lisp_Object elems = Fnreverse (read_stack_pop ()->u.vector.elems); + if (NILP (elems)) + invalid_syntax ("#s", readcharfun); + + if (BASE_EQ (XCAR (elems), Qhash_table)) + obj = hash_table_from_plist (XCDR (elems)); + else + obj = record_from_list (elems); + break; } + case RE_string_props: + locate_syms = read_stack_top ()->u.vector.old_locate_syms; + obj = string_props_from_rev_list (read_stack_pop () ->u.vector.elems, + readcharfun); + break; + default: + invalid_syntax (")", readcharfun); + } + break; - if (c == '\\') - c = read_escape (readcharfun, 0); - modifiers = c & CHAR_MODIFIER_MASK; - c &= ~CHAR_MODIFIER_MASK; - if (CHAR_BYTE8_P (c)) - c = CHAR_TO_BYTE8 (c); - c |= modifiers; - - next_char = READCHAR; - ok = (next_char <= 040 - || (next_char < 0200 - && strchr ("\"';()[]#?`,.", next_char) != NULL)); - UNREAD (next_char); - if (ok) - return make_fixnum (c); - - invalid_syntax ("?", readcharfun); - } + case '[': + read_stack_push ((struct read_stack_entry) { + .type = RE_vector, + .u.vector.elems = Qnil, + .u.vector.old_locate_syms = locate_syms, + }); + /* FIXME: should vectors be read with locate_syms=false? */ + goto read_obj; - case '"': + case ']': + if (read_stack_empty_p (base_sp)) + invalid_syntax ("]", readcharfun); + switch (read_stack_top ()->type) + { + case RE_vector: + locate_syms = read_stack_top ()->u.vector.old_locate_syms; + obj = vector_from_rev_list (read_stack_pop ()->u.vector.elems); + break; + case RE_byte_code: + locate_syms = read_stack_top ()->u.vector.old_locate_syms; + obj = bytecode_from_rev_list (read_stack_pop ()->u.vector.elems, + readcharfun); + break; + case RE_char_table: + locate_syms = read_stack_top ()->u.vector.old_locate_syms; + obj = char_table_from_rev_list (read_stack_pop ()->u.vector.elems, + readcharfun); + break; + case RE_sub_char_table: + locate_syms = read_stack_top ()->u.vector.old_locate_syms; + obj = sub_char_table_from_rev_list (read_stack_pop ()->u.vector.elems, + readcharfun); + break; + default: + invalid_syntax ("]", readcharfun); + break; + } + break; + + case '#': { - ptrdiff_t 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; - int ch; - /* True if we saw an escape sequence specifying - a multibyte character. */ - bool force_multibyte = false; - /* True if we saw an escape sequence specifying - a single-byte character. */ - bool force_singlebyte = false; - bool cancel = false; - ptrdiff_t nchars = 0; - - while ((ch = READCHAR) >= 0 - && ch != '\"') + int ch = READCHAR; + switch (ch) { - if (end - p < MAX_MULTIBYTE_LENGTH) + case '\'': + /* #'X -- special syntax for (function X) */ + read_stack_push ((struct read_stack_entry) { + .type = RE_special, + .u.special.symbol = Qfunction, + }); + goto read_obj; + + case '#': + /* ## -- the empty symbol */ + obj = Fintern (empty_unibyte_string, Qnil); + break; + + case 's': + /* #s(...) -- a record or hash-table */ + ch = READCHAR; + if (ch != '(') { - ptrdiff_t offset = p - read_buffer; - read_buffer = grow_read_buffer (read_buffer, offset, - &heapbuf, &read_buffer_size, - count); - p = read_buffer + offset; - end = read_buffer + read_buffer_size; + UNREAD (ch); + invalid_syntax ("#s", readcharfun); + } + read_stack_push ((struct read_stack_entry) { + .type = RE_record, + .u.vector.elems = Qnil, + .u.vector.old_locate_syms = locate_syms, + }); + locate_syms = false; + goto read_obj; + + case '^': + /* #^[...] -- char-table + #^^[...] -- sub-char-table */ + ch = READCHAR; + if (ch == '^') + { + ch = READCHAR; + if (ch == '[') + { + read_stack_push ((struct read_stack_entry) { + .type = RE_sub_char_table, + .u.vector.elems = Qnil, + .u.vector.old_locate_syms = locate_syms, + }); + locate_syms = false; + goto read_obj; + } + else + { + UNREAD (ch); + invalid_syntax ("#^^", readcharfun); + } + } + else if (ch == '[') + { + read_stack_push ((struct read_stack_entry) { + .type = RE_char_table, + .u.vector.elems = Qnil, + .u.vector.old_locate_syms = locate_syms, + }); + locate_syms = false; + goto read_obj; + } + else + { + UNREAD (ch); + invalid_syntax ("#^", readcharfun); } - if (ch == '\\') + case '(': + /* #(...) -- string with properties */ + read_stack_push ((struct read_stack_entry) { + .type = RE_string_props, + .u.vector.elems = Qnil, + .u.vector.old_locate_syms = locate_syms, + }); + locate_syms = false; + goto read_obj; + + case '[': + /* #[...] -- byte-code */ + read_stack_push ((struct read_stack_entry) { + .type = RE_byte_code, + .u.vector.elems = Qnil, + .u.vector.old_locate_syms = locate_syms, + }); + locate_syms = false; + goto read_obj; + + case '&': + /* #&N"..." -- bool-vector */ + obj = read_bool_vector (stackbuf, readcharfun); + break; + + case '!': + /* #! appears at the beginning of an executable file. + Skip the rest of the line. */ + { + int c; + do + c = READCHAR; + while (c >= 0 && c != '\n'); + goto read_obj; + } + + case 'x': + case 'X': + obj = read_integer (readcharfun, 16, stackbuf); + break; + + case 'o': + case 'O': + obj = read_integer (readcharfun, 8, stackbuf); + break; + + case 'b': + case 'B': + obj = read_integer (readcharfun, 2, stackbuf); + break; + + case '@': + /* #@NUMBER is used to skip NUMBER following bytes. + That's used in .elc files to skip over doc strings + and function definitions that can be loaded lazily. */ + skip_lazy_string (readcharfun); + goto read_obj; + + case '$': + /* #$ -- reference to lazy-loaded string */ + obj = Vload_file_name; + break; + + case ':': + /* #:X -- uninterned symbol */ + c = READCHAR; + if (c <= 32 || c == NO_BREAK_SPACE + || c == '"' || c == '\'' || c == ';' || c == '#' + || c == '(' || c == ')' || c == '[' || c == ']' + || c == '`' || c == ',') { - int modifiers; + /* No symbol character follows: this is the empty symbol. */ + UNREAD (c); + obj = Fmake_symbol (empty_unibyte_string); + break; + } + uninterned_symbol = true; + skip_shorthand = false; + goto read_symbol; - ch = read_escape (readcharfun, 1); + case '_': + /* #_X -- symbol without shorthand */ + c = READCHAR; + if (c <= 32 || c == NO_BREAK_SPACE + || c == '"' || c == '\'' || c == ';' || c == '#' + || c == '(' || c == ')' || c == '[' || c == ']' + || c == '`' || c == ',') + { + /* No symbol character follows: this is the empty symbol. */ + UNREAD (c); + obj = Fintern (empty_unibyte_string, Qnil); + break; + } + uninterned_symbol = false; + skip_shorthand = true; + goto read_symbol; - /* CH is -1 if \ newline or \ space has just been seen. */ - if (ch == -1) + default: + if (ch >= '0' && ch <= '9') + { + /* #N=OBJ or #N# -- first read the number N */ + EMACS_INT n = ch - '0'; + int c; + for (;;) { - if (p == read_buffer) - cancel = true; - continue; + c = READCHAR; + if (c < '0' || c > '9') + break; + if (INT_MULTIPLY_WRAPV (n, 10, &n) + || INT_ADD_WRAPV (n, c - '0', &n)) + invalid_syntax ("#", readcharfun); } - - modifiers = ch & CHAR_MODIFIER_MASK; - ch = ch & ~CHAR_MODIFIER_MASK; - - if (CHAR_BYTE8_P (ch)) - force_singlebyte = true; - else if (! ASCII_CHAR_P (ch)) - force_multibyte = true; - else /* I.e. ASCII_CHAR_P (ch). */ + if (c == 'r' || c == 'R') { - /* Allow `\C- ' and `\C-?'. */ - if (modifiers == CHAR_CTL) - { - if (ch == ' ') - ch = 0, modifiers = 0; - else if (ch == '?') - ch = 127, modifiers = 0; - } - if (modifiers & CHAR_SHIFT) + /* #NrDIGITS -- radix-N number */ + if (n < 0 || n > 36) + invalid_radix_integer (n, stackbuf, readcharfun); + obj = read_integer (readcharfun, n, stackbuf); + break; + } + else if (n <= MOST_POSITIVE_FIXNUM && !NILP (Vread_circle)) + { + if (c == '=') { - /* Shift modifier is valid only with [A-Za-z]. */ - if (ch >= 'A' && ch <= 'Z') - modifiers &= ~CHAR_SHIFT; - else if (ch >= 'a' && ch <= 'z') - ch -= ('a' - 'A'), modifiers &= ~CHAR_SHIFT; + /* #N=OBJ -- assign number N to OBJ */ + Lisp_Object placeholder = Fcons (Qnil, Qnil); + + struct Lisp_Hash_Table *h + = XHASH_TABLE (read_objects_map); + Lisp_Object number = make_fixnum (n); + Lisp_Object hash; + ptrdiff_t i = hash_lookup (h, number, &hash); + if (i >= 0) + /* Not normal, but input could be malformed. */ + set_hash_value_slot (h, i, placeholder); + else + hash_put (h, number, placeholder, hash); + read_stack_push ((struct read_stack_entry) { + .type = RE_numbered, + .u.numbered.number = number, + .u.numbered.placeholder = placeholder, + }); + goto read_obj; } - - if (modifiers & CHAR_META) + else if (c == '#') { - /* Move the meta bit to the right place for a - string. */ - modifiers &= ~CHAR_META; - ch = BYTE8_TO_CHAR (ch | 0x80); - force_singlebyte = true; + /* #N# -- reference to numbered object */ + struct Lisp_Hash_Table *h + = XHASH_TABLE (read_objects_map); + ptrdiff_t i = hash_lookup (h, make_fixnum (n), NULL); + if (i < 0) + invalid_syntax ("#", readcharfun); + obj = HASH_VALUE (h, i); + break; } + else + invalid_syntax ("#", readcharfun); } - - /* Any modifiers remaining are invalid. */ - if (modifiers) - invalid_syntax ("Invalid modifier in string", readcharfun); - p += CHAR_STRING (ch, (unsigned char *) p); + else + invalid_syntax ("#", readcharfun); } else - { - p += CHAR_STRING (ch, (unsigned char *) p); - if (CHAR_BYTE8_P (ch)) - force_singlebyte = true; - else if (! ASCII_CHAR_P (ch)) - force_multibyte = true; - } - nchars++; + invalid_syntax ("#", readcharfun); } + break; + } + + case '?': + obj = read_char_literal (readcharfun); + break; - if (ch < 0) - end_of_file_error (); + case '"': + obj = read_string_literal (stackbuf, readcharfun); + break; + + case '\'': + read_stack_push ((struct read_stack_entry) { + .type = RE_special, + .u.special.symbol = Qquote, + }); + goto read_obj; - /* If purifying, and string starts with \ newline, - return zero instead. This is for doc strings - that we are really going to find in etc/DOC.nn.nn. */ - if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel) - return unbind_to (count, make_fixnum (0)); + case '`': + read_stack_push ((struct read_stack_entry) { + .type = RE_special, + .u.special.symbol = Qbackquote, + }); + goto read_obj; - if (! force_multibyte && force_singlebyte) + case ',': + { + int ch = READCHAR; + Lisp_Object sym; + if (ch == '@') + sym = Qcomma_at; + else { - /* READ_BUFFER contains raw 8-bit bytes and no multibyte - forms. Convert it to unibyte. */ - nchars = str_as_unibyte ((unsigned char *) read_buffer, - p - read_buffer); - p = read_buffer + nchars; + if (ch >= 0) + UNREAD (ch); + sym = Qcomma; } + read_stack_push ((struct read_stack_entry) { + .type = RE_special, + .u.special.symbol = sym, + }); + goto read_obj; + } - Lisp_Object result - = make_specified_string (read_buffer, nchars, p - read_buffer, - (force_multibyte - || (p - read_buffer != nchars))); - return unbind_to (count, result); + case ';': + { + int c; + do + c = READCHAR; + while (c >= 0 && c != '\n'); + goto read_obj; } case '.': { - int next_char = READCHAR; - UNREAD (next_char); - - if (next_char <= 040 - || (next_char < 0200 - && strchr ("\"';([#?`,", next_char) != NULL)) + int nch = READCHAR; + UNREAD (nch); + if (nch <= 32 || nch == NO_BREAK_SPACE + || nch == '"' || nch == '\'' || nch == ';' + || nch == '(' || nch == '[' || nch == '#' + || nch == '?' || nch == '`' || nch == ',') { - *pch = c; - return Qnil; + if (!read_stack_empty_p (base_sp) + && read_stack_top ()->type == RE_list) + { + read_stack_top ()->type = RE_list_dot; + goto read_obj; + } + invalid_syntax (".", readcharfun); } } - /* The atom-reading loop below will now loop at least once, - assuring that we will not try to UNREAD two characters in a - row. */ + /* may be a number or symbol starting with a dot */ FALLTHROUGH; + default: - if (c <= 040) goto retry; - if (c == NO_BREAK_SPACE) - goto retry; + if (c <= 32 || c == NO_BREAK_SPACE) + goto read_obj; + uninterned_symbol = false; + skip_shorthand = false; + /* symbol or number */ read_symbol: { - ptrdiff_t 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 { @@ -3755,7 +4116,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (c == '\\') { c = READCHAR; - if (c == -1) + if (c < 0) end_of_file_error (); quoted = true; } @@ -3766,94 +4127,205 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) *p++ = c; c = READCHAR; } - while (c > 040 + while (c > 32 && c != NO_BREAK_SPACE - && (c >= 0200 - || strchr ("\"';()[]#`,", c) == NULL)); + && (c >= 128 + || !( c == '"' || c == '\'' || c == ';' || c == '#' + || c == '(' || c == ')' || c == '[' || c == ']' + || c == '`' || c == ','))); *p = 0; ptrdiff_t nbytes = p - read_buffer; UNREAD (c); - if (!quoted && !uninterned_symbol && !skip_shorthand) + /* Only attempt to parse the token as a number if it starts as one. */ + char c0 = read_buffer[0]; + if (((c0 >= '0' && c0 <= '9') || c0 == '.' || c0 == '-' || c0 == '+') + && !quoted && !uninterned_symbol && !skip_shorthand) { ptrdiff_t len; Lisp_Object result = string_to_number (read_buffer, 10, &len); - if (! NILP (result) && len == nbytes) - return unbind_to (count, result); + if (!NILP (result) && len == nbytes) + { + obj = result; + break; + } } - { - Lisp_Object result; - ptrdiff_t nchars - = (multibyte - ? multibyte_chars_in_text ((unsigned char *) read_buffer, - nbytes) - : nbytes); - - if (uninterned_symbol) - { - Lisp_Object name - = ((! NILP (Vpurify_flag) - ? make_pure_string : make_specified_string) - (read_buffer, nchars, nbytes, multibyte)); - result = Fmake_symbol (name); - } - else - { - /* Don't create the string object for the name unless - we're going to retain it in a new symbol. - - Like intern_1 but supports multibyte names. */ - Lisp_Object obarray = check_obarray (Vobarray); - - char* longhand = NULL; - ptrdiff_t longhand_chars = 0; - ptrdiff_t longhand_bytes = 0; - - Lisp_Object tem; - if (skip_shorthand - /* The following ASCII characters are used in the - only "core" Emacs Lisp symbols that are comprised - entirely of characters that have the 'symbol - constituent' syntax. We exempt them from - transforming according to shorthands. */ - || strspn (read_buffer, "^*+-/<=>_|") >= nbytes) - tem = oblookup (obarray, read_buffer, nchars, nbytes); - else - tem = oblookup_considering_shorthand (obarray, read_buffer, + + /* symbol, possibly uninterned */ + ptrdiff_t nchars + = (multibyte + ? multibyte_chars_in_text ((unsigned char *)read_buffer, nbytes) + : nbytes); + Lisp_Object result; + if (uninterned_symbol) + { + Lisp_Object name + = (!NILP (Vpurify_flag) + ? make_pure_string (read_buffer, nchars, nbytes, multibyte) + : make_specified_string (read_buffer, nchars, nbytes, + multibyte)); + result = Fmake_symbol (name); + } + else + { + /* Don't create the string object for the name unless + we're going to retain it in a new symbol. + + Like intern_1 but supports multibyte names. */ + Lisp_Object obarray = check_obarray (Vobarray); + + char *longhand = NULL; + ptrdiff_t longhand_chars = 0; + ptrdiff_t longhand_bytes = 0; + + Lisp_Object found; + if (skip_shorthand + /* We exempt characters used in the "core" Emacs Lisp + symbols that are comprised entirely of characters + that have the 'symbol constituent' syntax from + transforming according to shorthands. */ + || symbol_char_span (read_buffer) >= nbytes) + found = oblookup (obarray, read_buffer, nchars, nbytes); + else + found = oblookup_considering_shorthand (obarray, read_buffer, nchars, nbytes, &longhand, &longhand_chars, &longhand_bytes); - if (SYMBOLP (tem)) - result = tem; - else if (longhand) - { - Lisp_Object name - = make_specified_string (longhand, longhand_chars, - longhand_bytes, multibyte); - xfree (longhand); - result = intern_driver (name, obarray, tem); - } - else - { - Lisp_Object name - = make_specified_string (read_buffer, nchars, nbytes, - multibyte); - result = intern_driver (name, obarray, tem); - } - } + if (SYMBOLP (found)) + result = found; + else if (longhand) + { + Lisp_Object name = make_specified_string (longhand, + longhand_chars, + longhand_bytes, + multibyte); + xfree (longhand); + result = intern_driver (name, obarray, found); + } + else + { + Lisp_Object name = make_specified_string (read_buffer, nchars, + nbytes, multibyte); + result = intern_driver (name, obarray, found); + } + } + 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); - } + obj = result; + break; } } + + /* We have read an object in `obj'. Use the stack to decide what to + do with it. */ + while (rdstack.sp > base_sp) + { + struct read_stack_entry *e = read_stack_top (); + switch (e->type) + { + case RE_list_start: + e->type = RE_list; + e->u.list.head = e->u.list.tail = Fcons (obj, Qnil); + goto read_obj; + + case RE_list: + { + Lisp_Object tl = Fcons (obj, Qnil); + XSETCDR (e->u.list.tail, tl); + e->u.list.tail = tl; + goto read_obj; + } + + case RE_list_dot: + { + skip_space_and_comments (readcharfun); + int ch = READCHAR; + if (ch != ')') + invalid_syntax ("expected )", readcharfun); + XSETCDR (e->u.list.tail, obj); + read_stack_pop (); + obj = e->u.list.head; + break; + } + + case RE_vector: + case RE_record: + case RE_char_table: + case RE_sub_char_table: + case RE_byte_code: + case RE_string_props: + e->u.vector.elems = Fcons (obj, e->u.vector.elems); + goto read_obj; + + case RE_special: + read_stack_pop (); + obj = list2 (e->u.special.symbol, obj); + break; + + case RE_numbered: + { + read_stack_pop (); + Lisp_Object placeholder = e->u.numbered.placeholder; + if (CONSP (obj)) + { + if (BASE_EQ (obj, 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 substitution below, + since the placeholder is already referenced + inside OBJ at the appropriate places. */ + Fsetcar (placeholder, XCAR (obj)); + Fsetcdr (placeholder, XCDR (obj)); + + struct Lisp_Hash_Table *h2 + = XHASH_TABLE (read_objects_completed); + Lisp_Object hash; + ptrdiff_t i = hash_lookup (h2, placeholder, &hash); + eassert (i < 0); + hash_put (h2, placeholder, Qnil, hash); + obj = placeholder; + } + else + { + /* If it can be recursive, remember it for future + substitutions. */ + if (!SYMBOLP (obj) && !NUMBERP (obj) + && !(STRINGP (obj) && !string_intervals (obj))) + { + struct Lisp_Hash_Table *h2 + = XHASH_TABLE (read_objects_completed); + Lisp_Object hash; + ptrdiff_t i = hash_lookup (h2, obj, &hash); + eassert (i < 0); + hash_put (h2, obj, Qnil, hash); + } + + /* Now put it everywhere the placeholder was... */ + Flread__substitute_object_in_subtree (obj, placeholder, + read_objects_completed); + + /* ...and #n# will use the real value from now on. */ + struct Lisp_Hash_Table *h = XHASH_TABLE (read_objects_map); + Lisp_Object hash; + ptrdiff_t i = hash_lookup (h, e->u.numbered.number, &hash); + eassert (i >= 0); + set_hash_value_slot (h, i, obj); + } + break; + } + } + } + + return unbind_to (count, obj); } + DEFUN ("lread--substitute-object-in-subtree", Flread__substitute_object_in_subtree, @@ -4100,232 +4572,6 @@ string_to_number (char const *string, int base, ptrdiff_t *plen) } -static Lisp_Object -read_vector (Lisp_Object readcharfun, bool bytecodeflag) -{ - Lisp_Object tem = read_list (1, readcharfun); - ptrdiff_t size = list_length (tem); - Lisp_Object vector = make_nil_vector (size); - - /* Avoid accessing past the end of a vector if the vector is too - small to be valid for bytecode. */ - bytecodeflag &= COMPILED_STACK_DEPTH < size; - - Lisp_Object *ptr = XVECTOR (vector)->contents; - for (ptrdiff_t i = 0; i < size; i++) - { - Lisp_Object item = Fcar (tem); - /* If `load-force-doc-strings' is t when reading a lazily-loaded - bytecode object, the docstring containing the bytecode and - constants values must be treated as unibyte and passed to - Fread, to get the actual bytecode string and constants vector. */ - if (bytecodeflag && load_force_doc_strings) - { - if (i == COMPILED_BYTECODE) - { - if (!STRINGP (item)) - error ("Invalid byte code"); - - /* Delay handling the bytecode slot until we know whether - it is lazily-loaded (we can tell by whether the - constants slot is nil). */ - ASET (vector, COMPILED_CONSTANTS, item); - item = Qnil; - } - else if (i == COMPILED_CONSTANTS) - { - Lisp_Object bytestr = ptr[COMPILED_CONSTANTS]; - - if (NILP (item)) - { - /* Coerce string to unibyte (like string-as-unibyte, - but without generating extra garbage and - guaranteeing no change in the contents). */ - STRING_SET_CHARS (bytestr, SBYTES (bytestr)); - STRING_SET_UNIBYTE (bytestr); - - item = Fread (Fcons (bytestr, readcharfun)); - if (!CONSP (item)) - error ("Invalid byte code"); - - struct Lisp_Cons *otem = XCONS (item); - bytestr = XCAR (item); - item = XCDR (item); - free_cons (otem); - } - - /* Now handle the bytecode slot. */ - ASET (vector, COMPILED_BYTECODE, bytestr); - } - else if (i == COMPILED_DOC_STRING - && STRINGP (item) - && ! STRING_MULTIBYTE (item)) - { - if (EQ (readcharfun, Qget_emacs_mule_file_char)) - item = Fdecode_coding_string (item, Qemacs_mule, Qnil, Qnil); - else - item = Fstring_as_multibyte (item); - } - } - ASET (vector, i, item); - struct Lisp_Cons *otem = XCONS (tem); - tem = Fcdr (tem); - free_cons (otem); - } - return vector; -} - -/* FLAG means check for ']' to terminate rather than ')' and '.'. */ - -static Lisp_Object -read_list (bool flag, Lisp_Object readcharfun) -{ - Lisp_Object val, tail; - Lisp_Object elt, tem; - /* 0 is the normal case. - 1 means this list is a doc reference; replace it with the number 0. - 2 means this list is a doc reference; replace it with the doc string. */ - int doc_reference = 0; - - /* Initialize this to 1 if we are reading a list. */ - bool first_in_list = flag <= 0; - - val = Qnil; - tail = Qnil; - - while (1) - { - int ch; - elt = read1 (readcharfun, &ch, first_in_list); - - 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)) - { - 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)); - } - } - else if (EQ (elt, Vload_file_name) - && ! NILP (elt) - && load_force_doc_strings) - doc_reference = 2; - - if (ch) - { - if (flag > 0) - { - if (ch == ']') - return val; - invalid_syntax (") or . in a vector", readcharfun); - } - if (ch == ')') - return val; - if (ch == '.') - { - if (!NILP (tail)) - XSETCDR (tail, read0 (readcharfun)); - else - val = read0 (readcharfun); - read1 (readcharfun, &ch, 0); - - if (ch == ')') - { - if (doc_reference == 1) - return make_fixnum (0); - if (doc_reference == 2 && FIXNUMP (XCDR (val))) - { - char *saved = NULL; - file_offset saved_position; - /* Get a doc string from the file we are loading. - If it's in saved_doc_string, get it from there. - - Here, we don't know if the string is a - bytecode string or a doc string. As a - bytecode string must be unibyte, we always - return a unibyte string. If it is actually a - doc string, caller must make it - multibyte. */ - - /* Position is negative for user variables. */ - EMACS_INT pos = eabs (XFIXNUM (XCDR (val))); - if (pos >= saved_doc_string_position - && pos < (saved_doc_string_position - + saved_doc_string_length)) - { - saved = saved_doc_string; - saved_position = saved_doc_string_position; - } - /* Look in prev_saved_doc_string the same way. */ - else if (pos >= prev_saved_doc_string_position - && pos < (prev_saved_doc_string_position - + prev_saved_doc_string_length)) - { - saved = prev_saved_doc_string; - saved_position = prev_saved_doc_string_position; - } - if (saved) - { - ptrdiff_t start = pos - saved_position; - ptrdiff_t from, to; - - /* Process quoting with ^A, - and find the end of the string, - which is marked with ^_ (037). */ - for (from = start, to = start; - saved[from] != 037;) - { - int c = saved[from++]; - if (c == 1) - { - c = saved[from++]; - saved[to++] = (c == 1 ? c - : c == '0' ? 0 - : c == '_' ? 037 - : c); - } - else - saved[to++] = c; - } - - return make_unibyte_string (saved + start, - to - start); - } - else - return get_doc_string (val, 1, 0); - } - - return val; - } - invalid_syntax (". in wrong context", readcharfun); - } - invalid_syntax ("] in a list", readcharfun); - } - tem = list1 (elt); - if (!NILP (tail)) - XSETCDR (tail, tem); - else - val = tem; - tail = tem; - } -} - static Lisp_Object initial_obarray; /* `oblookup' stores the bucket number here, for the sake of Funintern. */ @@ -4432,7 +4678,7 @@ define_symbol (Lisp_Object sym, char const *str) /* Qunbound is uninterned, so that it's not confused with any symbol 'unbound' created by a Lisp program. */ - if (! EQ (sym, Qunbound)) + if (! BASE_EQ (sym, Qunbound)) { Lisp_Object bucket = oblookup (initial_obarray, str, len, len); eassert (FIXNUMP (bucket)); @@ -4620,10 +4866,12 @@ oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff hash = hash_string (ptr, size_byte) % obsize; bucket = AREF (obarray, hash); oblookup_last_bucket_number = hash; - if (EQ (bucket, make_fixnum (0))) + if (BASE_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)) { @@ -4640,7 +4888,7 @@ oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff /* Like 'oblookup', but considers 'Vread_symbol_shorthands', potentially recognizing that IN is shorthand for some other - longhand name, which is then then placed in OUT. In that case, + longhand name, which is then placed in OUT. In that case, memory is malloc'ed for OUT (which the caller must free) while SIZE_OUT and SIZE_BYTE_OUT respectively hold the character and byte sizes of the transformed symbol name. If IN is not recognized @@ -5121,6 +5369,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 +5403,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 +5485,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 +5520,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 +5683,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..fe30908f5d6 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -57,8 +57,10 @@ static CFStringRef mac_font_create_preferred_family_for_attributes (CFDictionary static CFIndex mac_font_shape (CTFontRef, CFStringRef, struct mac_glyph_layout *, CFIndex, enum lgstring_direction); +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1090 static CFArrayRef mac_font_copy_default_descriptors_for_language (CFStringRef); static CFStringRef mac_font_copy_default_name_for_charset_and_languages (CFCharacterSetRef, CFArrayRef); +#endif #if USE_CT_GLYPH_INFO static CGGlyph mac_ctfont_get_glyph_for_cid (CTFontRef, CTCharacterCollection, CGFontIndex); @@ -598,9 +600,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 +615,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) @@ -830,7 +847,7 @@ macfont_store_descriptor_attributes (CTFontDescriptorRef desc, {{FONT_WEIGHT_INDEX, kCTFontWeightTrait, {{-0.4, 50}, /* light */ {-0.24, 87.5}, /* (semi-light + normal) / 2 */ - {0, 100}, /* normal */ + {0, 80}, /* normal */ {0.24, 140}, /* (semi-bold + normal) / 2 */ {0.4, 200}, /* bold */ {CGFLOAT_MAX, CGFLOAT_MAX}}, @@ -912,7 +929,7 @@ macfont_descriptor_entity (CTFontDescriptorRef desc, Lisp_Object extra, cfnumber_get_font_symbolic_traits_value (num, &sym_traits); CFRelease (dict); } - if (EQ (AREF (entity, FONT_SIZE_INDEX), make_fixnum (0))) + if (BASE_EQ (AREF (entity, FONT_SIZE_INDEX), make_fixnum (0))) ASET (entity, FONT_AVGWIDTH_INDEX, make_fixnum (0)); ASET (entity, FONT_EXTRA_INDEX, Fcopy_sequence (extra)); name = CTFontDescriptorCopyAttribute (desc, kCTFontNameAttribute); @@ -2636,7 +2653,7 @@ macfont_open (struct frame * f, Lisp_Object entity, int pixel_size) macfont_info->cgfont = CTFontCopyGraphicsFont (macfont, NULL); val = assq_no_quit (QCdestination, AREF (entity, FONT_EXTRA_INDEX)); - if (CONSP (val) && EQ (XCDR (val), make_fixnum (1))) + if (CONSP (val) && BASE_EQ (XCDR (val), make_fixnum (1))) macfont_info->screen_font = mac_screen_font_create_with_name (font_name, size); else @@ -2911,14 +2928,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 +2944,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 +2980,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,15 +3572,17 @@ mac_font_create_preferred_family_for_attributes (CFDictionaryRef attributes) if (languages && CFArrayGetCount (languages) > 0) { - if (CTGetCoreTextVersion () >= kCTVersionNumber10_9) - values[num_values++] = CFArrayGetValueAtIndex (languages, 0); - else +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1090 + if (CTGetCoreTextVersion () < kCTVersionNumber10_9) { CFCharacterSetRef charset = CFDictionaryGetValue (attributes, kCTFontCharacterSetAttribute); result = mac_font_copy_default_name_for_charset_and_languages (charset, languages); } + else +#endif + values[num_values++] = CFArrayGetValueAtIndex (languages, 0); } if (result == NULL) { @@ -3975,6 +4001,7 @@ mac_ctfont_get_glyph_for_cid (CTFontRef font, CTCharacterCollection collection, } #endif +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1090 static CFArrayRef mac_font_copy_default_descriptors_for_language (CFStringRef language) { @@ -4109,6 +4136,7 @@ mac_font_copy_default_name_for_charset_and_languages (CFCharacterSetRef charset, return result; } +#endif void * macfont_get_nsctfont (struct font *font) 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..eeb0c9a7e5b 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,15 +1113,15 @@ 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; Lisp_Object selection = Qnil; - struct frame *f = NULL; + struct frame *f; 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,13 +1252,26 @@ 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, + /* ??? Not really clean; should be Qwindow_or_framep but I don't want to make one now. */ - CHECK_WINDOW (window); + wrong_type_argument (Qwindowp, window); xpos += check_integer_range (x, (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM @@ -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 0fc7f2caa15..bedc5644807 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -34,6 +34,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "systty.h" #include "pdumper.h" +#ifdef HAVE_NTGUI +#include "w32term.h" +#endif + /* List of buffers for use as minibuffers. The first element of the list is used for the outermost minibuffer invocation, the next element is used for a recursive minibuffer @@ -41,7 +45,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. */ @@ -253,7 +257,7 @@ without invoking the usual minibuffer commands. */) static void read_minibuf_unwind (void); static void minibuffer_unwind (void); -static void run_exit_minibuf_hook (void); +static void run_exit_minibuf_hook (Lisp_Object minibuf); /* Read a Lisp object from VAL and return it. If VAL is an empty @@ -423,8 +427,8 @@ No argument or nil as argument means use the current buffer as BUFFER. */) { if (NILP (buffer)) buffer = Fcurrent_buffer (); - return EQ (buffer, (Fcar (Fnthcdr (make_fixnum (minibuf_level), - Vminibuffer_list)))) + return BASE_EQ (buffer, (Fcar (Fnthcdr (make_fixnum (minibuf_level), + Vminibuffer_list)))) ? Qt : Qnil; } @@ -570,7 +574,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; @@ -737,7 +741,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, separately from read_minibuf_unwind because we need to make sure that read_minibuf_unwind is fully executed even if exit-minibuffer-hook signals an error. --Stef */ - record_unwind_protect_void (run_exit_minibuf_hook); + record_unwind_protect (run_exit_minibuf_hook, minibuffer); /* Now that we can restore all those variables, start changing them. */ @@ -756,7 +760,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, /* If variable is unbound, make it nil. */ histval = find_symbol_value (histvar); - if (EQ (histval, Qunbound)) + if (BASE_EQ (histval, Qunbound)) { Fset (histvar, Qnil); histval = Qnil; @@ -825,7 +829,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 (); @@ -908,7 +912,17 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, XWINDOW (minibuf_window)->cursor.x = 0; XWINDOW (minibuf_window)->must_be_updated_p = true; update_frame (XFRAME (selected_frame), true, true); +#ifndef HAVE_NTGUI flush_frame (XFRAME (XWINDOW (minibuf_window)->frame)); +#else + /* The reason this function isn't `flush_display' in the RIF is + that `flush_frame' is also called in many other circumstances + when some code wants X requests to be sent to the X server, + but there is no corresponding "flush" concept on MS Windows, + and flipping buffers every time `flush_frame' is called + causes flicker. */ + w32_flip_buffers_if_dirty (XFRAME (XWINDOW (minibuf_window)->frame)); +#endif } /* Make minibuffer contents into a string. */ @@ -983,7 +997,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); @@ -997,7 +1011,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); } @@ -1054,9 +1068,14 @@ static EMACS_INT minibuf_c_loop_level (EMACS_INT depth) } static void -run_exit_minibuf_hook (void) +run_exit_minibuf_hook (Lisp_Object minibuf) { + specpdl_ref count = SPECPDL_INDEX (); + record_unwind_current_buffer (); + if (BUFFER_LIVE_P (XBUFFER (minibuf))) + Fset_buffer (minibuf); safe_run_hooks (Qminibuffer_exit_hook); + unbind_to (count, Qnil); } /* This variable records the expired minibuffer's frame between the @@ -1104,8 +1123,8 @@ read_minibuf_unwind (void) found: if (!EQ (exp_MB_frame, saved_selected_frame) && !NILP (exp_MB_frame)) - do_switch_frame (exp_MB_frame, 0, 0, Qt); /* This also sets - minibuf_window */ + do_switch_frame (exp_MB_frame, 0, Qt); /* This also sets + minibuf_window */ /* To keep things predictable, in case it matters, let's be in the minibuffer when we reset the relevant variables. Don't depend on @@ -1147,7 +1166,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); @@ -1217,7 +1236,7 @@ read_minibuf_unwind (void) /* Restore the selected frame. */ if (!EQ (exp_MB_frame, saved_selected_frame) && !NILP (exp_MB_frame)) - do_switch_frame (saved_selected_frame, 0, 0, Qt); + do_switch_frame (saved_selected_frame, 0, Qt); } /* Replace the expired minibuffer in frame exp_MB_frame with the next less @@ -1284,8 +1303,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'. @@ -1376,7 +1396,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 @@ -1475,7 +1495,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); @@ -1525,51 +1545,72 @@ function, instead of the usual behavior. */) return unbind_to (count, result); } -static Lisp_Object -minibuf_conform_representation (Lisp_Object string, Lisp_Object basis) +static bool +match_regexps (Lisp_Object string, Lisp_Object regexps, + bool ignore_case) { - if (STRING_MULTIBYTE (string) == STRING_MULTIBYTE (basis)) - return string; + ptrdiff_t val; + for (; CONSP (regexps); regexps = XCDR (regexps)) + { + CHECK_STRING (XCAR (regexps)); - if (STRING_MULTIBYTE (string)) - return Fstring_make_unibyte (string); - else - return Fstring_make_multibyte (string); + 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. + doc: /* Return longest common substring of all completions of STRING in COLLECTION. + Test each possible completion specified by COLLECTION to see if it begins with STRING. The possible completions may be strings or symbols. Symbols are converted to strings before testing, -see `symbol-name'. -All that match STRING are compared together; the longest initial sequence -common to all these matches is the return value. -If there is no match at all, the return value is nil. -For a unique match which is exact, the return value is t. +by using `symbol-name'. + +If no possible completions match, the function returns nil; if +there's just one exact match, it returns t; otherwise it returns +the longest initial substring common to all possible completions +that begin with STRING. If COLLECTION is an alist, the keys (cars of elements) are the possible completions. If an element is not a cons cell, then the -element itself is the possible completion. -If COLLECTION is a hash-table, all the keys that are strings or symbols -are the possible completions. +element itself is a possible completion. +If COLLECTION is a hash-table, all the keys that are either strings +or symbols are the possible completions. If COLLECTION is an obarray, the names of all symbols in the obarray are the possible completions. COLLECTION can also be a function to do the completion itself. -It receives three arguments: the values STRING, PREDICATE and nil. +It receives three arguments: STRING, PREDICATE and nil. Whatever it returns becomes the value of `try-completion'. -If optional third argument PREDICATE is non-nil, -it is used to test each possible match. -The match is a candidate only if PREDICATE returns non-nil. -The argument given to PREDICATE is the alist element -or the symbol from the obarray. If COLLECTION is a hash-table, -predicate is called with two arguments: the key and the value. -Additionally to this predicate, `completion-regexp-list' -is used to further constrain the set of candidates. */) +If optional third argument PREDICATE is non-nil, it must be a function +of one or two arguments, and is used to test each possible completion. +A possible completion is accepted only if PREDICATE returns non-nil. + +The argument given to PREDICATE is either a string or a cons cell (whose +car is a string) from the alist, or a symbol from the obarray. +If COLLECTION is a hash-table, PREDICATE is called with two arguments: +the string key and the associated value. + +To be acceptable, a possible completion must also match all the regexps +in `completion-regexp-list' (unless COLLECTION is a function, in +which case that function should itself handle `completion-regexp-list'). + +If `completion-ignore-case' is non-nil, possible completions are matched +while ignoring letter-case, but no guarantee is made about the letter-case +of the return value, except that it comes either from the user's input +or from one of the possible completions. */) (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate) { + Lisp_Object bestmatch, tail, elt, eltstring; /* Size in bytes of BESTMATCH. */ ptrdiff_t bestmatchsize = 0; @@ -1583,7 +1624,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); @@ -1641,7 +1681,8 @@ is used to further constrain the set of candidates. */) else /* if (type == hash_table) */ { while (idx < HASH_TABLE_SIZE (XHASH_TABLE (collection)) - && EQ (HASH_KEY (XHASH_TABLE (collection), idx), Qunbound)) + && BASE_EQ (HASH_KEY (XHASH_TABLE (collection), idx), + Qunbound)) idx++; if (idx >= HASH_TABLE_SIZE (XHASH_TABLE (collection))) break; @@ -1662,27 +1703,10 @@ is used to further constrain the set of candidates. */) completion_ignore_case ? Qt : Qnil), EQ (Qt, tem))) { - /* Yes. */ - Lisp_Object regexps; - /* Ignore this element if it fails to match all the regexps. */ - { - for (regexps = Vcompletion_regexp_list; CONSP (regexps); - regexps = XCDR (regexps)) - { - if (bindcount < 0) - { - bindcount = SPECPDL_INDEX (); - specbind (Qcase_fold_search, - completion_ignore_case ? Qt : Qnil); - } - tem = Fstring_match (XCAR (regexps), eltstring, zero); - if (NILP (tem)) - break; - } - if (CONSP (regexps)) - continue; - } + if (!match_regexps (eltstring, Vcompletion_regexp_list, + completion_ignore_case)) + continue; /* Ignore this element if there is a predicate and the predicate doesn't like it. */ @@ -1693,11 +1717,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), @@ -1760,10 +1779,10 @@ is used to further constrain the set of candidates. */) if (bestmatchsize != SCHARS (eltstring) || bestmatchsize != matchsize || (completion_ignore_case - && !EQ (Fcompare_strings (old_bestmatch, zero, lcompare, - eltstring, zero, lcompare, - Qnil), - Qt))) + && !BASE_EQ (Fcompare_strings (old_bestmatch, zero, + lcompare, eltstring, zero, + lcompare, Qnil), + Qt))) /* Don't count the same string multiple times. */ matchcount += matchcount <= 1; bestmatchsize = matchsize; @@ -1779,9 +1798,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, @@ -1789,7 +1805,7 @@ is used to further constrain the set of candidates. */) don't change the case of what the user typed. */ if (completion_ignore_case && bestmatchsize == SCHARS (string) && SCHARS (bestmatch) > bestmatchsize) - return minibuf_conform_representation (string, bestmatch); + return string; /* Return t if the supplied string is an exact match (counting case); it does not require any change to be made. */ @@ -1802,11 +1818,13 @@ is used to further constrain the set of candidates. */) } DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 4, 0, - doc: /* Search for partial matches to STRING in COLLECTION. -Test each of the possible completions specified by COLLECTION + doc: /* Search for partial matches of STRING in COLLECTION. + +Test each possible completion specified by COLLECTION to see if it begins with STRING. The possible completions may be strings or symbols. Symbols are converted to strings before testing, -see `symbol-name'. +by using `symbol-name'. + The value is a list of all the possible completions that match STRING. If COLLECTION is an alist, the keys (cars of elements) are the @@ -1818,17 +1836,21 @@ If COLLECTION is an obarray, the names of all symbols in the obarray are the possible completions. COLLECTION can also be a function to do the completion itself. -It receives three arguments: the values STRING, PREDICATE and t. +It receives three arguments: STRING, PREDICATE and t. Whatever it returns becomes the value of `all-completions'. -If optional third argument PREDICATE is non-nil, -it is used to test each possible match. -The match is a candidate only if PREDICATE returns non-nil. -The argument given to PREDICATE is the alist element -or the symbol from the obarray. If COLLECTION is a hash-table, -predicate is called with two arguments: the key and the value. -Additionally to this predicate, `completion-regexp-list' -is used to further constrain the set of candidates. +If optional third argument PREDICATE is non-nil, it must be a function +of one or two arguments, and is used to test each possible completion. +A possible completion is accepted only if PREDICATE returns non-nil. + +The argument given to PREDICATE is either a string or a cons cell (whose +car is a string) from the alist, or a symbol from the obarray. +If COLLECTION is a hash-table, PREDICATE is called with two arguments: +the string key and the associated value. + +To be acceptable, a possible completion must also match all the regexps +in `completion-regexp-list' (unless COLLECTION is a function, in +which case that function should itself handle `completion-regexp-list'). An obsolete optional fourth argument HIDE-SPACES is still accepted for backward compatibility. If non-nil, strings in COLLECTION that start @@ -1841,7 +1863,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); @@ -1898,7 +1919,8 @@ with a space are ignored unless STRING itself starts with a space. */) else /* if (type == 3) */ { while (idx < HASH_TABLE_SIZE (XHASH_TABLE (collection)) - && EQ (HASH_KEY (XHASH_TABLE (collection), idx), Qunbound)) + && BASE_EQ (HASH_KEY (XHASH_TABLE (collection), idx), + Qunbound)) idx++; if (idx >= HASH_TABLE_SIZE (XHASH_TABLE (collection))) break; @@ -1926,27 +1948,10 @@ with a space are ignored unless STRING itself starts with a space. */) completion_ignore_case ? Qt : Qnil), EQ (Qt, tem))) { - /* Yes. */ - Lisp_Object regexps; - /* Ignore this element if it fails to match all the regexps. */ - { - for (regexps = Vcompletion_regexp_list; CONSP (regexps); - regexps = XCDR (regexps)) - { - if (bindcount < 0) - { - bindcount = SPECPDL_INDEX (); - specbind (Qcase_fold_search, - completion_ignore_case ? Qt : Qnil); - } - tem = Fstring_match (XCAR (regexps), eltstring, zero); - if (NILP (tem)) - break; - } - if (CONSP (regexps)) - continue; - } + if (!match_regexps (eltstring, Vcompletion_regexp_list, + completion_ignore_case)) + continue; /* Ignore this element if there is a predicate and the predicate doesn't like it. */ @@ -1957,11 +1962,6 @@ with a space are ignored unless STRING itself starts with a space. */) tem = Fcommandp (elt, Qnil); else { - if (bindcount >= 0) - { - unbind_to (bindcount, Qnil); - bindcount = -1; - } tem = type == 3 ? call2 (predicate, elt, HASH_VALUE (XHASH_TABLE (collection), idx - 1)) @@ -1974,9 +1974,6 @@ with a space are ignored unless STRING itself starts with a space. */) } } - if (bindcount >= 0) - unbind_to (bindcount, Qnil); - return Fnreverse (allmatches); } @@ -2002,6 +1999,9 @@ REQUIRE-MATCH can take the following values: input, but she needs to confirm her choice if she called `minibuffer-complete' right before `minibuffer-complete-and-exit' and the input is not an element of COLLECTION. +- a function, which will be called with the input as the + argument. If the function returns a non-nil value, the + minibuffer is exited with that argument as the value. - anything else behaves like t except that typing RET does not exit if it does non-null completion. @@ -2060,7 +2060,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); @@ -2078,19 +2078,6 @@ the values STRING, PREDICATE and `lambda'. */) SSDATA (string), SCHARS (string), SBYTES (string)); - if (!SYMBOLP (tem)) - { - if (STRING_MULTIBYTE (string)) - string = Fstring_make_unibyte (string); - else - string = Fstring_make_multibyte (string); - - tem = oblookup (collection, - SSDATA (string), - SCHARS (string), - SBYTES (string)); - } - if (completion_ignore_case && !SYMBOLP (tem)) { for (i = ASIZE (collection) - 1; i >= 0; i--) @@ -2099,10 +2086,11 @@ the values STRING, PREDICATE and `lambda'. */) if (SYMBOLP (tail)) while (1) { - if (EQ (Fcompare_strings (string, make_fixnum (0), Qnil, - Fsymbol_name (tail), - make_fixnum (0) , Qnil, Qt), - Qt)) + if (BASE_EQ (Fcompare_strings (string, make_fixnum (0), + Qnil, + Fsymbol_name (tail), + make_fixnum (0) , Qnil, Qt), + Qt)) { tem = tail; break; @@ -2130,12 +2118,12 @@ the values STRING, PREDICATE and `lambda'. */) for (i = 0; i < HASH_TABLE_SIZE (h); ++i) { tem = HASH_KEY (h, i); - if (EQ (tem, Qunbound)) continue; + if (BASE_EQ (tem, Qunbound)) continue; Lisp_Object strkey = (SYMBOLP (tem) ? Fsymbol_name (tem) : tem); if (!STRINGP (strkey)) continue; - if (EQ (Fcompare_strings (string, Qnil, Qnil, - strkey, Qnil, Qnil, - completion_ignore_case ? Qt : Qnil), + if (BASE_EQ (Fcompare_strings (string, Qnil, Qnil, + strkey, Qnil, Qnil, + completion_ignore_case ? Qt : Qnil), Qt)) goto found_matching_key; } @@ -2146,20 +2134,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..16174210669 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -47,12 +47,42 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu) #ifdef NS_IMPL_COCOA #include <IOKit/graphics/IOGraphicsLib.h> #include "macfont.h" + +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 120000 +#include <UniformTypeIdentifiers/UniformTypeIdentifiers.h> +#if MAC_OS_X_VERSION_MIN_REQUIRED >= 120000 +#define IOMasterPort IOMainPort +#endif +#endif #endif #ifdef HAVE_NS static EmacsTooltip *ns_tooltip = nil; +/* The frame of the currently visible tooltip, or nil if none. */ +static Lisp_Object tip_frame; + +/* The X and Y deltas of the last call to `x-show-tip'. */ +static Lisp_Object tip_dx, tip_dy; + +/* The window-system window corresponding to the frame of the + currently visible tooltip. */ +static NSWindow *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 variables to handle AppleScript execution. */ static Lisp_Object as_script, *as_result; static int as_status; @@ -236,7 +266,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 +282,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 +301,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 +315,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 +330,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); } @@ -362,7 +382,7 @@ ns_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) /* See if it's changed. */ if (STRINGP (arg)) { - if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt)) + if (STRINGP (oldval) && BASE_EQ (Fstring_equal (oldval, arg), Qt)) return; } else if (!STRINGP (oldval) && NILP (oldval) == NILP (arg)) @@ -779,11 +799,13 @@ ns_implicitly_set_icon_type (struct frame *f) Lisp_Object chain, elt; NSAutoreleasePool *pool; BOOL setMini = YES; + NSWorkspace *workspace; NSTRACE ("ns_implicitly_set_icon_type"); block_input (); pool = [[NSAutoreleasePool alloc] init]; + workspace = [NSWorkspace sharedWorkspace]; if (f->output_data.ns->miniimage && [[NSString stringWithLispString:f->name] isEqualToString: [(NSImage *)f->output_data.ns->miniimage name]]) @@ -828,7 +850,21 @@ ns_implicitly_set_icon_type (struct frame *f) if (image == nil) { - image = [[[NSWorkspace sharedWorkspace] iconForFileType: @"text"] retain]; +#ifndef NS_IMPL_GNUSTEP +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 120000 +#if MAC_OS_X_VERSION_MIN_REQUIRED < 120000 + if ([workspace respondsToSelector: @selector (iconForContentType:)]) +#endif + image = [[workspace iconForContentType: + [UTType typeWithIdentifier: @"text"]] retain]; +#if MAC_OS_X_VERSION_MIN_REQUIRED < 120000 + else +#endif +#endif +#endif +#if MAC_OS_X_VERSION_MIN_REQUIRED < 120000 + image = [[workspace iconForFileType: @"text"] retain]; +#endif setMini = NO; } @@ -901,7 +937,10 @@ static Lisp_Object ns_appkit_version_str (void) { NSString *tmp; + Lisp_Object string; + NSAutoreleasePool *autorelease; + autorelease = [[NSAutoreleasePool alloc] init]; #ifdef NS_IMPL_GNUSTEP tmp = [NSString stringWithFormat:@"gnustep-gui-%s", Xstr(GNUSTEP_GUI_VERSION)]; #elif defined (NS_IMPL_COCOA) @@ -911,7 +950,10 @@ ns_appkit_version_str (void) #else tmp = [NSString initWithUTF8String:@"ns-unknown"]; #endif - return [tmp lispString]; + string = [tmp lispString]; + [autorelease release]; + + return string; } @@ -1014,6 +1056,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, @@ -1024,7 +1067,7 @@ frame_parm_handler ns_frame_parm_handlers[] = /* Handler for signals raised during x_create_frame. FRAME is the frame which is partially constructed. */ -static void +static Lisp_Object unwind_create_frame (Lisp_Object frame) { struct frame *f = XFRAME (frame); @@ -1033,7 +1076,7 @@ unwind_create_frame (Lisp_Object frame) display is disconnected after the frame has become official, but before x_create_frame removes the unwind protect. */ if (!FRAME_LIVE_P (f)) - return; + return Qnil; /* If frame is ``official'', nothing to do. */ if (NILP (Fmemq (frame, Vframe_list))) @@ -1060,7 +1103,18 @@ unwind_create_frame (Lisp_Object frame) /* Check that reference counts are indeed correct. */ eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount); #endif + + return Qt; } + + return Qnil; +} + + +static void +do_unwind_create_frame (Lisp_Object frame) +{ + unwind_create_frame (frame); } /* @@ -1115,12 +1169,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); @@ -1193,7 +1248,7 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, FRAME_DISPLAY_INFO (f) = dpyinfo; /* With FRAME_DISPLAY_INFO set up, this unwind-protect is safe. */ - record_unwind_protect (unwind_create_frame, frame); + record_unwind_protect (do_unwind_create_frame, frame); f->output_data.ns->window_desc = desc_ctr++; if (TYPE_RANGED_FIXNUMP (Window, parent)) @@ -1236,6 +1291,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 +1306,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 +1420,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 +1501,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 +1547,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. */ @@ -1564,26 +1650,22 @@ Some window managers may refuse to restack windows. */) } } -DEFUN ("ns-popup-font-panel", Fns_popup_font_panel, Sns_popup_font_panel, - 0, 1, "", - doc: /* Pop up the font panel. */) - (Lisp_Object frame) +DEFUN ("x-select-font", Fx_select_font, Sx_select_font, 0, 2, 0, + doc: /* Read a font using a Nextstep dialog. +Return a font specification describing the selected font. + +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); - id fm = [NSFontManager sharedFontManager]; - struct font *font = f->output_data.ns->font; - NSFont *nsfont; -#ifdef NS_IMPL_GNUSTEP - nsfont = ((struct nsfont_info *)font)->nsfont; -#endif -#ifdef NS_IMPL_COCOA - nsfont = (NSFont *) macfont_get_nsctfont (font); -#endif - [fm setSelectedFont: nsfont isMultiple: NO]; - [fm orderFrontFontPanel: NSApp]; - return Qnil; -} + Lisp_Object font = [FRAME_NS_VIEW (f) showFontPanel]; + if (NILP (font)) + quit (); + + return font; +} DEFUN ("ns-popup-color-panel", Fns_popup_color_panel, Sns_popup_color_panel, 0, 1, "", @@ -1652,16 +1734,18 @@ Optional arg DIR_ONLY_P, if non-nil, means choose only directories. */) BOOL isSave = NILP (mustmatch) && NILP (dir_only_p); id panel; Lisp_Object fname = Qnil; - - NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil : - [NSString stringWithLispString:prompt]; - NSString *dirS = NILP (dir) || !STRINGP (dir) ? - [NSString stringWithLispString:BVAR (current_buffer, directory)] : - [NSString stringWithLispString:dir]; - NSString *initS = NILP (init) || !STRINGP (init) ? nil : - [NSString stringWithLispString:init]; + NSString *promptS, *dirS, *initS, *str; NSEvent *nxev; + promptS = (NILP (prompt) || !STRINGP (prompt) + ? nil : [NSString stringWithLispString: prompt]); + dirS = (NILP (dir) || !STRINGP (dir) + ? [NSString stringWithLispString: + ENCODE_FILE (BVAR (current_buffer, directory))] : + [NSString stringWithLispString: ENCODE_FILE (dir)]); + initS = (NILP (init) || !STRINGP (init) + ? nil : [NSString stringWithLispString: init]); + check_window_system (NULL); if (fileDelegate == nil) @@ -1699,7 +1783,20 @@ Optional arg DIR_ONLY_P, if non-nil, means choose only directories. */) ns_fd_data.ret = NO; #ifdef NS_IMPL_COCOA if (! NILP (mustmatch) || ! NILP (dir_only_p)) - [panel setAllowedFileTypes: nil]; + { +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 120000 +#if MAC_OS_X_VERSION_MIN_REQUIRED < 120000 + if ([panel respondsToSelector: @selector (setAllowedContentTypes:)]) +#endif + [panel setAllowedContentTypes: [NSArray array]]; +#if MAC_OS_X_VERSION_MIN_REQUIRED < 120000 + else +#endif +#endif +#if MAC_OS_X_VERSION_MIN_REQUIRED < 120000 + [panel setAllowedFileTypes: nil]; +#endif + } if (dirS) [panel setDirectoryURL: [NSURL fileURLWithPath: dirS]]; if (initS && NILP (Ffile_directory_p (init))) [panel setNameFieldStringValue: [initS lastPathComponent]]; @@ -1733,9 +1830,15 @@ Optional arg DIR_ONLY_P, if non-nil, means choose only directories. */) if (ns_fd_data.ret == MODAL_OK_RESPONSE) { - NSString *str = ns_filename_from_panel (panel); - if (! str) str = ns_directory_from_panel (panel); - if (str) fname = [str lispString]; + str = ns_filename_from_panel (panel); + + if (!str) + str = ns_directory_from_panel (panel); + if (str) + fname = [str lispString]; + + if (!NILP (fname)) + fname = DECODE_FILE (fname); } [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow]; @@ -1759,7 +1862,7 @@ ns_get_defaults_value (const char *key) DEFUN ("ns-get-resource", Fns_get_resource, Sns_get_resource, 2, 2, 0, doc: /* Return the value of the property NAME of OWNER from the defaults database. If OWNER is nil, Emacs is assumed. */) - (Lisp_Object owner, Lisp_Object name) + (Lisp_Object owner, Lisp_Object name) { const char *value; @@ -1780,7 +1883,7 @@ DEFUN ("ns-set-resource", Fns_set_resource, Sns_set_resource, 3, 3, 0, doc: /* Set property NAME of OWNER to VALUE, from the defaults database. If OWNER is nil, Emacs is assumed. If VALUE is nil, the default is removed. */) - (Lisp_Object owner, Lisp_Object name, Lisp_Object value) + (Lisp_Object owner, Lisp_Object name, Lisp_Object value) { check_window_system (NULL); if (NILP (owner)) @@ -1807,7 +1910,7 @@ DEFUN ("x-server-max-request-size", Fx_server_max_request_size, Sx_server_max_request_size, 0, 1, 0, doc: /* SKIP: real doc in xfns.c. */) - (Lisp_Object terminal) + (Lisp_Object terminal) { check_ns_display_info (terminal); /* This function has no real equivalent under Nextstep. Return nil to @@ -2080,6 +2183,7 @@ The optional argument FRAME is currently ignored. */) Lisp_Object list = Qnil; NSEnumerator *colorlists; NSColorList *clist; + NSAutoreleasePool *pool; if (!NILP (frame)) { @@ -2089,7 +2193,9 @@ The optional argument FRAME is currently ignored. */) } block_input (); - + /* This can be called during dumping, so we need to set up a + temporary autorelease pool. */ + pool = [[NSAutoreleasePool alloc] init]; colorlists = [[NSColorList availableColorLists] objectEnumerator]; while ((clist = [colorlists nextObject])) { @@ -2100,12 +2206,9 @@ The optional argument FRAME is currently ignored. */) NSString *cname; while ((cname = [cnames nextObject])) list = Fcons ([cname lispString], list); -/* for (i = [[clist allKeys] count] - 1; i >= 0; i--) - list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i] - UTF8String]), list); */ } } - + [pool release]; unblock_input (); return list; @@ -2352,6 +2455,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) @@ -2628,7 +2772,8 @@ Internal use only, use `display-monitor-attributes-list' instead. */) } else { - // Flip y coordinate as NS has y starting from the bottom. + /* Flip y coordinate as NS screen coordinates originate from + the bottom. */ y = (short) (primary_display_height - fr.size.height - fr.origin.y); vy = (short) (primary_display_height - vfr.size.height - vfr.origin.y); @@ -2640,11 +2785,12 @@ Internal use only, use `display-monitor-attributes-list' instead. */) m->geom.height = (unsigned short) fr.size.height; m->work.x = (short) vfr.origin.x; - // y is flipped on NS, so vy - y are pixels missing at the bottom, - // and fr.size.height - vfr.size.height are pixels missing in total. - // Pixels missing at top are - // fr.size.height - vfr.size.height - vy + y. - // work.y is then pixels missing at top + y. + /* y is flipped on NS, so vy - y are pixels missing at the + bottom, and fr.size.height - vfr.size.height are pixels + missing in total. + + Pixels missing at top are fr.size.height - vfr.size.height - + vy + y. work.y is then pixels missing at top + y. */ m->work.y = (short) (fr.size.height - vfr.size.height) - vy + y + y; m->work.width = (unsigned short) vfr.size.width; m->work.height = (unsigned short) vfr.size.height; @@ -2659,13 +2805,14 @@ Internal use only, use `display-monitor-attributes-list' instead. */) } #else - // Assume 92 dpi as x-display-mm-height/x-display-mm-width does. + /* Assume 92 dpi as x-display-mm-height and x-display-mm-width + do. */ m->mm_width = (int) (25.4 * fr.size.width / 92.0); m->mm_height = (int) (25.4 * fr.size.height / 92.0); #endif } - // Primary monitor is always first for NS. + /* Primary monitor is always ordered first for NS. */ attributes_list = ns_make_monitor_attribute_list (monitors, n_monitors, 0, "NS"); @@ -2695,16 +2842,10 @@ DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells, return make_fixnum (1 << min (dpyinfo->n_planes, 24)); } -/* TODO: move to xdisp or similar */ 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) +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; NSPoint pt; @@ -2773,18 +2914,318 @@ compute_tip_xy (struct frame *f, *root_y = screen.frame.origin.y + screen.frame.size.height - height; } +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 +ns_create_tip_frame (struct ns_display_info *dpyinfo, Lisp_Object parms) +{ + 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; + + f->output_method = output_ns; + f->output_data.ns = xzalloc (sizeof *f->output_data.ns); + f->tooltip = true; + + FRAME_FONTSET (f) = -1; + FRAME_DISPLAY_INFO (f) = dpyinfo; + + block_input (); +#ifdef NS_IMPL_COCOA + mac_register_font_driver (f); +#else + register_font_driver (&nsfont_driver, f); +#endif + unblock_input (); + + 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); + + { +#ifdef NS_IMPL_COCOA + /* use for default font name */ + id font = [NSFont userFixedPitchFontOfSize: -1.0]; /* default */ + gui_default_parameter (f, parms, Qfontsize, + make_fixnum (0 /* (int)[font pointSize] */), + "fontSize", "FontSize", RES_TYPE_NUMBER); + // Remove ' Regular', not handled by backends. + char *fontname = xstrdup ([[font displayName] UTF8String]); + int len = strlen (fontname); + if (len > 8 && strcmp (fontname + len - 8, " Regular") == 0) + fontname[len-8] = '\0'; + gui_default_parameter (f, parms, Qfont, + 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 + } + + gui_default_parameter (f, parms, Qborder_width, make_fixnum (0), + "borderWidth", "BorderWidth", RES_TYPE_NUMBER); + + /* 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); + + f->output_data.ns->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); + + block_input (); + [[EmacsView alloc] initFrameFromEmacs: f]; + ns_icon (f, parms); + 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); + + /* 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 = 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 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 Lisp_Object +x_hide_tip (bool delete) +{ + if (!NILP (tip_timer)) + { + call1 (intern ("cancel-timer"), tip_timer); + tip_timer = Qnil; + } + + if (!(ns_tooltip == nil || ![ns_tooltip isActive])) + { + [ns_tooltip hide]; + tip_last_frame = Qnil; + return Qt; + } + + if ((NILP (tip_last_frame) && NILP (tip_frame)) + || (!use_system_tooltips + && !delete + && !NILP (tip_frame) + && FRAME_LIVE_P (XFRAME (tip_frame)) + && !FRAME_VISIBLE_P (XFRAME (tip_frame)))) + /* Either there's no tooltip to hide or it's an already invisible + Emacs tooltip and we don't want to change its type. Return + quickly. */ + return Qnil; + else + { + specpdl_ref count; + Lisp_Object was_open = Qnil; + + count = SPECPDL_INDEX (); + specbind (Qinhibit_redisplay, Qt); + specbind (Qinhibit_quit, Qt); + + /* Now look whether there's an Emacs tip around. */ + if (!NILP (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 + ns_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: /* SKIP: real doc in xfns.c. */) (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 (); - struct frame *f; + specpdl_ref count = SPECPDL_INDEX (); + struct frame *f, *tip_f; + struct window *w; + struct buffer *old_buffer; + struct text_pos pos; + int width, height; + int old_windows_or_buffers_changed = windows_or_buffers_changed; + specpdl_ref count_1; + Lisp_Object window, size, tip_buf; char *str; - NSSize size; - NSColor *color; - Lisp_Object t; + NSWindow *nswindow; + + AUTO_STRING (tip, " *tip*"); specbind (Qinhibit_redisplay, Qt); @@ -2792,9 +3233,8 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, str = SSDATA (string); f = decode_window_system_frame (frame); if (NILP (timeout)) - timeout = make_fixnum (5); - else - CHECK_FIXNAT (timeout); + timeout = Vx_show_tooltip_timeout; + CHECK_FIXNAT (timeout); if (NILP (dx)) dx = make_fixnum (5); @@ -2806,32 +3246,253 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, else CHECK_FIXNUM (dy); - block_input (); - if (ns_tooltip == nil) - ns_tooltip = [[EmacsTooltip alloc] init]; + tip_dx = dx; + tip_dy = dy; + + if (use_system_tooltips) + { + NSSize size; + NSColor *color; + Lisp_Object t; + + block_input (); + if (ns_tooltip == nil) + ns_tooltip = [[EmacsTooltip alloc] init]; + else + Fx_hide_tip (); + + t = gui_display_get_arg (NULL, parms, Qbackground_color, NULL, NULL, + RES_TYPE_STRING); + if (ns_lisp_to_color (t, &color) == 0) + [ns_tooltip setBackgroundColor: color]; + + t = gui_display_get_arg (NULL, parms, Qforeground_color, NULL, NULL, + RES_TYPE_STRING); + if (ns_lisp_to_color (t, &color) == 0) + [ns_tooltip setForegroundColor: color]; + + [ns_tooltip setText: str]; + size = [ns_tooltip frame].size; + + /* Move the tooltip window where the mouse pointer is. Resize and + show it. */ + compute_tip_xy (f, parms, dx, dy, (int) size.width, (int) size.height, + &root_x, &root_y); + + [ns_tooltip showAtX: root_x Y: root_y for: XFIXNUM (timeout)]; + unblock_input (); + } else - Fx_hide_tip (); + { + 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 (intern ("cancel-timer"), tip_timer); + tip_timer = Qnil; + } + + nswindow = [FRAME_NS_VIEW (tip_f) window]; + + block_input (); + compute_tip_xy (tip_f, parms, dx, dy, FRAME_PIXEL_WIDTH (tip_f), + FRAME_PIXEL_HEIGHT (tip_f), &root_x, &root_y); + [nswindow setFrame: NSMakeRect (root_x, root_y, + FRAME_PIXEL_WIDTH (tip_f), + FRAME_PIXEL_HEIGHT (tip_f)) + display: YES]; + [nswindow setLevel: NSPopUpMenuWindowLevel]; + [nswindow orderFront: NSApp]; + [nswindow display]; + + SET_FRAME_VISIBLE (tip_f, 1); + 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 (intern ("assq-delete-all"), parm, tip_last_parms); + } + else + tip_last_parms = + call2 (intern ("assq-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); - t = gui_display_get_arg (NULL, parms, Qbackground_color, NULL, NULL, - RES_TYPE_STRING); - if (ns_lisp_to_color (t, &color) == 0) - [ns_tooltip setBackgroundColor: color]; + tip_last_frame = frame; + tip_last_string = string; + tip_last_parms = parms; - t = gui_display_get_arg (NULL, parms, Qforeground_color, NULL, NULL, - RES_TYPE_STRING); - if (ns_lisp_to_color (t, &color) == 0) - [ns_tooltip setForegroundColor: color]; + 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 = ns_create_tip_frame (FRAME_DISPLAY_INFO (f), parms))) + /* Creating the tip frame failed. */ + return unbind_to (count, Qnil); + } - [ns_tooltip setText: str]; - size = [ns_tooltip frame].size; + 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; + } - /* Move the tooltip window where the mouse pointer is. Resize and - show it. */ - compute_tip_xy (f, parms, dx, dy, (int)size.width, (int)size.height, - &root_x, &root_y); + 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. */ + 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); + + block_input (); + nswindow = [FRAME_NS_VIEW (tip_f) window]; + [nswindow setFrame: NSMakeRect (root_x, root_y, + width, height) + display: YES]; + [nswindow setLevel: NSPopUpMenuWindowLevel]; + [nswindow orderFront: NSApp]; + [nswindow display]; + + SET_FRAME_VISIBLE (tip_f, YES); + FRAME_PIXEL_WIDTH (tip_f) = width; + FRAME_PIXEL_HEIGHT (tip_f) = height; + unblock_input (); - [ns_tooltip showAtX: root_x Y: root_y for: XFIXNUM (timeout)]; - 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); } @@ -2841,10 +3502,7 @@ DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0, doc: /* SKIP: real doc in xfns.c. */) (void) { - if (ns_tooltip == nil || ![ns_tooltip isActive]) - return Qnil; - [ns_tooltip hide]; - return Qt; + return x_hide_tip (!tooltip_reuse_hidden_frame); } /* Return geometric attributes of FRAME. According to the value of @@ -3099,6 +3757,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) @@ -3139,6 +3800,48 @@ all_nonzero_ascii (unsigned char *str, ptrdiff_t n) } @end +void +ns_move_tooltip_to_mouse_location (NSPoint screen_point) +{ + int root_x, root_y; + NSSize size; + NSWindow *window; + struct frame *tip_f; + + window = nil; + + if (!FIXNUMP (tip_dx) || !FIXNUMP (tip_dy)) + return; + + if (ns_tooltip) + size = [ns_tooltip frame].size; + else if (!FRAMEP (tip_frame) + || !FRAME_LIVE_P (XFRAME (tip_frame)) + || !FRAME_VISIBLE_P (XFRAME (tip_frame))) + return; + else + { + tip_f = XFRAME (tip_frame); + window = [FRAME_NS_VIEW (tip_f) window]; + size = [window frame].size; + } + + root_x = screen_point.x; + root_y = screen_point.y; + + /* We can directly use `compute_tip_xy' here, since it doesn't cons + nearly as much as it does on X. */ + compute_tip_xy (NULL, Qnil, tip_dx, tip_dy, (int) size.width, + (int) size.height, &root_x, &root_y); + + if (ns_tooltip) + [ns_tooltip moveTo: NSMakePoint (root_x, root_y)]; + else + [window setFrame: NSMakeRect (root_x, root_y, + size.width, size.height) + display: YES]; +} + /* ========================================================================== Lisp interface declaration @@ -3184,6 +3887,10 @@ be used as the image of the icon representing the frame. */); Default is t. */); ns_use_proxy_icon = 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)); + defsubr (&Sns_read_file_name); defsubr (&Sns_get_resource); defsubr (&Sns_set_resource); @@ -3227,12 +3934,31 @@ Default is t. */); defsubr (&Sns_emacs_info_panel); defsubr (&Sns_list_services); defsubr (&Sns_perform_service); - defsubr (&Sns_popup_font_panel); + defsubr (&Sx_select_font); defsubr (&Sns_popup_color_panel); defsubr (&Sx_show_tip); defsubr (&Sx_hide_tip); + 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); + tip_dx = Qnil; + staticpro (&tip_dx); + tip_dy = Qnil; + staticpro (&tip_dy); + +#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..b54118afe5d 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; +}; + + +enum lgstring_direction + { + DIR_R2L = -1, DIR_UNKNOWN = 0, DIR_L2R = 1 + }; + +enum gs_font_slant + { + GS_FONT_SLANT_ITALIC, + GS_FONT_SLANT_REVERSE_ITALIC, + GS_FONT_SLANT_NORMAL + }; + +enum gs_font_weight + { + GS_FONT_WEIGHT_LIGHT, + GS_FONT_WEIGHT_BOLD, + GS_FONT_WEIGHT_NORMAL + }; + +enum gs_font_width + { + GS_FONT_WIDTH_CONDENSED, + GS_FONT_WIDTH_EXPANDED, + GS_FONT_WIDTH_NORMAL + }; + +enum gs_specified + { + GS_SPECIFIED_SLANT = 1, + GS_SPECIFIED_WEIGHT = 1 << 1, + GS_SPECIFIED_WIDTH = 1 << 2, + GS_SPECIFIED_FAMILY = 1 << 3, + GS_SPECIFIED_SPACING = 1 << 4 + }; +struct gs_font_data +{ + int specified; + enum gs_font_slant slant; + enum gs_font_weight weight; + enum gs_font_width width; + bool monospace_p; + char *family_name; +}; -/* Replace spaces w/another character so emacs core font parsing routines - aren't thrown off. */ static void -ns_escape_name (char *name) +ns_done_font_data (struct gs_font_data *data) { - for (; *name; name++) - if (*name == ' ') - *name = '_'; + if (data->specified & GS_SPECIFIED_FAMILY) + xfree (data->family_name); } - -/* Reconstruct spaces in a font family name passed through emacs. */ static void -ns_unescape_name (char *name) +ns_get_font_data (NSFontDescriptor *desc, struct gs_font_data *dat) { - for (; *name; name++) - if (*name == '_') - *name = ' '; + NSNumber *tem; + NSFontSymbolicTraits traits = [desc symbolicTraits]; + NSDictionary *dict = [desc objectForKey: NSFontTraitsAttribute]; + NSString *family = [desc objectForKey: NSFontFamilyAttribute]; + + dat->specified = 0; + + if (family != nil) + { + dat->specified |= GS_SPECIFIED_FAMILY; + dat->family_name = xstrdup ([family cStringUsingEncoding: NSUTF8StringEncoding]); + } + + tem = [desc objectForKey: NSFontFixedAdvanceAttribute]; + + if ((tem != nil && [tem boolValue] != NO) + || (traits & NSFontMonoSpaceTrait)) + { + dat->specified |= GS_SPECIFIED_SPACING; + dat->monospace_p = true; + } + else if (tem != nil && [tem boolValue] == NO) + { + dat->specified |= GS_SPECIFIED_SPACING; + dat->monospace_p = false; + } + + if (traits & NSFontBoldTrait) + { + dat->specified |= GS_SPECIFIED_WEIGHT; + dat->weight = GS_FONT_WEIGHT_BOLD; + } + + if (traits & NSFontItalicTrait) + { + dat->specified |= GS_SPECIFIED_SLANT; + dat->slant = GS_FONT_SLANT_ITALIC; + } + + if (traits & NSFontCondensedTrait) + { + dat->specified |= GS_SPECIFIED_WIDTH; + dat->width = GS_FONT_WIDTH_CONDENSED; + } + else if (traits & NSFontExpandedTrait) + { + dat->specified |= GS_SPECIFIED_WIDTH; + dat->width = GS_FONT_WIDTH_EXPANDED; + } + + if (dict != nil) + { + tem = [dict objectForKey: NSFontSlantTrait]; + + if (tem != nil) + { + dat->specified |= GS_SPECIFIED_SLANT; + + dat->slant = [tem floatValue] > 0 + ? GS_FONT_SLANT_ITALIC + : ([tem floatValue] < 0 + ? GS_FONT_SLANT_REVERSE_ITALIC + : GS_FONT_SLANT_NORMAL); + } + + tem = [dict objectForKey: NSFontWeightTrait]; + + if (tem != nil) + { + dat->specified |= GS_SPECIFIED_WEIGHT; + + dat->weight = [tem floatValue] > 0 + ? GS_FONT_WEIGHT_BOLD + : ([tem floatValue] < -0.4f + ? GS_FONT_WEIGHT_LIGHT + : GS_FONT_WEIGHT_NORMAL); + } + + tem = [dict objectForKey: NSFontWidthTrait]; + + if (tem != nil) + { + dat->specified |= GS_SPECIFIED_WIDTH; + + dat->width = [tem floatValue] > 0 + ? GS_FONT_WIDTH_EXPANDED + : ([tem floatValue] < 0 + ? GS_FONT_WIDTH_NORMAL + : GS_FONT_WIDTH_CONDENSED); + } + } } +static bool +ns_font_descs_match_p (NSFontDescriptor *desc, NSFontDescriptor *target) +{ + struct gs_font_data dat; + struct gs_font_data t; + + ns_get_font_data (desc, &dat); + ns_get_font_data (target, &t); + + if (!(t.specified & GS_SPECIFIED_WIDTH)) + t.width = GS_FONT_WIDTH_NORMAL; + if (!(t.specified & GS_SPECIFIED_WEIGHT)) + t.weight = GS_FONT_WEIGHT_NORMAL; + if (!(t.specified & GS_SPECIFIED_SPACING)) + t.monospace_p = false; + if (!(t.specified & GS_SPECIFIED_SLANT)) + t.slant = GS_FONT_SLANT_NORMAL; + + if (!(t.specified & GS_SPECIFIED_FAMILY)) + emacs_abort (); + + bool match_p = true; + + if (dat.specified & GS_SPECIFIED_WIDTH + && dat.width != t.width) + { + match_p = false; + goto gout; + } + + if (dat.specified & GS_SPECIFIED_WEIGHT + && dat.weight != t.weight) + { + match_p = false; + goto gout; + } + + if (dat.specified & GS_SPECIFIED_SPACING + && dat.monospace_p != t.monospace_p) + { + match_p = false; + goto gout; + } + + if (dat.specified & GS_SPECIFIED_SLANT + && dat.monospace_p != t.monospace_p) + { + if (NSFONT_TRACE) + printf ("Matching monospace for %s: %d %d\n", + t.family_name, dat.monospace_p, + t.monospace_p); + match_p = false; + goto gout; + } + + if (dat.specified & GS_SPECIFIED_FAMILY + && strcmp (dat.family_name, t.family_name)) + match_p = false; + + gout: + ns_done_font_data (&dat); + ns_done_font_data (&t); + + return match_p; +} + +/* Font glyph and metrics caching functions, implemented at end. */ +static void ns_uni_to_glyphs (struct nsfont_info *font_info, + unsigned char block); +static void ns_glyph_metrics (struct nsfont_info *font_info, + unsigned int block); + +#define INVALID_GLYPH 0xFFFF + +/* ========================================================================== + + Utilities + + ========================================================================== */ + /* Extract family name from a font spec. */ static NSString * @@ -91,66 +313,116 @@ ns_get_family (Lisp_Object font_spec) { char *tmp = xlispstrdup (SYMBOL_NAME (tem)); NSString *family; - ns_unescape_name (tmp); family = [NSString stringWithUTF8String: tmp]; xfree (tmp); return family; } } - -/* Return 0 if attr not set, else value (which might also be 0). - On Leopard 0 gets returned even on descriptors where the attribute - was never set, so there's no way to distinguish between unspecified - and set to not have. Callers should assume 0 means unspecified. */ -static float -ns_attribute_fvalue (NSFontDescriptor *fdesc, NSString *trait) -{ - NSDictionary *tdict = [fdesc objectForKey: NSFontTraitsAttribute]; - NSNumber *val = [tdict objectForKey: trait]; - return val == nil ? 0.0F : [val floatValue]; -} - - /* Converts FONT_WEIGHT, FONT_SLANT, FONT_WIDTH, plus family and script/lang to NSFont descriptor. Information under extra only needed for matching. */ -#define STYLE_REF 100 static NSFontDescriptor * ns_spec_to_descriptor (Lisp_Object font_spec) { NSFontDescriptor *fdesc; NSMutableDictionary *fdAttrs = [NSMutableDictionary new]; - NSMutableDictionary *tdict = [NSMutableDictionary new]; NSString *family = ns_get_family (font_spec); - float n; - - /* Add each attr in font_spec to fdAttrs. */ - n = min (FONT_WEIGHT_NUMERIC (font_spec), 200); - if (n != -1 && n != STYLE_REF) - [tdict setObject: [NSNumber numberWithFloat: (n - 100.0F) / 100.0F] - forKey: NSFontWeightTrait]; - n = min (FONT_SLANT_NUMERIC (font_spec), 200); - if (n != -1 && n != STYLE_REF) - [tdict setObject: [NSNumber numberWithFloat: (n - 100.0F) / 100.0F] - forKey: NSFontSlantTrait]; - n = min (FONT_WIDTH_NUMERIC (font_spec), 200); - if (n > -1 && (n > STYLE_REF + 10 || n < STYLE_REF - 10)) - [tdict setObject: [NSNumber numberWithFloat: (n - 100.0F) / 100.0F] - forKey: NSFontWidthTrait]; - if ([tdict count] > 0) - [fdAttrs setObject: tdict forKey: NSFontTraitsAttribute]; + NSMutableDictionary *tdict = [NSMutableDictionary new]; - fdesc = [[[NSFontDescriptor fontDescriptorWithFontAttributes: fdAttrs] - retain] autorelease]; + Lisp_Object tem; + + tem = FONT_SLANT_SYMBOLIC (font_spec); + if (!NILP (tem)) + { + if (EQ (tem, Qitalic) || EQ (tem, Qoblique)) + [tdict setObject: [NSNumber numberWithFloat: 1.0] + forKey: NSFontSlantTrait]; + else if (EQ (tem, intern ("reverse-italic")) || + EQ (tem, intern ("reverse-oblique"))) + [tdict setObject: [NSNumber numberWithFloat: -1.0] + forKey: NSFontSlantTrait]; + else + [tdict setObject: [NSNumber numberWithFloat: 0.0] + forKey: NSFontSlantTrait]; + } + + tem = FONT_WIDTH_SYMBOLIC (font_spec); + if (!NILP (tem)) + { + if (EQ (tem, Qcondensed)) + [tdict setObject: [NSNumber numberWithFloat: -1.0] + forKey: NSFontWidthTrait]; + else if (EQ (tem, Qexpanded)) + [tdict setObject: [NSNumber numberWithFloat: 1.0] + forKey: NSFontWidthTrait]; + else + [tdict setObject: [NSNumber numberWithFloat: 0.0] + forKey: NSFontWidthTrait]; + } + + tem = FONT_WEIGHT_SYMBOLIC (font_spec); + + if (!NILP (tem)) + { + if (EQ (tem, Qbold)) + { + [tdict setObject: [NSNumber numberWithFloat: 1.0] + forKey: NSFontWeightTrait]; + } + else if (EQ (tem, Qlight)) + { + [tdict setObject: [NSNumber numberWithFloat: -1.0] + forKey: NSFontWeightTrait]; + } + else + { + [tdict setObject: [NSNumber numberWithFloat: 0.0] + forKey: NSFontWeightTrait]; + } + } + + tem = AREF (font_spec, FONT_SPACING_INDEX); if (family != nil) { - NSFontDescriptor *fdesc2 = [fdesc fontDescriptorWithFamily: family]; - fdesc = [[fdesc2 retain] autorelease]; + [fdAttrs setObject: family + forKey: NSFontFamilyAttribute]; } - [fdAttrs release]; + if (FIXNUMP (tem)) + { + if (XFIXNUM (tem) != FONT_SPACING_PROPORTIONAL) + { + [fdAttrs setObject: [NSNumber numberWithBool:YES] + forKey: NSFontFixedAdvanceAttribute]; + } + else + { + [fdAttrs setObject: [NSNumber numberWithBool:NO] + forKey: NSFontFixedAdvanceAttribute]; + } + } + + /* Handle special families such as ``fixed'' or ``Sans Serif''. */ + + if ([family isEqualToString: @"fixed"]) + { + [fdAttrs setObject: [[NSFont userFixedPitchFontOfSize: 0] familyName] + forKey: NSFontFamilyAttribute]; + } + else if ([family isEqualToString: @"Sans Serif"]) + { + [fdAttrs setObject: [[NSFont userFontOfSize: 0] familyName] + forKey: NSFontFamilyAttribute]; + } + + [fdAttrs setObject: tdict forKey: NSFontTraitsAttribute]; + + fdesc = [[[NSFontDescriptor fontDescriptorWithFontAttributes: fdAttrs] + retain] autorelease]; + [tdict release]; + [fdAttrs release]; return fdesc; } @@ -161,61 +433,64 @@ ns_descriptor_to_entity (NSFontDescriptor *desc, Lisp_Object extra, const char *style) { - Lisp_Object font_entity = font_make_entity (); - /* NSString *psName = [desc postscriptName]; */ - NSString *family = [desc objectForKey: NSFontFamilyAttribute]; - unsigned int traits = [desc symbolicTraits]; - char *escapedFamily; - - /* Shouldn't happen, but on Tiger fallback desc gets name but no family. */ - if (family == nil) - family = [desc objectForKey: NSFontNameAttribute]; - if (family == nil) - family = [[NSFont userFixedPitchFontOfSize: 0] familyName]; - - escapedFamily = xstrdup ([family UTF8String]); - ns_escape_name (escapedFamily); - - ASET (font_entity, FONT_TYPE_INDEX, Qns); - ASET (font_entity, FONT_FOUNDRY_INDEX, Qapple); - ASET (font_entity, FONT_FAMILY_INDEX, intern (escapedFamily)); - ASET (font_entity, FONT_ADSTYLE_INDEX, style ? intern (style) : Qnil); - ASET (font_entity, FONT_REGISTRY_INDEX, Qiso10646_1); - - FONT_SET_STYLE (font_entity, FONT_WEIGHT_INDEX, - traits & NSFontBoldTrait ? Qbold : Qmedium); -/* FONT_SET_STYLE (font_entity, FONT_WEIGHT_INDEX, - make_fixnum (100 + 100 - * ns_attribute_fvalue (desc, NSFontWeightTrait)));*/ - FONT_SET_STYLE (font_entity, FONT_SLANT_INDEX, - traits & NSFontItalicTrait ? Qitalic : Qnormal); -/* FONT_SET_STYLE (font_entity, FONT_SLANT_INDEX, - make_fixnum (100 + 100 - * ns_attribute_fvalue (desc, NSFontSlantTrait)));*/ - FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX, - traits & NSFontCondensedTrait ? Qcondensed : - traits & NSFontExpandedTrait ? Qexpanded : Qnormal); -/* FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX, - make_fixnum (100 + 100 - * ns_attribute_fvalue (desc, NSFontWidthTrait)));*/ - - ASET (font_entity, FONT_SIZE_INDEX, make_fixnum (0)); - ASET (font_entity, FONT_AVGWIDTH_INDEX, make_fixnum (0)); - ASET (font_entity, FONT_SPACING_INDEX, - make_fixnum([desc symbolicTraits] & NSFontMonoSpaceTrait - ? FONT_SPACING_MONO : FONT_SPACING_PROPORTIONAL)); - - ASET (font_entity, FONT_EXTRA_INDEX, extra); - ASET (font_entity, FONT_OBJLIST_INDEX, Qnil); + Lisp_Object font_entity = font_make_entity (); + struct gs_font_data data; + ns_get_font_data (desc, &data); + + ASET (font_entity, FONT_TYPE_INDEX, Qns); + ASET (font_entity, FONT_FOUNDRY_INDEX, Qns); + if (data.specified & GS_SPECIFIED_FAMILY) + ASET (font_entity, FONT_FAMILY_INDEX, intern (data.family_name)); + ASET (font_entity, FONT_ADSTYLE_INDEX, style ? intern (style) : Qnil); + ASET (font_entity, FONT_REGISTRY_INDEX, Qiso10646_1); + + if (data.specified & GS_SPECIFIED_WEIGHT) + { + FONT_SET_STYLE (font_entity, FONT_WEIGHT_INDEX, + data.weight == GS_FONT_WEIGHT_BOLD + ? Qbold : (data.weight == GS_FONT_WEIGHT_LIGHT + ? Qlight : Qnormal)); + } + else + FONT_SET_STYLE (font_entity, FONT_WEIGHT_INDEX, Qnormal); - if (NSFONT_TRACE) - { - fputs ("created font_entity:\n ", stderr); - debug_print (font_entity); - } + if (data.specified & GS_SPECIFIED_SLANT) + { + FONT_SET_STYLE (font_entity, FONT_SLANT_INDEX, + data.slant == GS_FONT_SLANT_ITALIC + ? Qitalic : (data.slant == GS_FONT_SLANT_REVERSE_ITALIC + ? intern ("reverse-italic") : Qnormal)); + } + else + FONT_SET_STYLE (font_entity, FONT_SLANT_INDEX, Qnormal); + + if (data.specified & GS_SPECIFIED_WIDTH) + { + FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX, + data.width == GS_FONT_WIDTH_CONDENSED + ? Qcondensed : (data.width == GS_FONT_WIDTH_EXPANDED + ? intern ("expanded") : Qnormal)); + } + else + FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX, Qnormal); + + 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]; + all_descs = [enumerator availableFontDescriptors]; - matchingDescs = [fdesc matchingFontDescriptorsWithMandatoryKeys: fkeys]; - - 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,198 +1158,429 @@ 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; - } - - r.origin.x = s->x; - if (s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p) - r.origin.x += max (s->face->box_vertical_line_width, 0); + face = s->face; - r.origin.y = s->y; + r.origin.x = x; + r.origin.y = 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 = 0; i < len; ++i) + c[i] = s->char2b[i + from]; /* 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 */ + 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; + + glyph_len = LGSTRING_GLYPH_LEN (lgstring); + for (i = 0; i < glyph_len; ++i) + { + tem = LGSTRING_GLYPH (lgstring, i); - col = (NS_FACE_FOREGROUND (face) != 0 - ? ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f) - : FRAME_FOREGROUND_COLOR (s->f)); + if (NILP (tem)) + break; + } - 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))); + len = i; - /* render under GNUstep using DPS */ - { - NSGraphicsContext *context = GSCurrentContext (); + if (INT_MAX / 2 < len) + memory_full (SIZE_MAX); - DPSgsave (context); - [font->nsfont set]; + block_input (); + + mb_buf = alloca (len * sizeof *mb_buf); + + for (i = 0; i < len; ++i) + { + uint32_t c = LGLYPH_CHAR (LGSTRING_GLYPH (lgstring, i)); + mb_buf[i] = (unichar) c; + } + + NSString *string = [NSString stringWithCharacters: mb_buf + length: len]; + unblock_input (); + + if (!string) + return Qnil; + + block_input (); + + enum lgstring_direction dir = DIR_UNKNOWN; + + if (EQ (direction, QL2R)) + dir = DIR_L2R; + else if (EQ (direction, QR2L)) + dir = DIR_R2L; + glyph_layouts = alloca (sizeof (struct ns_glyph_layout) * glyph_len); + used = ns_font_shape (nsfont, string, glyph_layouts, glyph_len, dir); + + for (i = 0; i < used; i++) + { + Lisp_Object lglyph = LGSTRING_GLYPH (lgstring, i); + struct ns_glyph_layout *gl = glyph_layouts + i; + EMACS_INT from, to; + struct font_metrics metrics; + + if (NILP (lglyph)) + { + lglyph = LGLYPH_NEW (); + LGSTRING_SET_GLYPH (lgstring, i, lglyph); + } - /* do erase if "foreground" mode */ - if (bgCol != nil) + 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 +1589,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 +1640,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 +1648,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 +1665,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 +1675,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 +1710,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 = - NSMaxY (r); + metrics->ascent = - NSMinY (r); } unblock_input (); } @@ -1257,6 +1753,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,10 +1762,12 @@ 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. */); + doc: /* Internal map of font registry to Unicode script. */); + Vns_reg_to_script = Qnil; + pdumper_do_now_and_after_load (syms_of_nsfont_for_pdumper); } 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..9cb5090dd0d 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. */ @@ -140,7 +142,7 @@ ns_load_image (struct frame *f, struct image *img, eassert (valid_image_p (img->spec)); - lisp_index = Fplist_get (XCDR (img->spec), QCindex); + lisp_index = plist_get (XCDR (img->spec), QCindex); index = FIXNUMP (lisp_index) ? XFIXNAT (lisp_index) : 0; if (STRINGP (spec_file)) diff --git a/src/nsmenu.m b/src/nsmenu.m index 891b6ee1504..ae795a0d22b 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -52,6 +52,10 @@ EmacsMenu *svcsMenu; /* Nonzero means a menu is currently active. */ static int popup_activated_flag; +/* The last frame whose menubar was updated. (This is the frame whose + menu bar is currently being displayed.) */ +static struct frame *last_menubar_frame; + /* NOTE: toolbar implementation is at end, following complete menu implementation. */ @@ -71,6 +75,12 @@ void free_frame_menubar (struct frame *f) { id menu = [NSApp mainMenu]; + + if (f != last_menubar_frame) + return; + + last_menubar_frame = NULL; + for (int i = [menu numberOfItems] - 1 ; i >= 0; i--) { NSMenuItem *item = (NSMenuItem *)[menu itemAtIndex:i]; @@ -101,6 +111,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,10 +139,15 @@ 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); */ + } + XSETFRAME (Vmenu_updating_frame, f); + last_menubar_frame = f; block_input (); /* Menu may have been created automatically; if so, discard it. */ @@ -141,11 +165,7 @@ ns_update_menubar (struct frame *f, bool deep_p) #if NSMENUPROFILE ftime (&tb); - t = -(1000*tb.time+tb.millitm); -#endif - -#ifdef NS_IMPL_GNUSTEP - deep_p = 1; /* See comment in menuNeedsUpdate. */ + t = -(1000 * tb.time + tb.millitm); #endif if (deep_p) @@ -154,7 +174,7 @@ ns_update_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); @@ -187,8 +207,6 @@ ns_update_menubar (struct frame *f, bool deep_p) /* 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))); @@ -275,6 +293,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; } @@ -400,7 +421,7 @@ ns_update_menubar (struct frame *f, bool deep_p) #if NSMENUPROFILE ftime (&tb); - t += 1000*tb.time+tb.millitm; + t += 1000 * tb.time + tb.millitm; fprintf (stderr, "Menu update took %ld msec.\n", t); #endif @@ -408,6 +429,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 +477,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 } @@ -615,7 +657,8 @@ prettify_key (const char *key) work around it by using tabs to split the title into two columns. */ NSFont *menuFont = [NSFont menuFontOfSize:0]; - NSDictionary *font_attribs = @{NSFontAttributeName: menuFont}; + NSDictionary *font_attribs = [NSDictionary dictionaryWithObjectsAndKeys: + menuFont, NSFontAttributeName, nil]; CGFloat maxNameWidth = 0; CGFloat maxKeyWidth = 0; @@ -643,11 +686,12 @@ prettify_key (const char *key) NSTextTab *tab = [[[NSTextTab alloc] initWithTextAlignment: NSTextAlignmentRight location: maxWidth - options: @{}] autorelease]; + options: [NSDictionary dictionary]] autorelease]; NSMutableParagraphStyle *pstyle = [[[NSMutableParagraphStyle alloc] init] autorelease]; - [pstyle setTabStops: @[tab]]; - attributes = @{NSParagraphStyleAttributeName: pstyle}; + [pstyle setTabStops: [NSArray arrayWithObject:tab]]; + attributes = [NSDictionary dictionaryWithObjectsAndKeys: + pstyle, NSParagraphStyleAttributeName, nil]; #endif /* clear existing contents */ @@ -705,15 +749,15 @@ prettify_key (const char *key) /* p = [view convertPoint:p fromView: nil]; */ p.y = NSHeight ([view frame]) - p.y; e = [[view window] currentEvent]; - event = [NSEvent mouseEventWithType: NSEventTypeRightMouseDown - location: p - modifierFlags: 0 - timestamp: [e timestamp] - windowNumber: [[view window] windowNumber] - context: nil - eventNumber: 0 /* [e eventNumber] */ - clickCount: 1 - pressure: 0]; + event = [NSEvent mouseEventWithType: NSEventTypeRightMouseDown + location: p + modifierFlags: 0 + timestamp: [e timestamp] + windowNumber: [[view window] windowNumber] + context: nil + eventNumber: 0 /* [e eventNumber] */ + clickCount: 1 + pressure: 0]; context_menu_value = -1; [NSMenu popUpContextMenu: self withEvent: event forView: view]; @@ -724,6 +768,45 @@ prettify_key (const char *key) : Qnil; } +- (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, *client_data; + + XSETFRAME (frame, f); + + /* This menu isn't a menubar, so use the pointer to the popup menu + data. */ + if (context_menu_value != 0) + { + client_data = (Lisp_Object *) idx; + + if (client_data) + help = client_data[MENU_ITEMS_ITEM_HELP]; + else + help = Qnil; + } + /* Just dismiss any help-echo that might already be in progress if + no menu item will be highlighted. */ + else if (item == nil || idx <= 0) + help = Qnil; + else + { + if (idx >= ASIZE (vec)) + return; + + /* Otherwise, get the help data from the menu bar vector. */ + help = AREF (vec, idx + MENU_ITEMS_ITEM_HELP); + } + + popup_activated_flag++; + if (STRINGP (help) || NILP (help)) + show_help_echo (help, Qnil, Qnil, Qnil); + popup_activated_flag--; +} + #ifdef NS_IMPL_GNUSTEP - (void) close { @@ -743,6 +826,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 +858,6 @@ prettify_key (const char *key) { return NSZeroRect; } - -- (void)menu:(NSMenu *)menu willHighlightItem:(NSMenuItem *)item -{ -} #endif @end /* EmacsMenu */ @@ -779,10 +877,17 @@ 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; widget_value *wv, *first_wv = 0; + widget_value *save_wv = 0, *prev_wv = 0; + widget_value **submenu_stack; + int submenu_depth = 0; + int first_pane = 1; + int i; bool keymaps = (menuflags & MENU_KEYMAPS); + USE_SAFE_ALLOCA; + NSTRACE ("ns_menu_show"); block_input (); @@ -794,19 +899,13 @@ ns_menu_show (struct frame *f, int x, int y, int menuflags, wv->button_type = BUTTON_TYPE_NONE; first_wv = wv; -#if 0 - /* FIXME: a couple of one-line differences prevent reuse. */ - wv = digest_single_submenu (0, menu_items_used, 0); -#else - { - widget_value *save_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; - int first_pane = 1; - int i; + submenu_stack + = SAFE_ALLOCA (menu_items_used * sizeof *submenu_stack); + + specpdl_count = SPECPDL_INDEX (); + + /* Don't GC due to a mysterious bug. */ + inhibit_garbage_collection (); /* Loop over all panes and items, filling in the tree. */ i = 0; @@ -936,8 +1035,6 @@ ns_menu_show (struct frame *f, int x, int y, int menuflags, i += MENU_ITEMS_ITEM_LENGTH; } } - } -#endif if (!NILP (title)) { @@ -960,16 +1057,20 @@ 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 (); + + SAFE_FREE (); return tem; } @@ -1019,6 +1120,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 +1143,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 +1169,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 +1193,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 +1310,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 +1328,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]; @@ -1389,6 +1495,15 @@ update_frame_tool_bar (struct frame *f) [timer retain]; } +- (void) moveTo: (NSPoint) screen_point +{ + [win setFrame: NSMakeRect (screen_point.x, + screen_point.y, + [self frame].size.width, + [self frame].size.height) + display: YES]; +} + - (void) hide { [win close]; @@ -1428,31 +1543,38 @@ pop_down_menu (void *arg) if (popup_activated_flag) { - block_input (); popup_activated_flag = 0; [panel close]; + /* For some reason this is required on macOS, or the selected + frame gets the keyboard focus but doesn't become + highlighted. */ +#ifdef NS_IMPL_COCOA [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow]; - unblock_input (); +#endif + discard_menu_items (); } } - Lisp_Object ns_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents) { - id dialog; + EmacsDialogPanel *dialog; Lisp_Object tem, title; NSPoint p; - BOOL isQ; + BOOL is_question; + const char *error_name; + specpdl_ref specpdl_count; NSTRACE ("ns_popup_dialog"); + specpdl_count = SPECPDL_INDEX (); - isQ = NILP (header); - + is_question = NILP (header); check_window_system (f); - p.x = (int)f->left_pos + ((int)FRAME_COLUMN_WIDTH (f) * f->text_cols)/2; - p.y = (int)f->top_pos + (FRAME_LINE_HEIGHT (f) * f->text_lines)/2; + p.x = ((int) f->left_pos + + ((int) FRAME_COLUMN_WIDTH (f) * f->text_cols) / 2); + p.y = ((int) f->top_pos + + (FRAME_LINE_HEIGHT (f) * f->text_lines) / 2); title = Fcar (contents); CHECK_STRING (title); @@ -1462,21 +1584,30 @@ ns_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents) the dialog. */ contents = list2 (title, Fcons (build_string ("Ok"), Qt)); - block_input (); - dialog = [[EmacsDialogPanel alloc] initFromContents: contents - isQuestion: isQ]; - - { - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + record_unwind_protect_void (unuse_menu_items); + list_of_panes (list1 (contents)); - record_unwind_protect_ptr (pop_down_menu, dialog); - popup_activated_flag = 1; - tem = [dialog runDialogAt: p]; - unbind_to (specpdl_count, Qnil); /* calls pop_down_menu */ - } + block_input (); + dialog = [[EmacsDialogPanel alloc] initWithTitle: SSDATA (title) + isQuestion: is_question]; + [dialog processMenuItems: menu_items + used: menu_items_used + withErrorOutput: &error_name]; + [dialog resizeBoundsPriorToDisplay]; unblock_input (); + if (error_name) + { + discard_menu_items (); + [dialog close]; + error ("%s", error_name); + } + + record_unwind_protect_ptr (pop_down_menu, dialog); + popup_activated_flag = 1; + tem = [dialog runDialogAt: p]; + unbind_to (specpdl_count, Qnil); return tem; } @@ -1517,7 +1648,6 @@ ns_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents) NSImage *img; dialog_return = Qundefined; - button_values = NULL; area.origin.x = 3*SPACER; area.origin.y = 2*SPACER; area.size.width = ICONSIZE; @@ -1601,58 +1731,65 @@ ns_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents) } -- (BOOL)windowShouldClose: (id)sender +- (BOOL)windowShouldClose: (id) sender { window_closed = YES; - [NSApp stop:self]; + [NSApp stop: self]; return NO; } -- (void)dealloc +- (void) dealloc { - xfree (button_values); [super dealloc]; } -- (void)process_dialog: (Lisp_Object) list +- (void) processMenuItems: (Lisp_Object) menu_items + used: (ptrdiff_t) menu_items_used + withErrorOutput: (const char **) error_name { - Lisp_Object item, lst = list; - int row = 0; - int buttons = 0, btnnr = 0; + int i, nb_buttons = 0, row = 0; + Lisp_Object item_name, enable; + + i = MENU_ITEMS_PANE_LENGTH; + *error_name = NULL; - for (; CONSP (lst); lst = XCDR (lst)) + /* Loop over all panes and items, filling in the tree. */ + while (i < menu_items_used) { - item = XCAR (list); - if (CONSP (item)) - ++buttons; - } + item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME); + enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE); - if (buttons > 0) - button_values = xmalloc (buttons * sizeof *button_values); + if (NILP (item_name)) + { + *error_name = "Submenu in dialog items"; + return; + } - for (; CONSP (list); list = XCDR (list)) - { - item = XCAR (list); - if (STRINGP (item)) - { - [self addString: SSDATA (item) row: row++]; - } - else if (CONSP (item)) - { - button_values[btnnr] = XCDR (item); - [self addButton: SSDATA (XCAR (item)) value: btnnr row: row++]; - ++btnnr; - } - else if (NILP (item)) - { - [self addSplit]; - row = 0; - } + if (EQ (item_name, Qquote)) + /* This is the boundary between elements on the left and those + on the right, but that boundary is currently not handled on + NS. */ + continue; + + if (nb_buttons > 9) + { + *error_name = "Too many dialog items"; + return; + } + + [self addButton: SSDATA (item_name) + value: (NSInteger) aref_addr (menu_items, i) + row: row++ + enable: !NILP (enable)]; + + i += MENU_ITEMS_ITEM_LENGTH; + nb_buttons++; } } -- (void)addButton: (char *)str value: (int)tag row: (int)row +- (void) addButton: (char *) str value: (NSInteger) tag + row: (int) row enable: (BOOL) enable { id cell; @@ -1661,7 +1798,8 @@ ns_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents) [matrix addRow]; rows++; } - cell = [matrix cellAtRow: row column: cols-1]; + + cell = [matrix cellAtRow: row column: cols - 1]; [cell setTarget: self]; [cell setAction: @selector (clicked: )]; [cell setTitle: [NSString stringWithUTF8String: str]]; @@ -1671,7 +1809,7 @@ ns_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents) } -- (void)addString: (char *)str row: (int)row +- (void)addString: (char *) str row: (int) row { id cell; @@ -1694,96 +1832,95 @@ ns_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents) } -- (void)clicked: sender +- (void) clicked: sender { NSArray *sellist = nil; - EMACS_INT seltag; + NSUInteger seltag; + Lisp_Object *selarray; sellist = [sender selectedCells]; + if ([sellist count] < 1) return; seltag = [[sellist objectAtIndex: 0] tag]; - dialog_return = button_values[seltag]; - [NSApp stop:self]; + selarray = (void *) seltag; + dialog_return = selarray[MENU_ITEMS_ITEM_VALUE]; + [NSApp stop: self]; } -- (instancetype)initFromContents: (Lisp_Object)contents isQuestion: (BOOL)isQ +- (instancetype) initWithTitle: (char *) title_string + isQuestion: (BOOL) is_question { - Lisp_Object head; [super init]; - if (CONSP (contents)) - { - head = Fcar (contents); - [self process_dialog: Fcdr (contents)]; - } - else - head = contents; + if (title_string) + [title setStringValue: + [NSString stringWithUTF8String: title_string]]; - if (STRINGP (head)) - [title setStringValue: - [NSString stringWithUTF8String: SSDATA (head)]]; - else if (isQ == YES) - [title setStringValue: @"Question"]; + if (is_question) + [command setStringValue: @"Question"]; else - [title setStringValue: @"Information"]; + [command setStringValue: @"Information"]; - { - int i; - NSRect r, s, t; + return self; +} - if (cols == 1 && rows > 1) /* Never told where to split. */ - { - [matrix addColumn]; - for (i = 0; i < rows/2; i++) - { - [matrix putCell: [matrix cellAtRow: (rows+1)/2 column: 0] - atRow: i column: 1]; - [matrix removeRow: (rows+1)/2]; - } - } +- (void) resizeBoundsPriorToDisplay +{ + int i; + NSRect r, s, t; + NSSize csize; - [matrix sizeToFit]; + if (cols == 1 && rows > 1) { - NSSize csize = [matrix cellSize]; - if (csize.width < MINCELLWIDTH) - { - csize.width = MINCELLWIDTH; - [matrix setCellSize: csize]; - [matrix sizeToCells]; - } + [matrix addColumn]; + for (i = 0; i < rows / 2; i++) + { + [matrix putCell: [matrix cellAtRow: (rows + 1) /2 + column: 0] + atRow: i column: 1]; + [matrix removeRow: (rows + 1) / 2]; + } } - [title sizeToFit]; - [command sizeToFit]; + [matrix sizeToFit]; - t = [matrix frame]; - r = [title frame]; - if (r.size.width+r.origin.x > t.size.width+t.origin.x) - { - t.origin.x = r.origin.x; - t.size.width = r.size.width; - } - r = [command frame]; - if (r.size.width+r.origin.x > t.size.width+t.origin.x) - { - t.origin.x = r.origin.x; - t.size.width = r.size.width; - } + csize = [matrix cellSize]; + if (csize.width < MINCELLWIDTH) + { + csize.width = MINCELLWIDTH; + [matrix setCellSize: csize]; + [matrix sizeToCells]; + } - r = [self frame]; - s = [(NSView *)[self contentView] frame]; - r.size.width += t.origin.x+t.size.width +2*SPACER-s.size.width; - r.size.height += t.origin.y+t.size.height+SPACER-s.size.height; - [self setFrame: r display: NO]; - } + [title sizeToFit]; + [command sizeToFit]; - return self; -} + t = [matrix frame]; + r = [title frame]; + if (r.size.width + r.origin.x > t.size.width + t.origin.x) + { + t.origin.x = r.origin.x; + t.size.width = r.size.width; + } + r = [command frame]; + if (r.size.width + r.origin.x > t.size.width + t.origin.x) + { + t.origin.x = r.origin.x; + t.size.width = r.size.width; + } + r = [self frame]; + s = [(NSView *) [self contentView] frame]; + r.size.width += (t.origin.x + t.size.width + + 2 * SPACER - s.size.width); + r.size.height += (t.origin.y + t.size.height + + SPACER - s.size.height); + [self setFrame: r display: NO]; +} - (void)timeout_handler: (NSTimer *)timedEntry { @@ -1801,11 +1938,11 @@ ns_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents) /* We use stop because stopModal/abortModal out of the main loop does not seem to work in 10.6. But as we use stop we must send a real event so the stop is seen and acted upon. */ - [NSApp stop:self]; + [NSApp stop: self]; [NSApp postEvent: nxev atStart: NO]; } -- (Lisp_Object)runDialogAt: (NSPoint)p +- (Lisp_Object) runDialogAt: (NSPoint) p { Lisp_Object ret = Qundefined; @@ -1825,13 +1962,17 @@ ns_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents) [[NSRunLoop currentRunLoop] addTimer: tmo forMode: NSModalPanelRunLoopMode]; } + timer_fired = NO; dialog_return = Qundefined; [NSApp runModalForWindow: self]; ret = dialog_return; - if (! timer_fired) + + if (!timer_fired) { - if (tmo != nil) [tmo invalidate]; /* Cancels timer. */ + if (tmo != nil) + [tmo invalidate]; /* Cancels timer. */ + break; } } diff --git a/src/nsselect.m b/src/nsselect.m index 62c67e7a13e..c46bfeaf42a 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -17,13 +17,11 @@ 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/>. */ -/* -Originally by Carl Edman -Updated by Christian Limpach (chris@nice.ch) -OpenStep/Rhapsody port by Scott Bender (sbender@harmony-ds.com) -macOS/Aqua port by Christophe de Dinechin (descubes@earthlink.net) -GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu) -*/ +/* Originally by Carl Edman + Updated by Christian Limpach (chris@nice.ch) + OpenStep/Rhapsody port by Scott Bender (sbender@harmony-ds.com) + macOS/Aqua port by Christophe de Dinechin (descubes@earthlink.net) + GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu) */ /* This should be the first include, as it may set up #defines affecting interpretation of even the system includes. */ @@ -215,9 +213,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 +301,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 +325,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 +367,7 @@ ns_string_from_pasteboard (id pb) NS_ENDHANDLER return make_string (utfStr, length); +#endif } @@ -483,6 +557,225 @@ nxatoms_of_nsselect (void) nil] retain]; } +static void +ns_decode_data_to_pasteboard (Lisp_Object type, Lisp_Object data, + NSPasteboard *pasteboard) +{ + NSArray *types, *new; + NSMutableArray *temp; + Lisp_Object tem; + specpdl_ref count; +#if !NS_USE_NSPasteboardTypeFileURL + NSURL *url; +#endif + + types = [pasteboard types]; + count = SPECPDL_INDEX (); + + CHECK_SYMBOL (type); + + if (EQ (type, Qstring)) + { + CHECK_STRING (data); + + new = [types arrayByAddingObject: NSPasteboardTypeString]; + + [pasteboard declareTypes: new + owner: nil]; + [pasteboard setString: [NSString stringWithLispString: data] + forType: NSPasteboardTypeString]; + } + else if (EQ (type, Qfile)) + { +#if NS_USE_NSPasteboardTypeFileURL + if (CONSP (data)) + new = [types arrayByAddingObject: NSPasteboardTypeURL]; + else + new = [types arrayByAddingObject: NSPasteboardTypeFileURL]; +#else + new = [types arrayByAddingObject: NSFilenamesPboardType]; +#endif + + [pasteboard declareTypes: new + owner: nil]; + + if (STRINGP (data)) + { +#if NS_USE_NSPasteboardTypeFileURL + [pasteboard setString: [NSString stringWithLispString: data] + forType: NSPasteboardTypeFileURL]; +#else + url = [NSURL URLWithString: [NSString stringWithLispString: data]]; + + if (!url) + signal_error ("Invalid file URL", data); + + [pasteboard setString: [url path] + forType: NSFilenamesPboardType]; +#endif + } + else + { + CHECK_LIST (data); + temp = [[NSMutableArray alloc] init]; + record_unwind_protect_ptr (ns_release_object, temp); + + for (tem = data; CONSP (tem); tem = XCDR (tem)) + { + CHECK_STRING (XCAR (tem)); + + [temp addObject: [NSString stringWithLispString: XCAR (tem)]]; + } + CHECK_LIST_END (tem, data); +#if NS_USE_NSPasteboardTypeFileURL + [pasteboard setPropertyList: temp + /* We have to use this deprecated pasteboard + type, since Apple doesn't let us use + dragImage:at: to drag multiple file URLs. */ + forType: @"NSFilenamesPboardType"]; +#else + [pasteboard setPropertyList: temp + forType: NSFilenamesPboardType]; +#endif + unbind_to (count, Qnil); + } + } + else + signal_error ("Unknown pasteboard type", type); +} + +static void +ns_lisp_to_pasteboard (Lisp_Object object, + NSPasteboard *pasteboard) +{ + Lisp_Object tem, type, data; + + [pasteboard declareTypes: [NSArray array] + owner: nil]; + + CHECK_LIST (object); + for (tem = object; CONSP (tem); tem = XCDR (tem)) + { + maybe_quit (); + + type = Fcar (Fcar (tem)); + data = Fcdr (Fcar (tem)); + + ns_decode_data_to_pasteboard (type, data, pasteboard); + } + CHECK_LIST_END (tem, object); +} + +static NSDragOperation +ns_dnd_action_to_operation (Lisp_Object action) +{ + if (EQ (action, QXdndActionCopy)) + return NSDragOperationCopy; + + if (EQ (action, QXdndActionMove)) + return NSDragOperationMove; + + if (EQ (action, QXdndActionLink)) + return NSDragOperationLink; + + signal_error ("Unsupported drag-and-drop action", action); +} + +static Lisp_Object +ns_dnd_action_from_operation (NSDragOperation operation) +{ + switch (operation) + { + case NSDragOperationCopy: + return QXdndActionCopy; + + case NSDragOperationMove: + return QXdndActionMove; + + case NSDragOperationLink: + return QXdndActionLink; + + case NSDragOperationNone: + return Qnil; + + default: + return QXdndActionPrivate; + } +} + +DEFUN ("ns-begin-drag", Fns_begin_drag, Sns_begin_drag, 3, 6, 0, + doc: /* Begin a drag-and-drop operation on FRAME. + +FRAME must be a window system frame. PBOARD is an alist of (TYPE +. DATA), where TYPE is one of the following data types that determine +the meaning of DATA: + + - `string' means DATA should be a string describing text that will + be dragged to another program. + + - `file' means DATA should be a file URL that will be dragged to + another program. DATA may also be a list of file names; that + means each file in the list will be dragged to another program. + +ACTION is the action that will be taken by the drop target towards the +data inside PBOARD. + +Return the action that the drop target actually chose to perform, or +nil if no action was performed (either because there was no drop +target, or the drop was rejected). If RETURN-FRAME is the symbol +`now', also return any frame that mouse moves into during the +drag-and-drop operation, whilst simultaneously cancelling it. Any +other non-nil value means to do the same, but to wait for the mouse to +leave FRAME first. + +If ALLOW-SAME-FRAME is nil, dropping on FRAME will result in the drop +being ignored. + +FOLLOW-TOOLTIP means the same thing it does in `x-begin-drag'. */) + (Lisp_Object frame, Lisp_Object pboard, Lisp_Object action, + Lisp_Object return_frame, Lisp_Object allow_same_frame, + Lisp_Object follow_tooltip) +{ + struct frame *f, *return_to; + NSPasteboard *pasteboard; + EmacsWindow *window; + NSDragOperation operation; + enum ns_return_frame_mode mode; + Lisp_Object val; + + if (EQ (return_frame, Qnow)) + mode = RETURN_FRAME_NOW; + else if (!NILP (return_frame)) + mode = RETURN_FRAME_EVENTUALLY; + else + mode = RETURN_FRAME_NEVER; + + if (NILP (pboard)) + signal_error ("Empty pasteboard", pboard); + + f = decode_window_system_frame (frame); + pasteboard = [NSPasteboard pasteboardWithName: NSPasteboardNameDrag]; + window = (EmacsWindow *) [FRAME_NS_VIEW (f) window]; + + operation = ns_dnd_action_to_operation (action); + ns_lisp_to_pasteboard (pboard, pasteboard); + + operation = [window beginDrag: operation + forPasteboard: pasteboard + withMode: mode + returnFrameTo: &return_to + prohibitSame: (BOOL) NILP (allow_same_frame) + followTooltip: (BOOL) !NILP (follow_tooltip)]; + + if (return_to) + { + XSETFRAME (val, return_to); + return val; + } + + return ns_dnd_action_from_operation (operation); +} + void syms_of_nsselect (void) { @@ -491,11 +784,19 @@ syms_of_nsselect (void) DEFSYM (QTEXT, "TEXT"); DEFSYM (QFILE_NAME, "FILE_NAME"); + DEFSYM (QTARGETS, "TARGETS"); + DEFSYM (QXdndActionCopy, "XdndActionCopy"); + DEFSYM (QXdndActionMove, "XdndActionMove"); + DEFSYM (QXdndActionLink, "XdndActionLink"); + DEFSYM (QXdndActionPrivate, "XdndActionPrivate"); + DEFSYM (Qnow, "now"); + defsubr (&Sns_disown_selection_internal); defsubr (&Sns_get_selection); defsubr (&Sns_own_selection_internal); defsubr (&Sns_selection_exists_p); defsubr (&Sns_selection_owner_p); + defsubr (&Sns_begin_drag); Vselection_alist = Qnil; staticpro (&Vselection_alist); diff --git a/src/nsterm.h b/src/nsterm.h index 911539844a0..2a4c7571a34 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 @@ -407,23 +408,48 @@ typedef id instancetype; @end #endif +enum ns_return_frame_mode + { + RETURN_FRAME_NEVER, + RETURN_FRAME_EVENTUALLY, + RETURN_FRAME_NOW, + }; + /* EmacsWindow */ @interface EmacsWindow : NSWindow { NSPoint grabOffset; + NSEvent *last_drag_event; + NSDragOperation drag_op; + NSDragOperation selected_op; + + struct frame *dnd_return_frame; + enum ns_return_frame_mode dnd_mode; + BOOL dnd_allow_same_frame; + BOOL dnd_move_tooltip_with_frame; } #ifdef NS_IMPL_GNUSTEP - (NSInteger) orderedIndex; #endif -- (instancetype)initWithEmacsFrame:(struct frame *)f; -- (instancetype)initWithEmacsFrame:(struct frame *)f fullscreen:(BOOL)fullscreen screen:(NSScreen *)screen; -- (void)createToolbar:(struct frame *)f; -- (void)setParentChildRelationships; -- (NSInteger)borderWidth; -- (BOOL)restackWindow:(NSWindow *)win above:(BOOL)above; -- (void)setAppearance; +- (instancetype) initWithEmacsFrame: (struct frame *) f; +- (instancetype) initWithEmacsFrame: (struct frame *) f + fullscreen: (BOOL) fullscreen + screen: (NSScreen *) screen; +- (void) createToolbar: (struct frame *) f; +- (void) setParentChildRelationships; +- (NSInteger) borderWidth; +- (BOOL) restackWindow: (NSWindow *) win above: (BOOL) above; +- (void) setAppearance; +- (void) setLastDragEvent: (NSEvent *) event; +- (NSDragOperation) beginDrag: (NSDragOperation) op + forPasteboard: (NSPasteboard *) pasteboard + withMode: (enum ns_return_frame_mode) mode + returnFrameTo: (struct frame **) frame_return + prohibitSame: (BOOL) prohibit_same_frame + followTooltip: (BOOL) follow_tooltip; +- (BOOL) mustNotDropOn: (NSView *) receiver; @end @@ -441,23 +467,25 @@ typedef id instancetype; #else @interface EmacsView : NSView <NSTextInput> #endif - { +{ #ifdef NS_IMPL_COCOA - char *old_title; - BOOL maximizing_resize; + char *old_title; + BOOL maximizing_resize; #endif - BOOL windowClosing; - NSString *workingText; - BOOL processingCompose; - int fs_state, fs_before_fs, next_maximized; - int maximized_width, maximized_height; - EmacsWindow *nonfs_window; - BOOL fs_is_native; + BOOL font_panel_active; + NSFont *font_panel_result; + BOOL windowClosing; + NSString *workingText; + BOOL processingCompose; + int fs_state, fs_before_fs, next_maximized; + int maximized_width, maximized_height; + EmacsWindow *nonfs_window; + BOOL fs_is_native; @public - struct frame *emacsframe; - int scrollbarsNeedingUpdate; - NSRect ns_userRect; - } + struct frame *emacsframe; + int scrollbarsNeedingUpdate; + NSRect ns_userRect; +} /* AppKit-side interface */ - (instancetype)menuDown: (id)sender; @@ -484,9 +512,10 @@ typedef id instancetype; #ifdef NS_IMPL_GNUSTEP - (void)windowDidMove: (id)sender; #endif +- (Lisp_Object) showFontPanel; - (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 +579,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 */ @@ -570,22 +599,32 @@ typedef id instancetype; ========================================================================== */ @interface EmacsDialogPanel : NSPanel - { - NSTextField *command; - NSTextField *title; - NSMatrix *matrix; - int rows, cols; - BOOL timer_fired, window_closed; - Lisp_Object dialog_return; - Lisp_Object *button_values; - } -- (instancetype)initFromContents: (Lisp_Object)menu isQuestion: (BOOL)isQ; -- (void)process_dialog: (Lisp_Object)list; -- (void)addButton: (char *)str value: (int)tag row: (int)row; -- (void)addString: (char *)str row: (int)row; -- (void)addSplit; -- (Lisp_Object)runDialogAt: (NSPoint)p; -- (void)timeout_handler: (NSTimer *)timedEntry; +{ + NSTextField *command; + NSTextField *title; + NSMatrix *matrix; + int rows, cols; + BOOL timer_fired, window_closed; + Lisp_Object dialog_return; +} + +- (instancetype) initWithTitle: (char *) title_str + isQuestion: (BOOL) is_question; +- (void) processMenuItems: (Lisp_Object) menu_items + used: (ptrdiff_t) menu_items_used + withErrorOutput: (const char **) error_name; + +- (void) addButton: (char *) str + value: (NSInteger) tag + row: (int) row + enable: (BOOL) enable; +- (void) addString: (char *) str + row: (int) row; +- (void) addSplit; +- (void) resizeBoundsPriorToDisplay; + +- (Lisp_Object) runDialogAt: (NSPoint) p; +- (void) timeout_handler: (NSTimer *) timedEntry; @end #ifdef NS_IMPL_COCOA @@ -593,19 +632,21 @@ typedef id instancetype; #else @interface EmacsTooltip : NSObject #endif - { - NSWindow *win; - NSTextField *textField; - NSTimer *timer; - } +{ + NSWindow *win; + NSTextField *textField; + NSTimer *timer; +} + - (instancetype) init; -- (void) setText: (char *)text; -- (void) setBackgroundColor: (NSColor *)col; -- (void) setForegroundColor: (NSColor *)col; -- (void) showAtX: (int)x Y: (int)y for: (int)seconds; +- (void) setText: (char *) text; +- (void) setBackgroundColor: (NSColor *) col; +- (void) setForegroundColor: (NSColor *) col; +- (void) showAtX: (int) x Y: (int) y for: (int) seconds; - (void) hide; - (BOOL) isActive; - (NSRect) frame; +- (void) moveTo: (NSPoint) screen_point; @end @@ -683,6 +724,7 @@ typedef id instancetype; int em_whole; } +- (void) mark; - (instancetype) initFrame: (NSRect )r window: (Lisp_Object)win; - (void)setFrame: (NSRect)r; @@ -697,7 +739,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 +808,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 +833,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 +863,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; @@ -916,6 +927,9 @@ struct ns_output NSColor *cursor_color; NSColor *foreground_color; NSColor *background_color; + NSColor *relief_background_color; + NSColor *light_relief_color; + NSColor *dark_relief_color; EmacsToolbar *toolbar; #else void *view; @@ -923,6 +937,9 @@ struct ns_output void *cursor_color; void *foreground_color; void *background_color; + void *relief_background_color; + void *light_relief_color; + void *dark_relief_color; void *toolbar; #endif @@ -978,6 +995,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,17 +1144,16 @@ 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 /* Implemented in nsfns, published in nsterm. */ +#ifdef __OBJC__ +extern void ns_move_tooltip_to_mouse_location (NSPoint); +#endif extern void ns_implicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval); extern void ns_set_scroll_bar_default_width (struct frame *f); @@ -1201,6 +1223,7 @@ extern size_t ns_image_size_in_bytes (void *img); /* This in nsterm.m */ extern float ns_antialias_threshold; extern void ns_make_frame_visible (struct frame *f); +extern void ns_make_frame_invisible (struct frame *f); extern void ns_iconify_frame (struct frame *f); extern void ns_set_undecorated (struct frame *f, Lisp_Object new_value, Lisp_Object old_value); @@ -1318,6 +1341,7 @@ extern char gnustep_base_version[]; /* version tracking */ #define NSAlertStyleCritical NSCriticalAlertStyle #define NSControlSizeRegular NSRegularControlSize #define NSCompositingOperationCopy NSCompositeCopy +#define NSTextAlignmentRight NSRightTextAlignment /* And adds NSWindowStyleMask. */ #ifdef __OBJC__ @@ -1336,15 +1360,27 @@ enum NSWindowTabbingMode #if !defined (NS_IMPL_COCOA) || !defined (MAC_OS_X_VERSION_10_13) /* Deprecated in macOS 10.13. */ #define NSPasteboardNameGeneral NSGeneralPboard +#define NSPasteboardNameDrag NSDragPboard #endif #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 +#define NSButtonTypeMomentaryPushIn NSMomentaryPushInButton #endif + +extern void mark_nsterm (void); + #endif /* HAVE_NS */ diff --git a/src/nsterm.m b/src/nsterm.m index 40540c47be1..8e0c4b84f0e 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 @@ -78,6 +79,9 @@ static EmacsMenu *dockMenu; static EmacsMenu *mainMenu; #endif +/* The last known monitor attributes list. */ +static Lisp_Object last_known_monitors; + /* ========================================================================== NSTRACE, Trace support. @@ -88,8 +92,8 @@ static EmacsMenu *mainMenu; /* The following use "volatile" since they can be accessed from parallel threads. */ -volatile int nstrace_num = 0; -volatile int nstrace_depth = 0; +volatile int nstrace_num; +volatile int nstrace_depth; /* When 0, no trace is emitted. This is used by NSTRACE_WHEN and NSTRACE_UNLESS to silence functions called. @@ -100,33 +104,41 @@ volatile int nstrace_depth = 0; volatile int nstrace_enabled_global = 1; /* Called when nstrace_enabled goes out of scope. */ -void nstrace_leave(int * pointer_to_nstrace_enabled) +void +nstrace_leave (int *pointer_to_nstrace_enabled) { if (*pointer_to_nstrace_enabled) - { - --nstrace_depth; - } + --nstrace_depth; } /* Called when nstrace_saved_enabled_global goes out of scope. */ -void nstrace_restore_global_trace_state(int * pointer_to_saved_enabled_global) +void +nstrace_restore_global_trace_state (int *pointer_to_saved_enabled_global) { nstrace_enabled_global = *pointer_to_saved_enabled_global; } -char const * nstrace_fullscreen_type_name (int fs_type) +const char * +nstrace_fullscreen_type_name (int fs_type) { switch (fs_type) { - case -1: return "-1"; - case FULLSCREEN_NONE: return "FULLSCREEN_NONE"; - case FULLSCREEN_WIDTH: return "FULLSCREEN_WIDTH"; - case FULLSCREEN_HEIGHT: return "FULLSCREEN_HEIGHT"; - case FULLSCREEN_BOTH: return "FULLSCREEN_BOTH"; - case FULLSCREEN_MAXIMIZED: return "FULLSCREEN_MAXIMIZED"; - default: return "FULLSCREEN_?????"; + case -1: + return "-1"; + case FULLSCREEN_NONE: + return "FULLSCREEN_NONE"; + case FULLSCREEN_WIDTH: + return "FULLSCREEN_WIDTH"; + case FULLSCREEN_HEIGHT: + return "FULLSCREEN_HEIGHT"; + case FULLSCREEN_BOTH: + return "FULLSCREEN_BOTH"; + case FULLSCREEN_MAXIMIZED: + return "FULLSCREEN_MAXIMIZED"; + default: + return "FULLSCREEN_?????"; } } #endif @@ -162,7 +174,28 @@ char const * nstrace_fullscreen_type_name (int fs_type) && NSAppKitVersionNumber >= NSAppKitVersionNumber10_7) return [self colorUsingColorSpace: [NSColorSpace sRGBColorSpace]]; #endif - return [self colorUsingColorSpace: [NSColorSpace deviceRGBColorSpace]]; + return [self colorUsingColorSpace: [NSColorSpace genericRGBColorSpace]]; +} + ++ (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 @@ -325,7 +358,7 @@ mod_of_kind (Lisp_Object modifier, Lisp_Object kind) return modifier; else { - Lisp_Object val = Fplist_get (modifier, kind); + Lisp_Object val = plist_get (modifier, kind); return SYMBOLP (val) ? val : Qnil; } } @@ -407,37 +440,29 @@ ev_modifiers_helper (unsigned int flags, unsigned int left_mask, /* This is a piece of code which is common to all the event handling methods. Maybe it should even be a function. */ -#define EV_TRAILER(e) \ - { \ - XSETFRAME (emacs_event->frame_or_window, emacsframe); \ - EV_TRAILER2 (e); \ +#define EV_TRAILER(e) \ + { \ + XSETFRAME (emacs_event->frame_or_window, emacsframe); \ + EV_TRAILER2 (e); \ } #define EV_TRAILER2(e) \ { \ - if (e) emacs_event->timestamp = EV_TIMESTAMP (e); \ - if (q_event_ptr) \ - { \ - Lisp_Object tem = Vinhibit_quit; \ - Vinhibit_quit = Qt; \ - n_emacs_events_pending++; \ - kbd_buffer_store_event_hold (emacs_event, q_event_ptr); \ - Vinhibit_quit = tem; \ - } \ - else \ - hold_event (emacs_event); \ - EVENT_INIT (*emacs_event); \ - ns_send_appdefined (-1); \ - } - - -/* 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 + if (e) emacs_event->timestamp = EV_TIMESTAMP (e); \ + if (q_event_ptr) \ + { \ + Lisp_Object tem = Vinhibit_quit; \ + Vinhibit_quit = Qt; \ + n_emacs_events_pending++; \ + kbd_buffer_store_event_hold (emacs_event, q_event_ptr); \ + Vinhibit_quit = tem; \ + } \ + else \ + hold_event (emacs_event); \ + EVENT_INIT (*emacs_event); \ + ns_send_appdefined (-1); \ + } + /* TODO: Get rid of need for these forward declarations. */ static void ns_condemn_scroll_bars (struct frame *f); @@ -534,8 +559,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 +571,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); } } @@ -734,7 +762,18 @@ ns_parent_window_rect (struct frame *f) EmacsView *parentView = FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)); parentRect = [parentView convertRect:[parentView frame] toView:nil]; + +#if defined (NS_IMPL_COCOA) && !defined (MAC_OS_X_VERSION_10_7) + parentRect.origin = [[parentView window] convertBaseToScreen:parentRect.origin]; +#elif defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MIN_REQUIRED < 1070 + if ([[parentView window] + respondsToSelector:@selector(convertRectToScreen:)]) + parentRect = [[parentView window] convertRectToScreen:parentRect]; + else + parentRect.origin = [[parentView window] convertBaseToScreen:parentRect.origin]; +#else parentRect = [[parentView window] convertRectToScreen:parentRect]; +#endif } else parentRect = [[[NSScreen screens] objectAtIndex:0] frame]; @@ -771,10 +810,16 @@ ns_row_rect (struct window *w, struct glyph_row *row, double ns_frame_scale_factor (struct frame *f) { -#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED > 1060 - return [[FRAME_NS_VIEW (f) window] backingScaleFactor]; -#else +#if defined (NS_IMPL_GNUSTEP) || !defined (MAC_OS_X_VERSION_10_7) return [[FRAME_NS_VIEW (f) window] userSpaceScaleFactor]; +#elif MAC_OS_X_VERSION_MIN_REQUIRED < 1070 + if ([[FRAME_NS_VIEW (f) window] + respondsToSelector:@selector(backingScaleFactor:)]) + return [[FRAME_NS_VIEW (f) window] backingScaleFactor]; + else + return [[FRAME_NS_VIEW (f) window] userSpaceScaleFactor]; +#else + return [[FRAME_NS_VIEW (f) window] backingScaleFactor]; #endif } @@ -1043,7 +1088,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 +1122,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 +1155,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 } @@ -1478,7 +1528,7 @@ ns_make_frame_visible (struct frame *f) } -static void +void ns_make_frame_invisible (struct frame *f) /* -------------------------------------------------------------------------- Hide the window (X11 semantics) @@ -1595,10 +1645,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]; } @@ -1662,10 +1719,8 @@ ns_set_offset (struct frame *f, int xoff, int yoff, int change_grav) static void -ns_set_window_size (struct frame *f, - bool change_gravity, - int width, - int height) +ns_set_window_size (struct frame *f, bool change_gravity, + int width, int height) /* -------------------------------------------------------------------------- Adjust window pixel size based on native sizes WIDTH and HEIGHT. Impl is a bit more complex than other terms, need to do some @@ -1940,59 +1995,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 +2119,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 +2133,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 +2141,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 +2156,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 +2167,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 +2221,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 +2296,12 @@ 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; +#ifdef NS_IMPL_COCOA + NSPoint screen_position; + NSInteger window_number; + NSWindow *w; +#endif NSTRACE ("ns_mouse_position"); @@ -2344,32 +2328,56 @@ ns_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, This doesn't work on GNUstep, although in recent versions there is compatibility code that makes it a noop. */ - NSPoint screen_position = [NSEvent mouseLocation]; - NSInteger window_number = 0; + screen_position = [NSEvent mouseLocation]; + window_number = 0; + do { - NSWindow *w; + window_number = [NSWindow windowNumberAtPoint: screen_position + belowWindowWithWindowNumber: window_number]; + w = [NSApp windowWithWindowNumber: window_number]; + + if ((EQ (track_mouse, Qdrag_source) + || EQ (track_mouse, Qdropping)) + && w && [[w delegate] isKindOfClass: [EmacsTooltip class]]) + continue; - window_number = [NSWindow windowNumberAtPoint:screen_position - belowWindowWithWindowNumber:window_number]; - w = [NSApp windowWithWindowNumber:window_number]; + if (w && [[w delegate] isKindOfClass: [EmacsView class]]) + f = ((EmacsView *) [w delegate])->emacsframe; + else if (EQ (track_mouse, Qdrag_source)) + break; - if (w && [[w delegate] isKindOfClass:[EmacsView class]]) - f = ((EmacsView *)[w delegate])->emacsframe; + if (f && (EQ (track_mouse, Qdrag_source) + || EQ (track_mouse, Qdropping)) + && FRAME_TOOLTIP_P (f)) + continue; } while (window_number > 0 && !f); #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; + + if (f && FRAME_TOOLTIP_P (f)) + f = dpyinfo->last_mouse_frame; /* 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 +2396,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 +2441,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 +2576,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 +2616,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 +2645,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 +2748,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 +2799,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 +2849,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 +2967,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 +2992,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 +3021,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 +3043,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 +3054,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 +3085,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 +3103,13 @@ 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); + + /* This works like it does in PostScript, not X Windows. */ + [NSBezierPath strokeRect: NSInsetRect (r, 0.5, 0.5)]; break; case HBAR_CURSOR: NSRectFill (r); @@ -3118,12 +3125,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 +3147,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 +3183,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 +3307,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 +3331,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 +3356,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 +3370,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 +3380,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 +3398,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 +3411,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 +3436,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); } } @@ -3464,102 +3475,188 @@ ns_draw_box (NSRect r, CGFloat hthickness, CGFloat vthickness, } } +/* Set up colors for the relief lines around glyph string S. */ + +static void +ns_setup_relief_colors (struct glyph_string *s) +{ + struct ns_output *di = FRAME_OUTPUT_DATA (s->f); + NSColor *color; + + if (s->face->use_box_color_for_shadows_p) + color = [NSColor colorWithUnsignedLong: s->face->box_color]; + else + color = [NSColor colorWithUnsignedLong: s->face->background]; + + if (s->hl == DRAW_CURSOR) + color = FRAME_CURSOR_COLOR (s->f); + + if (color == nil) + color = [NSColor grayColor]; + + if (color != di->relief_background_color) + { + [di->relief_background_color release]; + di->relief_background_color = [color retain]; + [di->light_relief_color release]; + di->light_relief_color = [[color highlightWithLevel: 0.4] retain]; + [di->dark_relief_color release]; + di->dark_relief_color = [[color shadowWithLevel: 0.4] retain]; + } +} static void ns_draw_relief (NSRect outer, int hthickness, int vthickness, char raised_p, - char top_p, char bottom_p, char left_p, char right_p, - struct glyph_string *s) + char top_p, char bottom_p, char left_p, char right_p, + struct glyph_string *s) /* -------------------------------------------------------------------------- Draw a relief rect inside r, optionally leaving some sides open. Note we can't just use an NSDrawBezel command, because of the possibility of some sides not being drawn, and because the rect will be filled. -------------------------------------------------------------------------- */ { - static NSColor *baseCol = nil, *lightCol = nil, *darkCol = nil; - NSColor *newBaseCol = nil; NSRect inner; + NSBezierPath *p = nil; NSTRACE ("ns_draw_relief"); /* set up colors */ + ns_setup_relief_colors (s); - if (s->face->use_box_color_for_shadows_p) - { - newBaseCol = ns_lookup_indexed_color (s->face->box_color, s->f); - } -/* else if (s->first_glyph->type == IMAGE_GLYPH - && s->img->pixmap - && !IMAGE_BACKGROUND_TRANSPARENT (s->img, s->f, 0)) - { - newBaseCol = IMAGE_BACKGROUND (s->img, s->f, 0); - } */ - else + /* Calculate the inner rectangle. */ + inner = outer; + + if (left_p) { - newBaseCol = ns_lookup_indexed_color (s->face->background, s->f); + inner.origin.x += vthickness; + inner.size.width -= vthickness; } - if (newBaseCol == nil) - newBaseCol = [NSColor grayColor]; + if (right_p) + inner.size.width -= vthickness; - if (newBaseCol != baseCol) /* TODO: better check */ + if (top_p) { - [baseCol release]; - baseCol = [newBaseCol retain]; - [lightCol release]; - lightCol = [[baseCol highlightWithLevel: 0.2] retain]; - [darkCol release]; - darkCol = [[baseCol shadowWithLevel: 0.3] retain]; + inner.origin.y += hthickness; + inner.size.height -= hthickness; } - /* Calculate the inner rectangle. */ - inner = NSMakeRect (NSMinX (outer) + (left_p ? hthickness : 0), - NSMinY (outer) + (top_p ? vthickness : 0), - NSWidth (outer) - (left_p ? hthickness : 0) - - (right_p ? hthickness : 0), - NSHeight (outer) - (top_p ? vthickness : 0) - - (bottom_p ? vthickness : 0)); + if (bottom_p) + inner.size.height -= hthickness; + + struct ns_output *di = FRAME_OUTPUT_DATA (s->f); - [(raised_p ? lightCol : darkCol) set]; + [(raised_p ? di->light_relief_color : di->dark_relief_color) set]; if (top_p || left_p) { - NSBezierPath *p = [NSBezierPath bezierPath]; - [p moveToPoint:NSMakePoint (NSMinX (outer), NSMinY (outer))]; + p = [NSBezierPath bezierPath]; + + [p moveToPoint: NSMakePoint (NSMinX (outer), NSMinY (outer))]; if (top_p) { - [p lineToPoint:NSMakePoint (NSMaxX (outer), NSMinY (outer))]; - [p lineToPoint:NSMakePoint (NSMaxX (inner), NSMinY (inner))]; + [p lineToPoint: NSMakePoint (NSMaxX (outer), NSMinY (outer))]; + [p lineToPoint: NSMakePoint (NSMaxX (inner), NSMinY (inner))]; } - [p lineToPoint:NSMakePoint (NSMinX (inner), NSMinY (inner))]; + [p lineToPoint: NSMakePoint (NSMinX (inner), NSMinY (inner))]; if (left_p) { - [p lineToPoint:NSMakePoint (NSMinX (inner), NSMaxY (inner))]; - [p lineToPoint:NSMakePoint (NSMinX (outer), NSMaxY (outer))]; + [p lineToPoint: NSMakePoint (NSMinX (inner), NSMaxY (inner))]; + [p lineToPoint: NSMakePoint (NSMinX (outer), NSMaxY (outer))]; } [p closePath]; [p fill]; } - [(raised_p ? darkCol : lightCol) set]; + [(raised_p ? di->dark_relief_color : di->light_relief_color) set]; - if (bottom_p || right_p) + if (bottom_p || right_p) { - NSBezierPath *p = [NSBezierPath bezierPath]; - [p moveToPoint:NSMakePoint (NSMaxX (outer), NSMaxY (outer))]; + p = [NSBezierPath bezierPath]; + + [p moveToPoint: NSMakePoint (NSMaxX (outer), NSMaxY (outer))]; if (right_p) { - [p lineToPoint:NSMakePoint (NSMaxX (outer), NSMinY (outer))]; - [p lineToPoint:NSMakePoint (NSMaxX (inner), NSMinY (inner))]; + [p lineToPoint: NSMakePoint (NSMaxX (outer), NSMinY (outer))]; + [p lineToPoint: NSMakePoint (NSMaxX (inner), NSMinY (inner))]; } [p lineToPoint:NSMakePoint (NSMaxX (inner), NSMaxY (inner))]; if (bottom_p) { - [p lineToPoint:NSMakePoint (NSMinX (inner), NSMaxY (inner))]; - [p lineToPoint:NSMakePoint (NSMinX (outer), NSMaxY (outer))]; + [p lineToPoint: NSMakePoint (NSMinX (inner), NSMaxY (inner))]; + [p lineToPoint: NSMakePoint (NSMinX (outer), NSMaxY (outer))]; } [p closePath]; [p fill]; } + + /* If one of h/vthickness are more than 1, draw the outermost line + on the respective sides in the black relief color. */ + + if (p) + [p removeAllPoints]; + else + p = [NSBezierPath bezierPath]; + + if (hthickness > 1 && top_p) + { + [p moveToPoint: NSMakePoint (NSMinX (outer), + NSMinY (outer) + 0.5)]; + [p lineToPoint: NSMakePoint (NSMaxX (outer), + NSMinY (outer) + 0.5)]; + } + + if (hthickness > 1 && bottom_p) + { + [p moveToPoint: NSMakePoint (NSMinX (outer), + NSMaxY (outer) - 0.5)]; + [p lineToPoint: NSMakePoint (NSMaxX (outer), + NSMaxY (outer) - 0.5)]; + } + + if (vthickness > 1 && left_p) + { + [p moveToPoint: NSMakePoint (NSMinX (outer) + 0.5, + NSMinY (outer) + 0.5)]; + [p lineToPoint: NSMakePoint (NSMinX (outer) + 0.5, + NSMaxY (outer) - 0.5)]; + } + + if (vthickness > 1 && left_p) + { + [p moveToPoint: NSMakePoint (NSMinX (outer) + 0.5, + NSMinY (outer) + 0.5)]; + [p lineToPoint: NSMakePoint (NSMinX (outer) + 0.5, + NSMaxY (outer) - 0.5)]; + } + + [di->dark_relief_color set]; + [p stroke]; + + if (vthickness > 1 && hthickness > 1) + { + [FRAME_BACKGROUND_COLOR (s->f) set]; + + if (left_p && top_p) + [NSBezierPath fillRect: NSMakeRect (NSMinX (outer), + NSMinY (outer), + 1, 1)]; + + if (right_p && top_p) + [NSBezierPath fillRect: NSMakeRect (NSMaxX (outer) - 1, + NSMinY (outer), + 1, 1)]; + + if (right_p && bottom_p) + [NSBezierPath fillRect: NSMakeRect (NSMaxX (outer) - 1, + NSMaxY (outer) - 1, + 1, 1)]; + + if (left_p && bottom_p) + [NSBezierPath fillRect: NSMakeRect (NSMinX (outer), + NSMaxY (outer) - 1, + 1, 1)]; + } } @@ -3575,17 +3672,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 +3714,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 @@ -3651,6 +3738,7 @@ ns_maybe_dumpglyphs_background (struct glyph_string *s, char force_p) if (!s->background_filled_p/* || s->hl == DRAW_MOUSE_FACE*/) { int box_line_width = max (s->face->box_horizontal_line_width, 0); + if (FONT_HEIGHT (s->font) < s->height - 2 * box_line_width /* When xdisp.c ignores FONT_HEIGHT, we cannot trust font dimensions, since the actual glyphs might be much @@ -3659,40 +3747,118 @@ 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; } } } +static void +ns_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; + 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; + + ns_draw_relief (NSMakeRect (x, y, x1 - x + 1, y1 - y + 1), thick, + thick, raised_p, top_p, bot_p, left_p, right_p, s); +} static void ns_dumpglyphs_image (struct glyph_string *s, NSRect r) @@ -3704,10 +3870,8 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r) int box_line_vwidth = max (s->face->box_horizontal_line_width, 0); int x = s->x, y = s->ybase - image_ascent (s->img, s->face, &s->slice); int bg_x, bg_y, bg_height; - int th; - char raised_p; NSRect br; - struct face *face; + struct face *face = s->face; NSColor *tdCol; NSTRACE ("ns_dumpglyphs_image"); @@ -3728,17 +3892,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,60 +3962,30 @@ 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. */ ns_draw_text_decoration (s, face, tdCol, br.size.width, br.origin.x); - /* Draw relief, if requested */ - if (s->img->relief || s->hl ==DRAW_IMAGE_RAISED || s->hl ==DRAW_IMAGE_SUNKEN) - { - if (s->hl == DRAW_IMAGE_SUNKEN || s->hl == DRAW_IMAGE_RAISED) - { - th = (tool_bar_button_relief < 0 - ? DEFAULT_TOOL_BAR_BUTTON_RELIEF - : min (tool_bar_button_relief, 1000000)); - raised_p = (s->hl == DRAW_IMAGE_RAISED); - } - else - { - th = abs (s->img->relief); - raised_p = (s->img->relief > 0); - } - - r.origin.x = x - th; - r.origin.y = y - th; - r.size.width = s->slice.width + 2*th-1; - r.size.height = s->slice.height + 2*th-1; - ns_draw_relief (r, th, th, raised_p, - s->slice.y == 0, - s->slice.y + s->slice.height == s->img->height, - s->slice.x == 0, - s->slice.x + s->slice.width == s->img->width, 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) + ns_draw_image_relief (s); - /* If there is no mask, the background won't be seen, - so draw a rectangle on the image for the cursor. - Do this for all images, getting transparency right is not reliable. */ + /* If there is no mask, the background won't be seen, so draw a + rectangle on the image for the cursor. Do this for all images, + getting transparency right is not reliable. */ if (s->hl == DRAW_CURSOR) { int thickness = abs (s->img->relief); if (thickness == 0) thickness = 1; - ns_draw_box (br, thickness, thickness, FRAME_CURSOR_COLOR (s->f), 1, 1); + ns_draw_box (br, thickness, thickness, + FRAME_CURSOR_COLOR (s->f), 1, 1); } } @@ -3868,66 +3993,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); + bgCol = [NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND (face)]; + fgCol = [NSColor colorWithUnsignedLong:NS_FACE_FOREGROUND (face)]; - glyphRect = NSMakeRect (s->x, s->y, s->background_width, s->height); - - [bgCol set]; - - /* NOTE: under NS this is NOT used to draw cursors, but we must avoid - overwriting cursor (usually when cursor on a tab) */ if (s->hl == DRAW_CURSOR) - { - CGFloat x, width; + { + 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 +4034,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 +4045,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); } @@ -4049,6 +4141,85 @@ ns_draw_composite_glyph_string_foreground (struct glyph_string *s) } } +/* Draw the foreground of glyph string S for glyphless characters. */ +static void +ns_draw_glyphless_glyph_string_foreground (struct glyph_string *s) +{ + struct glyph *glyph = s->first_glyph; + NSGlyph 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++) + { + char buf[7]; + 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) + ns_draw_box (NSMakeRect (x, s->ybase - glyph->ascent, + glyph->pixel_width - 1, + glyph->ascent + glyph->descent - 1), + 1, 1, + [NSColor colorWithUnsignedLong:NS_FACE_FOREGROUND (s->face)], + YES, YES); + x += glyph->pixel_width; + } + + /* GCC 12 complains even though nothing ever uses s->char2b after + this function returns. */ + s->char2b = NULL; +} + static void ns_draw_glyph_string (struct glyph_string *s) /* -------------------------------------------------------------------------- @@ -4062,9 +4233,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 +4245,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 +4272,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,67 +4299,41 @@ 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; else ns_maybe_dumpglyphs_background (s, s->first_glyph->type == COMPOSITE_GLYPH); - /* ... */ - /* Not yet implemented. */ - /* ... */ - ns_unfocus (s->f); + ns_draw_glyphless_glyph_string_foreground (s); break; default: @@ -4190,13 +4342,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; } @@ -4305,11 +4546,14 @@ check_native_fs () static int -ns_read_socket (struct terminal *terminal, struct input_event *hold_quit) +ns_read_socket_1 (struct terminal *terminal, struct input_event *hold_quit, + BOOL no_release) /* -------------------------------------------------------------------------- External (hook): Post an event to ourself and keep reading events until we read it back again. In effect process all events which were waiting. From 21+ we have to manage the event buffer ourselves. + + NO_RELEASE means not to touch the global autorelease pool. -------------------------------------------------------------------------- */ { struct input_event ev; @@ -4340,11 +4584,14 @@ ns_read_socket (struct terminal *terminal, struct input_event *hold_quit) ns_init_events (&ev); q_event_ptr = hold_quit; - /* We manage autorelease pools by allocate/reallocate each time around - the loop; strict nesting is occasionally violated but seems not to - matter... earlier methods using full nesting caused major memory leaks. */ - [outerpool release]; - outerpool = [[NSAutoreleasePool alloc] init]; + if (!no_release) + { + /* We manage autorelease pools by allocate/reallocate each time around + the loop; strict nesting is occasionally violated but seems not to + matter... earlier methods using full nesting caused major memory leaks. */ + [outerpool release]; + outerpool = [[NSAutoreleasePool alloc] init]; + } /* If have pending open-file requests, attend to the next one of those. */ if (ns_pending_files && [ns_pending_files count] != 0 @@ -4383,11 +4630,17 @@ ns_read_socket (struct terminal *terminal, struct input_event *hold_quit) return nevents; } +static int +ns_read_socket (struct terminal *terminal, struct input_event *hold_quit) +{ + return ns_read_socket_1 (terminal, hold_quit, NO); +} -int -ns_select (int nfds, fd_set *readfds, fd_set *writefds, - fd_set *exceptfds, struct timespec *timeout, - sigset_t *sigmask) + +static int +ns_select_1 (int nfds, fd_set *readfds, fd_set *writefds, + fd_set *exceptfds, struct timespec *timeout, + sigset_t *sigmask, BOOL run_loop_only) /* -------------------------------------------------------------------------- Replacement for select, checking for events -------------------------------------------------------------------------- */ @@ -4403,7 +4656,7 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds, check_native_fs (); #endif - if (hold_event_q.nr > 0) + if (hold_event_q.nr > 0 && !run_loop_only) { /* We already have events pending. */ raise (SIGIO); @@ -4421,12 +4674,12 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds, if (NSApp == nil || ![NSThread isMainThread] || (timeout && timeout->tv_sec == 0 && timeout->tv_nsec == 0)) - return thread_select(pselect, nfds, readfds, writefds, - exceptfds, timeout, sigmask); + return thread_select (pselect, nfds, readfds, writefds, + exceptfds, timeout, sigmask); else { struct timespec t = {0, 0}; - thread_select(pselect, 0, NULL, NULL, NULL, &t, sigmask); + thread_select (pselect, 0, NULL, NULL, NULL, &t, sigmask); } /* FIXME: This draining of outerpool causes a crash when a buffer @@ -4544,9 +4797,18 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds, return result; } +int +ns_select (int nfds, fd_set *readfds, fd_set *writefds, + fd_set *exceptfds, struct timespec *timeout, + sigset_t *sigmask) +{ + return ns_select_1 (nfds, readfds, writefds, exceptfds, + timeout, sigmask, NO); +} + #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 +5189,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,11 +5206,33 @@ ns_default_font_parameter (struct frame *f, Lisp_Object parms) { } -/* 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 - interface. In addition, many of the ns_ methods have code that is - shared with all terms, indicating need for further refactoring. */ +#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 + +static void +ns_flush_display (struct frame *f) +{ + struct input_event ie; + + EVENT_INIT (ie); + ns_read_socket_1 (FRAME_TERMINAL (f), &ie, YES); +} + +/* 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 interface. In addition, many of the ns_ methods have + code that is shared with all terms, indicating need for further + refactoring. */ extern frame_parm_handler ns_frame_parm_handlers[]; static struct redisplay_interface ns_redisplay_interface = { @@ -4962,8 +5244,12 @@ 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 */ - 0, /* flush_display */ +#else + ns_update_window_end, +#endif + ns_flush_display, gui_clear_window_mouse_face, gui_get_glyph_overhangs, gui_fix_overlapping_area, @@ -4984,6 +5270,39 @@ static struct redisplay_interface ns_redisplay_interface = ns_default_font_parameter }; +#ifdef NS_IMPL_COCOA +static void +ns_displays_reconfigured (CGDirectDisplayID display, + CGDisplayChangeSummaryFlags flags, + void *user_info) +{ + struct input_event ie; + union buffered_input_event *ev; + Lisp_Object new_monitors; + + EVENT_INIT (ie); + + new_monitors = Fns_display_monitor_attributes_list (Qnil); + + if (!NILP (Fequal (new_monitors, last_known_monitors))) + return; + + last_known_monitors = new_monitors; + + ev = (kbd_store_ptr == kbd_buffer + ? kbd_buffer + KBD_BUFFER_SIZE - 1 + : kbd_store_ptr - 1); + + if (kbd_store_ptr != kbd_fetch_ptr + && ev->ie.kind == MONITORS_CHANGED_EVENT) + return; + + ie.kind = MONITORS_CHANGED_EVENT; + XSETTERMINAL (ie.arg, x_display_list->terminal); + + kbd_buffer_store_event (&ie); +} +#endif static void ns_delete_display (struct ns_display_info *dpyinfo) @@ -5201,11 +5520,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]]; } @@ -5341,6 +5658,16 @@ ns_term_init (Lisp_Object display_name) catch_child_signal (); #endif +#ifdef NS_IMPL_COCOA + /* Begin listening for display reconfiguration, so we can run the + appropriate hooks. FIXME: is this called when the resolution of + a monitor changes? */ + + CGDisplayRegisterReconfigurationCallback (ns_displays_reconfigured, + NULL); +#endif + last_known_monitors = Fns_display_monitor_attributes_list (Qnil); + NSTRACE_MSG ("ns_term_init done"); unblock_input (); @@ -5352,20 +5679,21 @@ ns_term_init (Lisp_Object display_name) void ns_term_shutdown (int sig) { + NSAutoreleasePool *pool; + /* We also need an autorelease pool here, since this can be called + during dumping. */ + pool = [[NSAutoreleasePool alloc] init]; [[NSUserDefaults standardUserDefaults] synchronize]; + [pool release]; /* code not reached in emacs.c after this is called by shut_down_emacs: */ if (STRINGP (Vauto_save_list_file_name)) unlink (SSDATA (Vauto_save_list_file_name)); if (sig == 0 || sig == SIGTERM) - { - [NSApp terminate: NSApp]; - } - else // force a stack trace to happen - { - emacs_abort (); - } + [NSApp terminate: NSApp]; + else /* Force a stack trace to happen. */ + emacs_abort (); } @@ -5380,6 +5708,10 @@ ns_term_shutdown (int sig) - (id)init { +#ifdef NS_IMPL_GNUSTEP + NSNotificationCenter *notification_center; +#endif + NSTRACE ("[EmacsApp init]"); if ((self = [super init])) @@ -5392,6 +5724,14 @@ ns_term_shutdown (int sig) #endif } +#ifdef NS_IMPL_GNUSTEP + notification_center = [NSNotificationCenter defaultCenter]; + [notification_center addObserver: self + selector: @selector(updateMonitors:) + name: NSApplicationDidChangeScreenParametersNotification + object: nil]; +#endif + return self; } @@ -5404,11 +5744,11 @@ ns_term_shutdown (int sig) #define NSAppKitVersionNumber10_9 1265 #endif - if ((int)NSAppKitVersionNumber != NSAppKitVersionNumber10_9) - { - [super run]; - return; - } + if ((int) NSAppKitVersionNumber != NSAppKitVersionNumber10_9) + { + [super run]; + return; + } NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init]; @@ -5592,6 +5932,36 @@ ns_term_shutdown (int sig) return YES; } +#ifdef NS_IMPL_GNUSTEP +- (void) updateMonitors: (NSNotification *) notification +{ + struct input_event ie; + union buffered_input_event *ev; + Lisp_Object new_monitors; + + EVENT_INIT (ie); + + new_monitors = Fns_display_monitor_attributes_list (Qnil); + + if (!NILP (Fequal (new_monitors, last_known_monitors))) + return; + + last_known_monitors = new_monitors; + + ev = (kbd_store_ptr == kbd_buffer + ? kbd_buffer + KBD_BUFFER_SIZE - 1 + : kbd_store_ptr - 1); + + if (kbd_store_ptr != kbd_fetch_ptr + && ev->ie.kind == MONITORS_CHANGED_EVENT) + return; + + ie.kind = MONITORS_CHANGED_EVENT; + XSETTERMINAL (ie.arg, x_display_list->terminal); + + kbd_buffer_store_event (&ie); +} +#endif /* ************************************************************************** @@ -5870,7 +6240,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; } @@ -5976,6 +6346,123 @@ not_in_argv (NSString *arg) @end /* EmacsApp */ +static Lisp_Object +ns_font_desc_to_font_spec (NSFontDescriptor *desc, NSFont *font) +{ + NSFontSymbolicTraits traits = [desc symbolicTraits]; + NSDictionary *dict = [desc objectForKey: NSFontTraitsAttribute]; + NSString *family = [font familyName]; + Lisp_Object lwidth, lslant, lweight, lheight; + NSNumber *tem; + + lwidth = Qnil; + lslant = Qnil; + lweight = Qnil; + lheight = Qnil; + + if (traits & NSFontBoldTrait) + lweight = Qbold; + + if (traits & NSFontItalicTrait) + lslant = Qitalic; + + if (traits & NSFontCondensedTrait) + lwidth = Qcondensed; + else if (traits & NSFontExpandedTrait) + lwidth = Qexpanded; + + if (dict != nil) + { + tem = [dict objectForKey: NSFontSlantTrait]; + + if (tem != nil) + lslant = ([tem floatValue] > 0 + ? Qitalic : ([tem floatValue] < 0 + ? Qreverse_italic + : Qnormal)); + + tem = [dict objectForKey: NSFontWeightTrait]; + +#ifdef NS_IMPL_GNUSTEP + if (tem != nil) + lweight = ([tem floatValue] > 0 + ? Qbold : ([tem floatValue] < -0.4f + ? Qlight : Qnormal)); +#else + if (tem != nil) + { + if ([tem floatValue] >= 0.4) + lweight = Qbold; + else if ([tem floatValue] >= 0.24) + lweight = Qmedium; + else if ([tem floatValue] >= 0) + lweight = Qnormal; + else if ([tem floatValue] >= -0.24) + lweight = Qsemi_light; + else + lweight = Qlight; + } +#endif + + tem = [dict objectForKey: NSFontWidthTrait]; + + if (tem != nil) + lwidth = ([tem floatValue] > 0 + ? Qexpanded : ([tem floatValue] < 0 + ? Qcondensed : Qnormal)); + } + + lheight = make_float ([font pointSize]); + + return CALLN (Ffont_spec, + QCwidth, lwidth, QCslant, lslant, + QCweight, lweight, QCsize, lheight, + QCfamily, (family + ? [family lispString] + : Qnil)); +} + +#ifdef NS_IMPL_COCOA +static NSView * +ns_create_font_panel_buttons (id target, SEL select, SEL cancel_action) +{ + NSMatrix *matrix; + NSButtonCell *prototype; + NSSize cell_size; + NSRect frame; + NSButtonCell *cancel, *ok; + + prototype = [[NSButtonCell alloc] init]; + [prototype setBezelStyle: NSBezelStyleRounded]; + [prototype setTitle: @"Cancel"]; + cell_size = [prototype cellSize]; + frame = NSMakeRect (0, 0, cell_size.width * 2, + cell_size.height); + matrix = [[NSMatrix alloc] initWithFrame: frame + mode: NSTrackModeMatrix + prototype: prototype + numberOfRows: 1 + numberOfColumns: 2]; + [prototype release]; + + ok = (NSButtonCell *) [matrix cellAtRow: 0 column: 0]; + cancel = (NSButtonCell *) [matrix cellAtRow: 0 column: 1]; + + [ok setTitle: @"OK"]; + [ok setTarget: target]; + [ok setAction: select]; + [ok setButtonType: NSButtonTypeMomentaryPushIn]; + + [cancel setTitle: @"Cancel"]; + [cancel setTarget: target]; + [cancel setAction: cancel_action]; + [cancel setButtonType: NSButtonTypeMomentaryPushIn]; + + [matrix selectCell: ok]; + + return matrix; +} +#endif /* ========================================================================== @@ -6012,42 +6499,129 @@ not_in_argv (NSString *arg) /* Called on font panel selection. */ -- (void)changeFont: (id)sender +- (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; + struct font *font = FRAME_OUTPUT_DATA (emacsframe)->font; NSFont *nsfont; - NSTRACE ("[EmacsView changeFont:]"); +#ifdef NS_IMPL_GNUSTEP + nsfont = ((struct nsfont_info *) font)->nsfont; +#else + nsfont = (NSFont *) macfont_get_nsctfont (font); +#endif - if (!emacs_event) + if (!font_panel_active) return; -#ifdef NS_IMPL_GNUSTEP - nsfont = ((struct nsfont_info *)font)->nsfont; + if (font_panel_result) + [font_panel_result release]; + + font_panel_result = (NSFont *) [sender convertFont: nsfont]; + + if (font_panel_result) + [font_panel_result retain]; + +#ifndef NS_IMPL_COCOA + font_panel_active = NO; + [NSApp stop: self]; #endif +} + #ifdef NS_IMPL_COCOA - nsfont = (NSFont *) macfont_get_nsctfont (font); -#endif +- (void) noteUserSelectedFont +{ + font_panel_active = NO; - if ((newFont = [sender convertFont: nsfont])) - { - SET_FRAME_GARBAGED (emacsframe); /* now needed as of 2008/10 */ + /* If no font was previously selected, use the currently selected + font. */ - emacs_event->kind = NS_NONKEY_EVENT; - emacs_event->modifiers = 0; - emacs_event->code = KEY_NS_CHANGE_FONT; + if (!font_panel_result && FRAME_FONT (emacsframe)) + { + font_panel_result + = macfont_get_nsctfont (FRAME_FONT (emacsframe)); - size = [newFont pointSize]; - ns_input_fontsize = make_fixnum (lrint (size)); - ns_input_font = [[newFont familyName] lispString]; - EV_TRAILER (e); + if (font_panel_result) + [font_panel_result retain]; } + + [NSApp stop: self]; } +- (void) noteUserCancelledSelection +{ + font_panel_active = NO; + + if (font_panel_result) + [font_panel_result release]; + font_panel_result = nil; + + [NSApp stop: self]; +} +#endif + +- (Lisp_Object) showFontPanel +{ + id fm = [NSFontManager sharedFontManager]; + struct font *font = FRAME_OUTPUT_DATA (emacsframe)->font; + NSFont *nsfont, *result; + struct timespec timeout; +#ifdef NS_IMPL_COCOA + NSView *buttons; + BOOL canceled; +#endif + +#ifdef NS_IMPL_GNUSTEP + nsfont = ((struct nsfont_info *) font)->nsfont; +#else + nsfont = (NSFont *) macfont_get_nsctfont (font); +#endif + +#ifdef NS_IMPL_COCOA + buttons + = ns_create_font_panel_buttons (self, + @selector (noteUserSelectedFont), + @selector (noteUserCancelledSelection)); + [[fm fontPanel: YES] setAccessoryView: buttons]; + [buttons release]; +#endif + + [fm setSelectedFont: nsfont isMultiple: NO]; + [fm orderFrontFontPanel: NSApp]; + + font_panel_active = YES; + timeout = make_timespec (0, 100000000); + + block_input (); + while (font_panel_active +#ifdef NS_IMPL_COCOA + && (canceled = [[fm fontPanel: YES] isVisible]) +#else + && [[fm fontPanel: YES] isVisible] +#endif + ) + ns_select_1 (0, NULL, NULL, NULL, &timeout, NULL, YES); + unblock_input (); + + if (font_panel_result) + [font_panel_result autorelease]; + +#ifdef NS_IMPL_COCOA + if (!canceled) + font_panel_result = nil; +#endif + + result = font_panel_result; + font_panel_result = nil; + + [[fm fontPanel: YES] setIsVisible: NO]; + font_panel_active = NO; + + if (result) + return ns_font_desc_to_font_spec ([result fontDescriptor], + result); + + return Qnil; +} - (BOOL)acceptsFirstResponder { @@ -6055,7 +6629,6 @@ not_in_argv (NSString *arg) return YES; } - - (void)resetCursorRects { NSRect visible = [self visibleRect]; @@ -6189,9 +6762,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. */ @@ -6530,17 +7105,24 @@ not_in_argv (NSString *arg) { struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (emacsframe); NSPoint p = [self convertPoint: [theEvent locationInWindow] fromView: nil]; + EmacsWindow *window; NSTRACE ("[EmacsView mouseDown:]"); if (!emacs_event) return; + if (FRAME_TOOLTIP_P (emacsframe)) + return; + dpyinfo->last_mouse_frame = emacsframe; /* Appears to be needed to prevent spurious movement events generated on button clicks. */ emacsframe->mouse_moved = 0; + window = (EmacsWindow *) [self window]; + [window setLastDragEvent: theEvent]; + if ([theEvent type] == NSEventTypeScrollWheel) { #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 @@ -6561,8 +7143,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 +7195,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 +7247,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) | @@ -6694,7 +7315,8 @@ not_in_argv (NSString *arg) tab_bar_p = EQ (window, emacsframe->tab_bar_window); if (tab_bar_p) - tab_bar_arg = handle_tab_bar_click (emacsframe, x, y, EV_UDMODIFIERS (theEvent) & down_modifier, + tab_bar_arg = handle_tab_bar_click (emacsframe, x, y, + EV_UDMODIFIERS (theEvent) & down_modifier, EV_MODIFIERS (theEvent) | EV_UDMODIFIERS (theEvent)); } @@ -6704,6 +7326,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)); @@ -6764,6 +7391,9 @@ not_in_argv (NSString *arg) NSPoint pt; BOOL dragging; + if (FRAME_TOOLTIP_P (emacsframe)) + return; + NSTRACE_WHEN (NSTRACE_GROUP_EVENTS, "[EmacsView mouseMoved:]"); dpyinfo->last_mouse_movement_time = EV_TIMESTAMP (e); @@ -6792,6 +7422,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 +7476,42 @@ not_in_argv (NSString *arg) [self mouseMoved: e]; } +#if defined NS_IMPL_COCOA && defined MAC_OS_X_VERSION_10_7 +- (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 +7671,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 +7696,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 +7707,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 +7740,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 +7815,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 +8221,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 +8240,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 +8479,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 +8495,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 +8508,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 +8518,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 +8539,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 @@ -7998,36 +8632,113 @@ not_in_argv (NSString *arg) -(NSDragOperation) draggingEntered: (id <NSDraggingInfo>) sender { + id source; + NSTRACE ("[EmacsView draggingEntered:]"); + + source = [sender draggingSource]; + + if (source && [source respondsToSelector: @selector(mustNotDropOn:)] + && [source mustNotDropOn: self]) + return NSDragOperationNone; + return NSDragOperationGeneric; } --(BOOL)prepareForDragOperation: (id <NSDraggingInfo>) sender +-(BOOL) prepareForDragOperation: (id <NSDraggingInfo>) sender { + id source; + + source = [sender draggingSource]; + + if (source && [source respondsToSelector: @selector(mustNotDropOn:)] + && [source mustNotDropOn: self]) + return NO; + return YES; } +- (BOOL) wantsPeriodicDraggingUpdates +{ + return YES; +} --(BOOL)performDragOperation: (id <NSDraggingInfo>) sender +- (NSDragOperation) draggingUpdated: (id <NSDraggingInfo>) sender { - id pb; +#ifdef NS_IMPL_GNUSTEP + struct input_event ie; +#else + Lisp_Object frame; +#endif + NSPoint position; + int x, y; + NSAutoreleasePool *ap; + specpdl_ref count; + + ap = [[NSAutoreleasePool alloc] init]; + count = SPECPDL_INDEX (); + record_unwind_protect_ptr (ns_release_autorelease_pool, ap); + +#ifdef NS_IMPL_GNUSTEP + EVENT_INIT (ie); + ie.kind = DRAG_N_DROP_EVENT; +#endif + + /* 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); + +#ifdef NS_IMPL_GNUSTEP + 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); +#else + /* Input events won't be processed until the drop happens on macOS, + so call this function instead. */ + XSETFRAME (frame, emacsframe); + + safe_call (4, Vns_drag_motion_function, frame, + make_fixnum (x), make_fixnum (y)); + + redisplay (); +#endif + + unbind_to (count, Qnil); + return NSDragOperationGeneric; +} + +- (BOOL) performDragOperation: (id <NSDraggingInfo>) sender +{ + id pb, source; int x, y; NSString *type; - NSEvent *theEvent = [[self window] currentEvent]; NSPoint position; NSDragOperation op = [sender draggingSourceOperationMask]; Lisp_Object operations = Qnil; Lisp_Object strings = Qnil; Lisp_Object type_sym; + struct input_event ie; - NSTRACE ("[EmacsView performDragOperation:]"); + NSTRACE (@"[EmacsView performDragOperation:]"); - if (!emacs_event) + source = [sender draggingSource]; + + if (source && [source respondsToSelector: @selector(mustNotDropOn:)] + && [source mustNotDropOn: self]) return NO; position = [self convertPoint: [sender draggingLocation] fromView: nil]; - x = lrint (position.x); y = lrint (position.y); + x = lrint (position.x); + y = lrint (position.y); pb = [sender draggingPasteboard]; type = [pb availableTypeFromArray: ns_drag_types]; @@ -8043,11 +8754,9 @@ not_in_argv (NSString *arg) if (op & NSDragOperationGeneric || NILP (operations)) operations = Fcons (Qns_drag_operation_generic, operations); - if (type == 0) - { - return NO; - } -#if NS_USE_NSPasteboardTypeFileURL != 0 + if (!type) + return NO; +#if NS_USE_NSPasteboardTypeFileURL else if ([type isEqualToString: NSPasteboardTypeFileURL]) { type_sym = Qfile; @@ -8062,18 +8771,29 @@ not_in_argv (NSString *arg) #else // !NS_USE_NSPasteboardTypeFileURL else if ([type isEqualToString: NSFilenamesPboardType]) { - NSArray *files; + id files; NSEnumerator *fenum; NSString *file; - if (!(files = [pb propertyListForType: type])) + files = [pb propertyListForType: type]; + + if (!files) return NO; type_sym = Qfile; - fenum = [files objectEnumerator]; - while ( (file = [fenum nextObject]) ) - strings = Fcons ([file lispString], strings); + /* On GNUstep, files might be a string. */ + + if ([files respondsToSelector: @selector (objectEnumerator:)]) + { + fenum = [files objectEnumerator]; + + while ((file = [fenum nextObject])) + strings = Fcons ([file lispString], strings); + } + else + /* Then `files' is an NSString. */ + strings = list1 ([files lispString]); } #endif // !NS_USE_NSPasteboardTypeFileURL else if ([type isEqualToString: NSPasteboardTypeURL]) @@ -8090,29 +8810,26 @@ not_in_argv (NSString *arg) { NSString *data; - if (! (data = [pb stringForType: type])) + data = [pb stringForType: type]; + + if (!data) return NO; type_sym = Qnil; - strings = list1 ([data lispString]); } else - { - fputs ("Invalid data type in dragging pasteboard\n", stderr); - return NO; - } - - emacs_event->kind = DRAG_N_DROP_EVENT; - XSETINT (emacs_event->x, x); - XSETINT (emacs_event->y, y); - emacs_event->modifiers = 0; + return NO; - emacs_event->arg = Fcons (type_sym, - Fcons (operations, - strings)); - EV_TRAILER (theEvent); + EVENT_INIT (ie); + ie.kind = DRAG_N_DROP_EVENT; + ie.arg = Fcons (type_sym, Fcons (operations, + strings)); + XSETINT (ie.x, x); + XSETINT (ie.y, y); + XSETFRAME (ie.frame_or_window, emacsframe); + kbd_buffer_store_event (&ie); return YES; } @@ -8219,36 +8936,48 @@ not_in_argv (NSString *arg) @implementation EmacsWindow -- (instancetype) initWithEmacsFrame:(struct frame *)f +- (instancetype) initWithEmacsFrame: (struct frame *) f { return [self initWithEmacsFrame:f fullscreen:NO screen:nil]; } -- (instancetype) initWithEmacsFrame:(struct frame *)f - fullscreen:(BOOL)fullscreen - screen:(NSScreen *)screen +- (instancetype) initWithEmacsFrame: (struct frame *) f + fullscreen: (BOOL) fullscreen + screen: (NSScreen *) screen { NSWindowStyleMask styleMask; + int width, height; NSTRACE ("[EmacsWindow initWithEmacsFrame:fullscreen:screen:]"); if (fullscreen) styleMask = NSWindowStyleMaskBorderless; else if (FRAME_UNDECORATED (f)) - styleMask = FRAME_UNDECORATED_FLAGS; + { + styleMask = NSWindowStyleMaskBorderless; +#ifdef NS_IMPL_COCOA + styleMask |= NSWindowStyleMaskResizable; +#endif + } + else if (f->tooltip) + styleMask = 0; else - styleMask = FRAME_DECORATED_FLAGS; + styleMask = (NSWindowStyleMaskTitled + | NSWindowStyleMaskResizable + | NSWindowStyleMaskMiniaturizable + | NSWindowStyleMaskClosable); + + last_drag_event = nil; + width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, f->text_cols); + height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, f->text_lines); - self = [super initWithContentRect: - NSMakeRect (0, 0, - FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, f->text_cols), - FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, f->text_lines)) - styleMask:styleMask - backing:NSBackingStoreBuffered - defer:YES - screen:screen]; + self = [super initWithContentRect: NSMakeRect (0, 0, width, height) + styleMask: styleMask + backing: NSBackingStoreBuffered + defer: YES + screen: screen]; if (self) { NSString *name; @@ -8304,9 +9033,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 +9064,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); @@ -8357,6 +9085,11 @@ not_in_argv (NSString *arg) /* We need to release the toolbar ourselves. */ [[self toolbar] release]; + + /* Also the last button press event . */ + if (last_drag_event) + [last_drag_event release]; + [super dealloc]; } @@ -8388,7 +9121,7 @@ not_in_argv (NSString *arg) expected later. */ #if MAC_OS_X_VERSION_MIN_REQUIRED < 101000 - if ([child respondsToSelector:@selector(setAccessibilitySubrole:)]) + if ([self respondsToSelector:@selector(setAccessibilitySubrole:)]) #endif /* Set the accessibility subroles. */ if (parentFrame) @@ -8399,6 +9132,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 @@ -8411,7 +9153,7 @@ not_in_argv (NSString *arg) #ifdef NS_IMPL_COCOA #if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 - if ([ourView respondsToSelector:@selector (toggleFullScreen)] + if ([ourView respondsToSelector:@selector (toggleFullScreen)]) #endif /* If we are the descendent of a fullscreen window and we have no new parent, go fullscreen. */ @@ -8436,11 +9178,11 @@ not_in_argv (NSString *arg) #ifdef NS_IMPL_COCOA #if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 - if ([ourView respondsToSelector:@selector (toggleFullScreen)] + if ([ourView respondsToSelector:@selector (toggleFullScreen)]) #endif - /* Child frames must not be fullscreen. */ - if ([ourView fsIsNative] && [ourView isFullscreen]) - [ourView toggleFullScreen:self]; + /* Child frames must not be fullscreen. */ + if ([ourView fsIsNative] && [ourView isFullscreen]) + [ourView toggleFullScreen:self]; #endif [parentWindow addChildWindow:self @@ -8872,6 +9614,153 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) return YES; } +- (void) setLastDragEvent: (NSEvent *) event +{ + if (last_drag_event) + [last_drag_event release]; + last_drag_event = [event copy]; +} + +- (NSDragOperation) draggingSourceOperationMaskForLocal: (BOOL) is_local +{ + return drag_op; +} + +- (void) draggedImage: (NSImage *) image + endedAt: (NSPoint) screen_point + operation: (NSDragOperation) operation +{ + selected_op = operation; +} + +- (void) draggedImage: (NSImage *) dragged_image + movedTo: (NSPoint) screen_point +{ + NSPoint mouse_loc; +#ifdef NS_IMPL_COCOA + NSInteger window_number; + NSWindow *w; +#endif + + mouse_loc = [NSEvent mouseLocation]; + +#ifdef NS_IMPL_COCOA + if (dnd_mode != RETURN_FRAME_NEVER) + { + window_number = [NSWindow windowNumberAtPoint: mouse_loc + belowWindowWithWindowNumber: 0]; + w = [NSApp windowWithWindowNumber: window_number]; + + if (!w || w != self) + dnd_mode = RETURN_FRAME_NOW; + + if (dnd_mode != RETURN_FRAME_NOW + || ![[w delegate] isKindOfClass: [EmacsView class]] + || ((EmacsView *) [w delegate])->emacsframe->tooltip) + goto out; + + dnd_return_frame = ((EmacsView *) [w delegate])->emacsframe; + + /* FIXME: there must be a better way to leave the event loop. */ + [NSException raise: @"" + format: @"Must return DND frame"]; + } + + out: +#endif + + if (dnd_move_tooltip_with_frame) + ns_move_tooltip_to_mouse_location (mouse_loc); +} + +- (BOOL) mustNotDropOn: (NSView *) receiver +{ + return ([receiver window] == self + ? !dnd_allow_same_frame : NO); +} + +- (NSDragOperation) beginDrag: (NSDragOperation) op + forPasteboard: (NSPasteboard *) pasteboard + withMode: (enum ns_return_frame_mode) mode + returnFrameTo: (struct frame **) frame_return + prohibitSame: (BOOL) prohibit_same_frame + followTooltip: (BOOL) follow_tooltip +{ + NSImage *image; +#ifdef NS_IMPL_COCOA + NSInteger window_number; + NSWindow *w; +#endif + drag_op = op; + selected_op = NSDragOperationNone; + image = [[NSImage alloc] initWithSize: NSMakeSize (1.0, 1.0)]; + dnd_mode = mode; + dnd_return_frame = NULL; + dnd_allow_same_frame = !prohibit_same_frame; + dnd_move_tooltip_with_frame = follow_tooltip; + + /* Now draw transparency onto the image. */ + [image lockFocus]; + [[NSColor colorWithUnsignedLong: 0] set]; + NSRectFillUsingOperation (NSMakeRect (0, 0, 1, 1), + NSCompositingOperationCopy); + [image unlockFocus]; + + block_input (); +#ifdef NS_IMPL_COCOA + if (mode == RETURN_FRAME_NOW) + { + window_number = [NSWindow windowNumberAtPoint: [NSEvent mouseLocation] + belowWindowWithWindowNumber: 0]; + w = [NSApp windowWithWindowNumber: window_number]; + + if (w && [[w delegate] isKindOfClass: [EmacsView class]] + && !((EmacsView *) [w delegate])->emacsframe->tooltip) + { + *frame_return = ((EmacsView *) [w delegate])->emacsframe; + [image release]; + unblock_input (); + + return NSDragOperationNone; + } + } + + @try + { +#endif + if (last_drag_event) + [self dragImage: image + at: NSMakePoint (0, 0) + offset: NSMakeSize (0, 0) + event: last_drag_event + pasteboard: pasteboard + source: self + slideBack: NO]; +#ifdef NS_IMPL_COCOA + } + @catch (NSException *e) + { + /* Ignore. This is probably the wrong way to leave the + drag-and-drop run loop. */ + } +#endif + unblock_input (); + + /* The drop happened, so delete the tooltip. */ + if (follow_tooltip) + Fx_hide_tip (); + + /* Assume all buttons have been released since the drag-and-drop + operation is now over. */ + if (!dnd_return_frame) + x_display_list->grabbed = 0; + + [image release]; + + *frame_return = dnd_return_frame; + return selected_op; +} + @end /* EmacsWindow */ @@ -9039,6 +9928,16 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) return ret; } +- (void) mark +{ + if (window) + { + Lisp_Object win; + XSETWINDOW (win, window); + mark_object (win); + } +} + - (void)resetCursorRects { @@ -9372,7 +10271,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 /* ========================================================================== @@ -9780,6 +10679,26 @@ ns_xlfd_to_fontname (const char *xlfd) return ret; } +void +mark_nsterm (void) +{ + NSTRACE ("mark_nsterm"); + Lisp_Object tail, frame; + FOR_EACH_FRAME (tail, frame) + { + struct frame *f = XFRAME (frame); + if (FRAME_NS_P (f)) + { + NSArray *subviews = [[FRAME_NS_VIEW (f) superview] subviews]; + for (int i = [subviews count] - 1; i >= 0; --i) + { + id scroller = [subviews objectAtIndex: i]; + if ([scroller isKindOfClass: [EmacsScroller class]]) + [scroller mark]; + } + } + } +} void syms_of_nsterm (void) @@ -9804,6 +10723,7 @@ syms_of_nsterm (void) DEFSYM (Qns_drag_operation_copy, "ns-drag-operation-copy"); DEFSYM (Qns_drag_operation_link, "ns-drag-operation-link"); DEFSYM (Qns_drag_operation_generic, "ns-drag-operation-generic"); + DEFSYM (Qns_handle_drag_motion, "ns-handle-drag-motion"); Fput (Qalt, Qmodifier_value, make_fixnum (alt_modifier)); Fput (Qhyper, Qmodifier_value, make_fixnum (hyper_modifier)); @@ -9811,117 +10731,117 @@ syms_of_nsterm (void) Fput (Qsuper, Qmodifier_value, make_fixnum (super_modifier)); Fput (Qcontrol, Qmodifier_value, make_fixnum (ctrl_modifier)); - DEFVAR_LISP ("ns-input-file", ns_input_file, - "The file specified in the last NS event."); - ns_input_file =Qnil; + DEFVAR_LISP ("ns-input-font", ns_input_font, + doc: /* The font specified in the last NS event. */); + ns_input_font = Qnil; - DEFVAR_LISP ("ns-working-text", ns_working_text, - "String for visualizing working composition sequence."); - ns_working_text =Qnil; + DEFVAR_LISP ("ns-input-fontsize", ns_input_fontsize, + doc: /* The fontsize specified in the last NS event. */); + ns_input_fontsize = Qnil; - DEFVAR_LISP ("ns-input-font", ns_input_font, - "The font specified in the last NS event."); - ns_input_font =Qnil; + DEFVAR_LISP ("ns-input-line", ns_input_line, + doc: /* The line specified in the last NS event. */); + ns_input_line = Qnil; - DEFVAR_LISP ("ns-input-fontsize", ns_input_fontsize, - "The fontsize specified in the last NS event."); - ns_input_fontsize =Qnil; + DEFVAR_LISP ("ns-input-spi-name", ns_input_spi_name, + doc: /* The service name specified in the last NS event. */); + ns_input_spi_name = Qnil; - DEFVAR_LISP ("ns-input-line", ns_input_line, - "The line specified in the last NS event."); - ns_input_line =Qnil; + DEFVAR_LISP ("ns-input-spi-arg", ns_input_spi_arg, + doc: /* The service argument specified in the last NS event. */); + ns_input_spi_arg = Qnil; - DEFVAR_LISP ("ns-input-spi-name", ns_input_spi_name, - "The service name specified in the last NS event."); - ns_input_spi_name =Qnil; + DEFVAR_LISP ("ns-input-file", ns_input_file, + doc: /* The file specified in the last NS event. */); + ns_input_file = Qnil; - DEFVAR_LISP ("ns-input-spi-arg", ns_input_spi_arg, - "The service argument specified in the last NS event."); - ns_input_spi_arg =Qnil; + DEFVAR_LISP ("ns-working-text", ns_working_text, + doc: /* String for visualizing working composition sequence. */); + ns_working_text = Qnil; DEFVAR_LISP ("ns-alternate-modifier", ns_alternate_modifier, - "This variable describes the behavior of the alternate or option key.\n\ -Either SYMBOL, describing the behavior for any event,\n\ -or (:ordinary SYMBOL :function SYMBOL :mouse SYMBOL), describing behavior\n\ -separately for ordinary keys, function keys, and mouse events.\n\ -\n\ -Each SYMBOL is `control', `meta', `alt', `super', `hyper' or `none'.\n\ -If `none', the key is ignored by Emacs and retains its standard meaning."); + doc: /* This variable describes the behavior of the alternate or option key. +Either SYMBOL, describing the behavior for any event, +or (:ordinary SYMBOL :function SYMBOL :mouse SYMBOL), describing behavior +separately for ordinary keys, function keys, and mouse events. + +Each SYMBOL is `control', `meta', `alt', `super', `hyper' or `none'. +If `none', the key is ignored by Emacs and retains its standard meaning. */); ns_alternate_modifier = Qmeta; DEFVAR_LISP ("ns-right-alternate-modifier", ns_right_alternate_modifier, - "This variable describes the behavior of the right alternate or option key.\n\ -Either SYMBOL, describing the behavior for any event,\n\ -or (:ordinary SYMBOL :function SYMBOL :mouse SYMBOL), describing behavior\n\ -separately for ordinary keys, function keys, and mouse events.\n\ -It can also be `left' to use the value of `ns-alternate-modifier' instead.\n\ -\n\ -Each SYMBOL is `control', `meta', `alt', `super', `hyper' or `none'.\n\ -If `none', the key is ignored by Emacs and retains its standard meaning."); + doc: /* This variable describes the behavior of the right alternate or option key. +Either SYMBOL, describing the behavior for any event, +or (:ordinary SYMBOL :function SYMBOL :mouse SYMBOL), describing behavior +separately for ordinary keys, function keys, and mouse events. +It can also be `left' to use the value of `ns-alternate-modifier' instead. + +Each SYMBOL is `control', `meta', `alt', `super', `hyper' or `none'. +If `none', the key is ignored by Emacs and retains its standard meaning. */); ns_right_alternate_modifier = Qleft; DEFVAR_LISP ("ns-command-modifier", ns_command_modifier, - "This variable describes the behavior of the command key.\n\ -Either SYMBOL, describing the behavior for any event,\n\ -or (:ordinary SYMBOL :function SYMBOL :mouse SYMBOL), describing behavior\n\ -separately for ordinary keys, function keys, and mouse events.\n\ -\n\ -Each SYMBOL is `control', `meta', `alt', `super', `hyper' or `none'.\n\ -If `none', the key is ignored by Emacs and retains its standard meaning."); + doc: /* This variable describes the behavior of the command key. +Either SYMBOL, describing the behavior for any event, +or (:ordinary SYMBOL :function SYMBOL :mouse SYMBOL), describing behavior +separately for ordinary keys, function keys, and mouse events. + +Each SYMBOL is `control', `meta', `alt', `super', `hyper' or `none'. +If `none', the key is ignored by Emacs and retains its standard meaning. */); ns_command_modifier = Qsuper; DEFVAR_LISP ("ns-right-command-modifier", ns_right_command_modifier, - "This variable describes the behavior of the right command key.\n\ -Either SYMBOL, describing the behavior for any event,\n\ -or (:ordinary SYMBOL :function SYMBOL :mouse SYMBOL), describing behavior\n\ -separately for ordinary keys, function keys, and mouse events.\n\ -It can also be `left' to use the value of `ns-command-modifier' instead.\n\ -\n\ -Each SYMBOL is `control', `meta', `alt', `super', `hyper' or `none'.\n\ -If `none', the key is ignored by Emacs and retains its standard meaning."); + doc: /* This variable describes the behavior of the right command key. +Either SYMBOL, describing the behavior for any event, +or (:ordinary SYMBOL :function SYMBOL :mouse SYMBOL), describing behavior +separately for ordinary keys, function keys, and mouse events. +It can also be `left' to use the value of `ns-command-modifier' instead. + +Each SYMBOL is `control', `meta', `alt', `super', `hyper' or `none'. +If `none', the key is ignored by Emacs and retains its standard meaning. */); ns_right_command_modifier = Qleft; DEFVAR_LISP ("ns-control-modifier", ns_control_modifier, - "This variable describes the behavior of the control key.\n\ -Either SYMBOL, describing the behavior for any event,\n\ -or (:ordinary SYMBOL :function SYMBOL :mouse SYMBOL), describing behavior\n\ -separately for ordinary keys, function keys, and mouse events.\n\ -\n\ -Each SYMBOL is `control', `meta', `alt', `super', `hyper' or `none'.\n\ -If `none', the key is ignored by Emacs and retains its standard meaning."); + doc: /* This variable describes the behavior of the control key. +Either SYMBOL, describing the behavior for any event, +or (:ordinary SYMBOL :function SYMBOL :mouse SYMBOL), describing behavior +separately for ordinary keys, function keys, and mouse events. + +Each SYMBOL is `control', `meta', `alt', `super', `hyper' or `none'. +If `none', the key is ignored by Emacs and retains its standard meaning. */); ns_control_modifier = Qcontrol; DEFVAR_LISP ("ns-right-control-modifier", ns_right_control_modifier, - "This variable describes the behavior of the right control key.\n\ -Either SYMBOL, describing the behavior for any event,\n\ -or (:ordinary SYMBOL :function SYMBOL :mouse SYMBOL), describing behavior\n\ -separately for ordinary keys, function keys, and mouse events.\n\ -It can also be `left' to use the value of `ns-control-modifier' instead.\n\ -\n\ -Each SYMBOL is `control', `meta', `alt', `super', `hyper' or `none'.\n\ -If `none', the key is ignored by Emacs and retains its standard meaning."); + doc: /* This variable describes the behavior of the right control key. +Either SYMBOL, describing the behavior for any event, +or (:ordinary SYMBOL :function SYMBOL :mouse SYMBOL), describing behavior +separately for ordinary keys, function keys, and mouse events. +It can also be `left' to use the value of `ns-control-modifier' instead. + +Each SYMBOL is `control', `meta', `alt', `super', `hyper' or `none'. +If `none', the key is ignored by Emacs and retains its standard meaning. */); ns_right_control_modifier = Qleft; DEFVAR_LISP ("ns-function-modifier", ns_function_modifier, - "This variable describes the behavior of the function (fn) key.\n\ -Either SYMBOL, describing the behavior for any event,\n\ -or (:ordinary SYMBOL :function SYMBOL :mouse SYMBOL), describing behavior\n\ -separately for ordinary keys, function keys, and mouse events.\n\ -\n\ -Each SYMBOL is `control', `meta', `alt', `super', `hyper' or `none'.\n\ -If `none', the key is ignored by Emacs and retains its standard meaning."); + doc: /* This variable describes the behavior of the function (fn) key. +Either SYMBOL, describing the behavior for any event, +or (:ordinary SYMBOL :function SYMBOL :mouse SYMBOL), describing behavior +separately for ordinary keys, function keys, and mouse events. + +Each SYMBOL is `control', `meta', `alt', `super', `hyper' or `none'. +If `none', the key is ignored by Emacs and retains its standard meaning. */); ns_function_modifier = Qnone; DEFVAR_LISP ("ns-antialias-text", ns_antialias_text, - "Non-nil (the default) means to render text antialiased."); + doc: /* Non-nil (the default) means to render text antialiased. */); ns_antialias_text = Qt; DEFVAR_LISP ("ns-use-thin-smoothing", ns_use_thin_smoothing, - "Non-nil turns on a font smoothing method that produces thinner strokes."); + doc: /* Non-nil turns on a font smoothing method that produces thinner strokes. */); ns_use_thin_smoothing = Qnil; DEFVAR_LISP ("ns-confirm-quit", ns_confirm_quit, - "Whether to confirm application quit using dialog."); + doc: /* Whether to confirm application quit using dialog. */); ns_confirm_quit = Qnil; DEFVAR_LISP ("ns-auto-hide-menu-bar", ns_auto_hide_menu_bar, @@ -9982,8 +10902,25 @@ 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); + + DEFVAR_LISP ("ns-drag-motion-function", Vns_drag_motion_function, + doc: /* Function called when another program drags items over Emacs. + +It is called with three arguments FRAME, X, and Y, whenever the user +moves the mouse over an Emacs frame as part of a drag-and-drop +operation. FRAME is the frame the mouse is on top of, and X and Y are +the frame-relative positions of the mouse in the X and Y axises +respectively. */); + Vns_drag_motion_function = Qns_handle_drag_motion; + /* Tell Emacs about this window system. */ Fprovide (Qns, Qnil); @@ -9992,6 +10929,9 @@ This variable is ignored on macOS < 10.7 and GNUstep. Default is t. */); DEFSYM (QCordinary, ":ordinary"); DEFSYM (QCfunction, ":function"); DEFSYM (QCmouse, ":mouse"); + DEFSYM (Qcondensed, "condensed"); + DEFSYM (Qreverse_italic, "reverse-italic"); + DEFSYM (Qexpanded, "expanded"); #ifdef NS_IMPL_COCOA Fprovide (Qcocoa, Qnil); @@ -10001,4 +10941,6 @@ This variable is ignored on macOS < 10.7 and GNUstep. Default is t. */); syms_of_nsfont (); #endif + last_known_monitors = Qnil; + staticpro (&last_known_monitors); } diff --git a/src/nsxwidget.m b/src/nsxwidget.m index f79873235cb..be0eba0bcb1 100644 --- a/src/nsxwidget.m +++ b/src/nsxwidget.m @@ -69,10 +69,13 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ [configuration.preferences setValue:@YES forKey:@"developerExtrasEnabled"]; +#if 0 /* Plugins are not supported by Mac OS X anymore. */ Lisp_Object enablePlugins = Fintern (build_string ("xwidget-webkit-enable-plugins"), Qnil); + if (!EQ (Fsymbol_value (enablePlugins), Qnil)) configuration.preferences.plugInsEnabled = YES; +#endif self = [super initWithFrame:frame configuration:configuration]; if (self) diff --git a/src/pdumper.c b/src/pdumper.c index b0167299d79..af451920eb6 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. */ @@ -1069,7 +1069,7 @@ dump_queue_enqueue (struct dump_queue *dump_queue, } } - if (!EQ (weights, orig_weights)) + if (!BASE_EQ (weights, orig_weights)) Fputhash (object, weights, dump_queue->link_weights); } @@ -1210,8 +1210,8 @@ dump_queue_find_score_of_one_weight_queue (struct dump_queue *dump_queue, static Lisp_Object dump_queue_dequeue (struct dump_queue *dump_queue, dump_off basis) { - eassert (EQ (Fhash_table_count (dump_queue->sequence_numbers), - Fhash_table_count (dump_queue->link_weights))); + eassert (BASE_EQ (Fhash_table_count (dump_queue->sequence_numbers), + Fhash_table_count (dump_queue->link_weights))); eassert (XFIXNUM (Fhash_table_count (dump_queue->sequence_numbers)) <= (dump_tailq_length (&dump_queue->fancy_weight_objects) @@ -1383,7 +1383,7 @@ print_paths_to_root_1 (struct dump_context *ctx, { Lisp_Object referrer = XCAR (referrers); referrers = XCDR (referrers); - Lisp_Object repr = Fprin1_to_string (referrer, Qnil); + Lisp_Object repr = Fprin1_to_string (referrer, Qnil, Qnil); for (int i = 0; i < level; ++i) putc (' ', stderr); fwrite (SDATA (repr), 1, SBYTES (repr), stderr); @@ -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_20B7443AD7) # error "Lisp_Subr changed. See CHECK_STRUCTS comment in config.h." #endif struct Lisp_Subr out; @@ -2876,12 +2876,14 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) dump_remember_cold_op (ctx, 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->intspec.native, 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->intspec.string); + 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"); } @@ -3752,7 +3758,7 @@ decode_emacs_reloc (struct dump_context *ctx, Lisp_Object lreloc) reloc.u.dump_offset = dump_recall_object (ctx, target_value); if (reloc.u.dump_offset <= 0) { - Lisp_Object repr = Fprin1_to_string (target_value, Qnil); + Lisp_Object repr = Fprin1_to_string (target_value, Qnil, Qnil); error ("relocation target was not dumped: %s", SDATA (repr)); } dump_check_dump_off (ctx, reloc.u.dump_offset); @@ -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", @@ -5537,7 +5543,10 @@ pdumper_load (const char *dump_filename, char *argv0) struct dump_header header_buf = { 0 }; struct dump_header *header = &header_buf; - struct dump_memory_map sections[NUMBER_DUMP_SECTIONS] = { 0 }; + struct dump_memory_map sections[NUMBER_DUMP_SECTIONS]; + + /* Use memset instead of "= { 0 }" to work around GCC bug 105961. */ + memset (sections, 0, sizeof sections); const struct timespec start_time = current_timespec (); char *dump_filename_copy; @@ -5597,8 +5606,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 +5619,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 +5715,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 +5800,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..5c43e5f3607 --- /dev/null +++ b/src/pgtkfns.c @@ -0,0 +1,3941 @@ +/* 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 +pgtk_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; + + pgtk_change_tab_bar_height (f, nlines * FRAME_LINE_HEIGHT (f)); +} + +/* Set the pixel height of the tab bar of frame F to HEIGHT. */ +void +pgtk_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; + + 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_GTK_WIDGET (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) && BASE_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) && BASE_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 (); +} + +static void +pgtk_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + set_frame_cursor_types (f, arg); +} + +static void +pgtk_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ +} + +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); + } +} + +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); + } +} + +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. */ +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 explicitly 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); +} + +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, + pgtk_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, + gui_set_fullscreen, /* generic OK */ + gui_set_font_backend, /* generic OK */ + gui_set_alpha, + pgtk_set_sticky, + pgtk_set_tool_bar_position, + 0, + 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++; + + pgtk_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 (BASE_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 (BASE_EQ (display, Qunbound)) + display = + gui_display_get_arg (dpyinfo, parms, Qdisplay, 0, 0, RES_TYPE_STRING); + if (BASE_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) && !BASE_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 (BASE_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) + || BASE_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))) + && !(BASE_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))) + && !(BASE_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 (BASE_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 (!BASE_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 (! BASE_EQ (value, Qunbound)) + parms = Fcons (Fcons (Qchild_frame_border_width, value), + parms); + + } + + 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, + 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 (); + xg_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 (BASE_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 + && (!BASE_EQ (height, Qunbound) || !BASE_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 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 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 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 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-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 +pgtk_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) + && !BASE_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 (BASE_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 (! BASE_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 gets set, which lets 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 = pgtk_display_pixel_width (FRAME_DISPLAY_INFO (f)); + max_y = pgtk_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 +pgtk_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 from the `x-show-tooltip-timeout' +variable. + +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 = Vx_show_tooltip_timeout; + 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; + } + } + + pgtk_hide_tip (delete); + } + else + pgtk_hide_tip (true); + } + else + pgtk_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 pgtk_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 (&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..d147f4b4168 --- /dev/null +++ b/src/pgtkmenu.c @@ -0,0 +1,1126 @@ +/* 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. */ + 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 (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 (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..e0230003b3a --- /dev/null +++ b/src/pgtkselect.c @@ -0,0 +1,1960 @@ +/* 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/>. */ + +/* 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 "atimer.h" +#include "blockinput.h" + +/* This file deliberately does not implement INCR, since it adds a + bunch of extra code for no real gain, as PGTK isn't supposed to + support X11 anyway. */ + +/* Advance declaration of structs. */ +struct selection_data; +struct prop_location; + +static void pgtk_decline_selection_request (struct selection_input_event *); +static bool pgtk_convert_selection (Lisp_Object, Lisp_Object, GdkAtom, bool, + struct pgtk_display_info *); +static bool waiting_for_other_props_on_window (GdkDisplay *, GdkWindow *); +#if 0 +static struct prop_location *expect_property_change (GdkDisplay *, GdkWindow *, + GdkAtom, int); +#endif +static void unexpect_property_change (struct prop_location *); +static void wait_for_property_change (struct prop_location *); +static Lisp_Object pgtk_get_window_property_as_lisp_data (struct pgtk_display_info *, + GdkWindow *, GdkAtom, + Lisp_Object, GdkAtom, bool); +static Lisp_Object selection_data_to_lisp_data (struct pgtk_display_info *, + const unsigned char *, + ptrdiff_t, GdkAtom, int); +static void lisp_data_to_selection_data (struct pgtk_display_info *, Lisp_Object, + struct selection_data *); +static Lisp_Object pgtk_get_local_selection (Lisp_Object, Lisp_Object, + bool, struct pgtk_display_info *); + +/* 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; +} + +#define LOCAL_SELECTION(selection_symbol, dpyinfo) \ + assq_no_quit (selection_symbol, dpyinfo->terminal->Vselection_alist) + +static GdkAtom +symbol_to_gdk_atom (Lisp_Object sym) +{ + if (NILP (sym)) + return GDK_NONE; + + if (EQ (sym, QPRIMARY)) + return GDK_SELECTION_PRIMARY; + if (EQ (sym, QSECONDARY)) + return GDK_SELECTION_SECONDARY; + if (EQ (sym, QCLIPBOARD)) + return GDK_SELECTION_CLIPBOARD; + + if (!SYMBOLP (sym)) + emacs_abort (); + + return gdk_atom_intern (SSDATA (SYMBOL_NAME (sym)), FALSE); +} + +static Lisp_Object +gdk_atom_to_symbol (GdkAtom atom) +{ + return intern (gdk_atom_name (atom)); +} + + + +/* Do protocol to assert ourself as a selection owner. + FRAME shall be the owner; it must be a valid GDK frame. + Update the Vselection_alist so that we can reply to later requests for + our selection. */ + +static void +pgtk_own_selection (Lisp_Object selection_name, Lisp_Object selection_value, + Lisp_Object frame) +{ + struct frame *f = XFRAME (frame); + struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + guint32 timestamp = gtk_get_current_event_time (); + GdkAtom selection_atom = symbol_to_gdk_atom (selection_name); + Lisp_Object targets; + ptrdiff_t i, ntargets; + GtkTargetEntry *gtargets; + + if (timestamp == GDK_CURRENT_TIME) + timestamp = dpyinfo->last_user_time; + + /* Assert ownership over the selection. Ideally we would use only + the GDK selection API for this, but it just doesn't work on + Wayland. */ + + if (!gdk_selection_owner_set_for_display (dpyinfo->display, + FRAME_GDK_WINDOW (f), + selection_atom, + timestamp, TRUE)) + signal_error ("Could not assert ownership over selection", selection_name); + + /* Update the local cache */ + { + Lisp_Object selection_data; + Lisp_Object prev_value; + + selection_data = list4 (selection_name, selection_value, + INT_TO_INTEGER (timestamp), frame); + prev_value = LOCAL_SELECTION (selection_name, dpyinfo); + + tset_selection_alist + (dpyinfo->terminal, + Fcons (selection_data, dpyinfo->terminal->Vselection_alist)); + + /* If we already owned the selection, remove the old selection + data. Don't use Fdelq as that may quit. */ + if (!NILP (prev_value)) + { + /* We know it's not the CAR, so it's easy. */ + Lisp_Object rest = dpyinfo->terminal->Vselection_alist; + for (; CONSP (rest); rest = XCDR (rest)) + if (EQ (prev_value, Fcar (XCDR (rest)))) + { + XSETCDR (rest, XCDR (XCDR (rest))); + break; + } + } + } + + /* Announce the targets to the display server. This isn't required + on X, but is on Wayland. */ + + targets = pgtk_get_local_selection (selection_name, QTARGETS, + true, dpyinfo); + + /* GC must not happen inside this segment. */ + block_input (); + gtk_selection_clear_targets (FRAME_GTK_WIDGET (f), selection_atom); + + if (VECTORP (targets)) + { + gtargets = xzalloc (sizeof *gtargets * ASIZE (targets)); + ntargets = 0; + + for (i = 0; i < ASIZE (targets); ++i) + { + if (SYMBOLP (AREF (targets, i))) + gtargets[ntargets++].target + = SSDATA (SYMBOL_NAME (AREF (targets, i))); + } + + gtk_selection_add_targets (FRAME_GTK_WIDGET (f), + selection_atom, gtargets, + ntargets); + + xfree (gtargets); + } + unblock_input (); +} + +static Lisp_Object +pgtk_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type, + bool local_request, struct pgtk_display_info *dpyinfo) +{ + Lisp_Object local_value, tem; + Lisp_Object handler_fn, value, check; + + local_value = LOCAL_SELECTION (selection_symbol, dpyinfo); + + if (NILP (local_value)) return Qnil; + + /* TIMESTAMP is a special case. */ + if (EQ (target_type, QTIMESTAMP)) + { + handler_fn = Qnil; + value = XCAR (XCDR (XCDR (local_value))); + } + else + { + /* 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. */ + 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); + + tem = XCAR (XCDR (local_value)); + + if (STRINGP (tem)) + { + local_value = Fget_text_property (make_fixnum (0), + target_type, tem); + + if (!NILP (local_value)) + tem = local_value; + } + + if (!NILP (handler_fn)) + value = call3 (handler_fn, selection_symbol, + (local_request + ? Qnil + : target_type), + tem); + else + value = Qnil; + value = unbind_to (count, value); + } + + /* Make sure this value is of a type that we could transmit + to another client. */ + + check = value; + if (CONSP (value) + && SYMBOLP (XCAR (value))) + check = XCDR (value); + + if (STRINGP (check) + || VECTORP (check) + || SYMBOLP (check) + || INTEGERP (check) + || NILP (value)) + return value; + /* Check for a value that CONS_TO_INTEGER could handle. */ + else if (CONSP (check) + && INTEGERP (XCAR (check)) + && (INTEGERP (XCDR (check)) + || + (CONSP (XCDR (check)) + && INTEGERP (XCAR (XCDR (check))) + && NILP (XCDR (XCDR (check)))))) + return value; + + signal_error ("Invalid data returned by selection-conversion function", + list2 (handler_fn, value)); +} + +static void +pgtk_decline_selection_request (struct selection_input_event *event) +{ + gdk_selection_send_notify (SELECTION_EVENT_REQUESTOR (event), + SELECTION_EVENT_SELECTION (event), + SELECTION_EVENT_TARGET (event), + GDK_NONE, SELECTION_EVENT_TIME (event)); +} + +struct selection_data +{ + unsigned char *data; + ptrdiff_t size; + int format; + GdkAtom type; + bool nofree; + GdkAtom property; + + /* This can be set to non-NULL during x_reply_selection_request, if + the selection is waiting for an INCR transfer to complete. Don't + free these; that's done by unexpect_property_change. */ + struct prop_location *wait_object; + struct selection_data *next; +}; + +struct pgtk_selection_request +{ + /* The last element in this stack. */ + struct pgtk_selection_request *last; + + /* Its display info. */ + struct pgtk_display_info *dpyinfo; + + /* Its selection input event. */ + struct selection_input_event *request; + + /* Linked list of the above (in support of MULTIPLE targets). */ + struct selection_data *converted_selections; + + /* "Data" to send a requestor for a failed MULTIPLE subtarget. */ + GdkAtom conversion_fail_tag; + + /* Whether or not conversion was successful. */ + bool converted; +}; + +/* Stack of selections currently being processed. + NULL if all requests have been fully processed. */ + +struct pgtk_selection_request *selection_request_stack; + +static void +pgtk_push_current_selection_request (struct selection_input_event *se, + struct pgtk_display_info *dpyinfo) +{ + struct pgtk_selection_request *frame; + + frame = xmalloc (sizeof *frame); + frame->converted = false; + frame->last = selection_request_stack; + frame->request = se; + frame->dpyinfo = dpyinfo; + frame->converted_selections = NULL; + frame->conversion_fail_tag = GDK_NONE; + + selection_request_stack = frame; +} + +static void +pgtk_pop_current_selection_request (void) +{ + struct pgtk_selection_request *tem; + + tem = selection_request_stack; + selection_request_stack = selection_request_stack->last; + + xfree (tem); +} + +/* Used as an unwind-protect clause so that, if a selection-converter signals + an error, we tell the requestor that we were unable to do what they wanted + before we throw to top-level or go into the debugger or whatever. */ + +static void +pgtk_selection_request_lisp_error (void) +{ + struct selection_data *cs, *next; + struct pgtk_selection_request *frame; + + frame = selection_request_stack; + + for (cs = frame->converted_selections; cs; cs = next) + { + next = cs->next; + if (! cs->nofree && cs->data) + xfree (cs->data); + xfree (cs); + } + frame->converted_selections = NULL; + + if (!frame->converted && frame->dpyinfo->display) + pgtk_decline_selection_request (frame->request); +} + +/* This stuff is so that INCR selections are reentrant (that is, so we can + be servicing multiple INCR selection requests simultaneously.) I haven't + actually tested that yet. */ + +/* Keep a list of the property changes that are awaited. */ + +struct prop_location +{ + int identifier; + GdkDisplay *display; + GdkWindow *window; + GdkAtom property; + int desired_state; + bool arrived; + struct prop_location *next; +}; + +#if 0 + +static int prop_location_identifier; + +#endif + +static Lisp_Object property_change_reply; + +static struct prop_location *property_change_reply_object; + +static struct prop_location *property_change_wait_list; + +static void +set_property_change_object (struct prop_location *location) +{ + /* Input must be blocked so we don't get the event before we set these. */ + if (!input_blocked_p ()) + emacs_abort (); + + XSETCAR (property_change_reply, Qnil); + property_change_reply_object = location; +} + + +/* Send the reply to a selection request event EVENT. */ + +static void +pgtk_reply_selection_request (struct selection_input_event *event, + struct pgtk_display_info *dpyinfo) +{ + GdkDisplay *display = SELECTION_EVENT_DISPLAY (event); + GdkWindow *window = SELECTION_EVENT_REQUESTOR (event); + ptrdiff_t bytes_remaining; + struct selection_data *cs; + struct pgtk_selection_request *frame; + + frame = selection_request_stack; + + block_input (); + /* Loop over converted selections, storing them in the requested + properties. If data is large, only store the first N bytes + (section 2.7.2 of ICCCM). Note that we store the data for a + MULTIPLE request in the opposite order; the ICCM says only that + the conversion itself must be done in the same order. */ + for (cs = frame->converted_selections; cs; cs = cs->next) + { + if (cs->property == GDK_NONE) + continue; + + bytes_remaining = cs->size; + bytes_remaining *= cs->format >> 3; + + gdk_property_change (window, cs->property, + cs->type, cs->format, + GDK_PROP_MODE_APPEND, + cs->data, cs->size); + } + + /* Now issue the SelectionNotify event. */ + gdk_selection_send_notify (window, + SELECTION_EVENT_SELECTION (event), + SELECTION_EVENT_TARGET (event), + SELECTION_EVENT_PROPERTY (event), + SELECTION_EVENT_TIME (event)); + gdk_display_flush (display); + + /* Finish sending the rest of each of the INCR values. This should + be improved; there's a chance of deadlock if more than one + subtarget in a MULTIPLE selection requires an INCR transfer, and + the requestor and Emacs loop waiting on different transfers. */ + for (cs = frame->converted_selections; cs; cs = cs->next) + if (cs->wait_object) + { + int format_bytes = cs->format / 8; + + /* Must set this inside block_input (). unblock_input may read + events and setting property_change_reply in + wait_for_property_change is then too late. */ + set_property_change_object (cs->wait_object); + unblock_input (); + + bytes_remaining = cs->size; + bytes_remaining *= format_bytes; + + /* Wait for the requestor to ack by deleting the property. + This can run Lisp code (process handlers) or signal. */ + wait_for_property_change (cs->wait_object); + + /* Now write a zero-length chunk to the property to tell the + requestor that we're done. */ + block_input (); + if (! waiting_for_other_props_on_window (display, window)) + gdk_window_set_events (window, 0); + gdk_property_change (window, cs->property, cs->type, cs->format, + GDK_PROP_MODE_REPLACE, cs->data, 0); + } + + gdk_display_sync (display); + unblock_input (); +} + + + +/* Handle a SelectionRequest event EVENT. + This is called from keyboard.c when such an event is found in the queue. */ + +static void +pgtk_handle_selection_request (struct selection_input_event *event) +{ + guint32 local_selection_time; + struct pgtk_display_info *dpyinfo = SELECTION_EVENT_DPYINFO (event); + GdkAtom selection = SELECTION_EVENT_SELECTION (event); + Lisp_Object selection_symbol = gdk_atom_to_symbol (selection); + GdkAtom target = SELECTION_EVENT_TARGET (event); + Lisp_Object target_symbol = gdk_atom_to_symbol (target); + GdkAtom property = SELECTION_EVENT_PROPERTY (event); + Lisp_Object local_selection_data; + bool success = false; + specpdl_ref count = SPECPDL_INDEX (); + bool pushed; + Lisp_Object alias, tem; + + alias = Vpgtk_selection_alias_alist; + + FOR_EACH_TAIL_SAFE (alias) + { + tem = Qnil; + + if (CONSP (alias)) + tem = XCAR (alias); + + if (CONSP (tem) + && EQ (XCAR (tem), selection_symbol) + && SYMBOLP (XCDR (tem))) + { + selection_symbol = XCDR (tem); + break; + } + } + + pushed = false; + + if (!dpyinfo) + goto DONE; + + local_selection_data = LOCAL_SELECTION (selection_symbol, dpyinfo); + + /* Decline if we don't own any selections. */ + if (NILP (local_selection_data)) goto DONE; + + /* Decline requests issued prior to our acquiring the selection. */ + CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data))), + guint32, local_selection_time); + if (SELECTION_EVENT_TIME (event) != GDK_CURRENT_TIME + && local_selection_time > SELECTION_EVENT_TIME (event)) + goto DONE; + + block_input (); + pushed = true; + pgtk_push_current_selection_request (event, dpyinfo); + record_unwind_protect_void (pgtk_pop_current_selection_request); + record_unwind_protect_void (pgtk_selection_request_lisp_error); + unblock_input (); + + if (EQ (target_symbol, QMULTIPLE)) + { + /* For MULTIPLE targets, the event property names a list of atom + pairs; the first atom names a target and the second names a + non-GDK_NONE property. */ + GdkWindow *requestor = SELECTION_EVENT_REQUESTOR (event); + Lisp_Object multprop; + ptrdiff_t j, nselections; + struct selection_data cs; + + if (property == GDK_NONE) + goto DONE; + + multprop = pgtk_get_window_property_as_lisp_data (dpyinfo, + requestor, + property, + QMULTIPLE, + selection, + true); + + if (!VECTORP (multprop) || ASIZE (multprop) % 2) + goto DONE; + + nselections = ASIZE (multprop) / 2; + /* Perform conversions. This can signal. */ + for (j = 0; j < nselections; j++) + { + Lisp_Object subtarget = AREF (multprop, 2*j); + GdkAtom subproperty = symbol_to_gdk_atom (AREF (multprop, 2 * j + 1)); + bool subsuccess = false; + + if (subproperty != GDK_NONE) + subsuccess = pgtk_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); + gdk_property_change (requestor, property, + cs.type, cs.format, + GDK_PROP_MODE_REPLACE, + cs.data, cs.size); + success = true; + } + else + { + if (property == GDK_NONE) + property = SELECTION_EVENT_TARGET (event); + + success = pgtk_convert_selection (selection_symbol, + target_symbol, property, + false, dpyinfo); + } + + DONE: + + if (pushed) + selection_request_stack->converted = true; + + if (success) + pgtk_reply_selection_request (event, dpyinfo); + else + pgtk_decline_selection_request (event); + + /* Run the `pgtk-sent-selection-functions' abnormal hook. */ + if (!NILP (Vpgtk_sent_selection_functions) + && !BASE_EQ (Vpgtk_sent_selection_functions, Qunbound)) + CALLN (Frun_hook_with_args, Qpgtk_sent_selection_functions, + selection_symbol, target_symbol, success ? Qt : Qnil); + + unbind_to (count, Qnil); +} + +/* Perform the requested selection conversion, and write the data to + the converted_selections linked list, where it can be accessed by + x_reply_selection_request. If FOR_MULTIPLE, write out + the data even if conversion fails, using conversion_fail_tag. + + Return true if (and only if) successful. */ + +static bool +pgtk_convert_selection (Lisp_Object selection_symbol, + Lisp_Object target_symbol, GdkAtom property, + bool for_multiple, struct pgtk_display_info *dpyinfo) +{ + Lisp_Object lisp_selection; + struct selection_data *cs; + struct pgtk_selection_request *frame; + + lisp_selection + = pgtk_get_local_selection (selection_symbol, target_symbol, + false, dpyinfo); + + frame = selection_request_stack; + + /* A nil return value means we can't perform the conversion. */ + if (NILP (lisp_selection) + || (CONSP (lisp_selection) && NILP (XCDR (lisp_selection)))) + { + if (for_multiple) + { + cs = xmalloc (sizeof *cs); + cs->data = ((unsigned char *) + &selection_request_stack->conversion_fail_tag); + cs->size = 1; + cs->format = 32; + cs->type = GDK_SELECTION_TYPE_ATOM; + cs->nofree = true; + cs->property = property; + cs->wait_object = NULL; + cs->next = frame->converted_selections; + frame->converted_selections = cs; + } + + return false; + } + + /* Otherwise, record the converted selection to binary. */ + cs = xmalloc (sizeof *cs); + cs->data = NULL; + cs->nofree = true; + cs->property = property; + cs->wait_object = NULL; + cs->next = frame->converted_selections; + frame->converted_selections = cs; + lisp_data_to_selection_data (dpyinfo, lisp_selection, cs); + return true; +} + + + +/* Handle a SelectionClear event EVENT, which indicates that some + client cleared out our previously asserted selection. + This is called from keyboard.c when such an event is found in the queue. */ + +static void +pgtk_handle_selection_clear (struct selection_input_event *event) +{ + GdkAtom selection = SELECTION_EVENT_SELECTION (event); + guint32 changed_owner_time = SELECTION_EVENT_TIME (event); + + Lisp_Object selection_symbol, local_selection_data; + guint32 local_selection_time; + struct pgtk_display_info *dpyinfo = SELECTION_EVENT_DPYINFO (event); + Lisp_Object Vselection_alist; + + if (!dpyinfo) return; + + selection_symbol = gdk_atom_to_symbol (selection); + local_selection_data = LOCAL_SELECTION (selection_symbol, dpyinfo); + + /* Well, we already believe that we don't own it, so that's just fine. */ + if (NILP (local_selection_data)) return; + + CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data))), + guint32, local_selection_time); + + /* We have reasserted the selection since this SelectionClear was + generated, so we can disregard it. */ + if (changed_owner_time != GDK_CURRENT_TIME + && local_selection_time > changed_owner_time) + return; + + /* Otherwise, really clear. Don't use Fdelq as that may quit. */ + Vselection_alist = dpyinfo->terminal->Vselection_alist; + if (EQ (local_selection_data, CAR (Vselection_alist))) + Vselection_alist = XCDR (Vselection_alist); + else + { + Lisp_Object rest; + for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest)) + if (EQ (local_selection_data, CAR (XCDR (rest)))) + { + XSETCDR (rest, XCDR (XCDR (rest))); + break; + } + } + tset_selection_alist (dpyinfo->terminal, Vselection_alist); + + /* Run the `pgtk-lost-selection-functions' abnormal hook. */ + CALLN (Frun_hook_with_args, Qpgtk_lost_selection_functions, selection_symbol); + + redisplay_preserve_echo_area (20); +} + +void +pgtk_handle_selection_event (struct selection_input_event *event) +{ + if (event->kind != SELECTION_REQUEST_EVENT) + pgtk_handle_selection_clear (event); + else + pgtk_handle_selection_request (event); +} + +/* Clear all selections that were made from frame F. + We do this when about to delete a frame. */ + +void +pgtk_clear_frame_selections (struct frame *f) +{ + Lisp_Object frame, rest, timestamp, symbol; + guint32 time; + struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + struct terminal *t = dpyinfo->terminal; + + XSETFRAME (frame, f); + + /* Delete elements from the beginning of Vselection_alist. */ + while (CONSP (t->Vselection_alist) + && EQ (frame, XCAR (XCDR (XCDR (XCDR (XCAR (t->Vselection_alist))))))) + { + symbol = Fcar (Fcar (t->Vselection_alist)); + + /* Run the `pgtk-lost-selection-functions' abnormal hook. */ + CALLN (Frun_hook_with_args, Qpgtk_lost_selection_functions, + symbol); + + timestamp = Fcar (Fcdr (Fcdr (Fcar (t->Vselection_alist)))); + CONS_TO_INTEGER (timestamp, guint32, time); + + /* On Wayland, GDK will still ask the (now non-existent) frame for + selection data, even though we no longer think the selection is + owned by us. Manually relinquish ownership of the selection. */ + gdk_selection_owner_set_for_display (dpyinfo->display, + NULL, + symbol_to_gdk_atom (symbol), + time, TRUE); + + tset_selection_alist (t, XCDR (t->Vselection_alist)); + } + + /* Delete elements after the beginning of Vselection_alist. */ + for (rest = t->Vselection_alist; CONSP (rest); rest = XCDR (rest)) + if (CONSP (XCDR (rest)) + && EQ (frame, XCAR (XCDR (XCDR (XCDR (XCAR (XCDR (rest)))))))) + { + symbol = XCAR (XCAR (XCDR (rest))); + CALLN (Frun_hook_with_args, Qpgtk_lost_selection_functions, + symbol); + + timestamp = XCAR (XCDR (XCDR (XCAR (XCDR (rest))))); + CONS_TO_INTEGER (timestamp, guint32, time); + + gdk_selection_owner_set_for_display (dpyinfo->display, + NULL, + symbol_to_gdk_atom (symbol), + time, TRUE); + + XSETCDR (rest, XCDR (XCDR (rest))); + break; + } +} + +/* True if any properties for DISPLAY and WINDOW + are on the list of what we are waiting for. */ + +static bool +waiting_for_other_props_on_window (GdkDisplay *display, GdkWindow *window) +{ + for (struct prop_location *p = property_change_wait_list; p; p = p->next) + if (p->display == display && p->window == window) + return true; + return false; +} + +/* Add an entry to the list of property changes we are waiting for. + DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for. + The return value is a number that uniquely identifies + this awaited property change. */ + +/* Currently unused -- uncomment later if we decide to implement INCR + transfer for X. */ + +#if 0 + +static struct prop_location * +expect_property_change (GdkDisplay *display, GdkWindow *window, + GdkAtom property, int state) +{ + struct prop_location *pl = xmalloc (sizeof *pl); + pl->identifier = ++prop_location_identifier; + pl->display = display; + pl->window = window; + pl->property = property; + pl->desired_state = state; + pl->next = property_change_wait_list; + pl->arrived = false; + property_change_wait_list = pl; + return pl; +} + +#endif + +/* Delete an entry from the list of property changes we are waiting for. + IDENTIFIER is the number that uniquely identifies the entry. */ + +static void +unexpect_property_change (struct prop_location *location) +{ + struct prop_location *prop, **pprev = &property_change_wait_list; + + for (prop = property_change_wait_list; prop; prop = *pprev) + { + if (prop == location) + { + *pprev = prop->next; + xfree (prop); + break; + } + else + pprev = &prop->next; + } +} + +/* Remove the property change expectation element for IDENTIFIER. */ + +static void +wait_for_property_change_unwind (void *loc) +{ + struct prop_location *location = loc; + + unexpect_property_change (location); + if (location == property_change_reply_object) + property_change_reply_object = 0; +} + +/* Actually wait for a property change. + IDENTIFIER should be the value that expect_property_change returned. */ + +static void +wait_for_property_change (struct prop_location *location) +{ + 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); + + /* See comment in x_reply_selection_request about setting + property_change_reply. Do not do it here. */ + + /* If the event we are waiting for arrives beyond here, it will set + property_change_reply, because property_change_reply_object says so. */ + if (! location->arrived) + { + intmax_t timeout = max (0, pgtk_selection_timeout); + intmax_t secs = timeout / 1000; + int nsecs = (timeout % 1000) * 1000000; + + wait_reading_process_output (secs, nsecs, 0, false, + property_change_reply, NULL, 0); + + if (NILP (XCAR (property_change_reply))) + error ("Timed out waiting for property-notify event"); + } + + unbind_to (count, Qnil); +} + +/* Called from the big filter in response to a PropertyNotify + event. */ + +void +pgtk_handle_property_notify (GdkEventProperty *event) +{ + struct prop_location *rest; + GdkDisplay *dpy; + + dpy = gdk_window_get_display (event->window); + + for (rest = property_change_wait_list; rest; rest = rest->next) + { + if (!rest->arrived + && rest->property == event->atom + && rest->window == event->window + && rest->display == dpy + && rest->desired_state == event->state) + { + rest->arrived = true; + + /* If this is the one wait_for_property_change is waiting for, + tell it to wake up. */ + if (rest == property_change_reply_object) + XSETCAR (property_change_reply, Qt); + + return; + } + } +} + +static void +pgtk_display_selection_waiting_message (struct atimer *timer) +{ + Lisp_Object val; + + val = build_string ("Waiting for reply from selection owner..."); + message3_nolog (val); +} + +static void +pgtk_cancel_atimer (void *atimer) +{ + cancel_atimer (atimer); +} + + +/* Variables for communication with pgtk_handle_selection_notify. */ +static GdkAtom reading_which_selection; +static Lisp_Object reading_selection_reply; +static GdkWindow *reading_selection_window; + +/* Do protocol to read selection-data from the window server. + Converts this to Lisp data and returns it. + FRAME is the frame whose window shall request the selection. */ + +static Lisp_Object +pgtk_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type, + Lisp_Object time_stamp, Lisp_Object frame) +{ + struct frame *f = XFRAME (frame); + struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + GdkWindow *requestor_window = FRAME_GDK_WINDOW (f); + guint32 requestor_time = dpyinfo->last_user_time; + GdkAtom selection_atom = symbol_to_gdk_atom (selection_symbol); + GdkAtom type_atom = (CONSP (target_type) + ? symbol_to_gdk_atom (XCAR (target_type)) + : symbol_to_gdk_atom (target_type)); + struct atimer *delayed_message; + struct timespec message_interval; + specpdl_ref count; + + count = SPECPDL_INDEX (); + + if (!FRAME_LIVE_P (f)) + return unbind_to (count, Qnil); + + if (!NILP (time_stamp)) + CONS_TO_INTEGER (time_stamp, guint32, requestor_time); + + block_input (); + /* Prepare to block until the reply has been read. */ + reading_selection_window = requestor_window; + reading_which_selection = selection_atom; + XSETCAR (reading_selection_reply, Qnil); + + gdk_selection_convert (requestor_window, selection_atom, + type_atom, requestor_time); + unblock_input (); + + /* It should not be necessary to stop handling selection requests + during this time. In fact, the SAVE_TARGETS mechanism requires + us to handle a clipboard manager's requests before it returns + GDK_SELECTION_NOTIFY. */ + + message_interval = make_timespec (1, 0); + delayed_message = start_atimer (ATIMER_RELATIVE, message_interval, + pgtk_display_selection_waiting_message, + NULL); + record_unwind_protect_ptr (pgtk_cancel_atimer, delayed_message); + + /* This allows quits. Also, don't wait forever. */ + intmax_t timeout = max (0, pgtk_selection_timeout); + intmax_t secs = timeout / 1000; + int nsecs = (timeout % 1000) * 1000000; + + wait_reading_process_output (secs, nsecs, 0, false, + reading_selection_reply, NULL, 0); + + if (NILP (XCAR (reading_selection_reply))) + error ("Timed out waiting for reply from selection owner"); + if (EQ (XCAR (reading_selection_reply), Qlambda)) + return unbind_to (count, Qnil); + + /* Otherwise, the selection is waiting for us on the requested property. */ + return unbind_to (count, + pgtk_get_window_property_as_lisp_data (dpyinfo, + requestor_window, + GDK_NONE, + target_type, + selection_atom, + false)); +} + +/* Subroutines of pgtk_get_window_property_as_lisp_data */ + +static ptrdiff_t +pgtk_size_for_format (gint format) +{ + switch (format) + { + case 8: + return sizeof (unsigned char); + case 16: + return sizeof (unsigned short); + case 32: + return sizeof (unsigned long); + + default: + emacs_abort (); + } +} + +/* Use xfree, not g_free, to free the data obtained with this function. */ + +static void +pgtk_get_window_property (GdkWindow *window, unsigned char **data_ret, + ptrdiff_t *bytes_ret, GdkAtom *actual_type_ret, + int *actual_format_ret, unsigned long *actual_size_ret) +{ + gint length, actual_format; + unsigned char *data; + ptrdiff_t element_size; + void *xdata; + GdkAtom actual_type; + unsigned long i; + unsigned int *idata; + unsigned long *ldata; + + data = NULL; + + length = gdk_selection_property_get (window, &data, + &actual_type, + &actual_format); + + if (!data) + { + *data_ret = NULL; + *actual_type_ret = GDK_NONE; + *bytes_ret = 0; + *actual_format_ret = 8; + *actual_size_ret = 0; + + return; + } + + if (actual_type == GDK_SELECTION_TYPE_ATOM + || actual_type == gdk_atom_intern_static_string ("ATOM_PAIR")) + { + /* GDK should not allow anything else. */ + eassert (actual_format == 32); + + length = length / sizeof (GdkAtom); + xdata = xmalloc (sizeof (GdkAtom) * length + 1); + memcpy (xdata, data, 1 + length * sizeof (GdkAtom)); + + g_free (data); + + *data_ret = xdata; + *actual_type_ret = actual_type; + *bytes_ret = length * sizeof (GdkAtom); + *actual_format_ret = 32; + *actual_size_ret = length; + + return; + } + + element_size = pgtk_size_for_format (actual_format); + length = length / element_size; + + /* Add an extra byte on the end. GDK guarantees that it is + NULL. */ + xdata = xmalloc (1 + element_size * length); + memcpy (xdata, data, 1 + element_size * length); + + if (actual_format == 32 && LONG_WIDTH > 32) + { + ldata = (typeof (ldata)) data; + idata = xdata; + + for (i = 0; i < length; ++i) + idata[i] = ldata[i]; + + /* There is always enough space in idata. */ + idata[length] = 0; + *bytes_ret = sizeof *idata * length; + } + else + /* I think GDK itself prevents element_size from exceeding the + length at which this computation fails. */ + *bytes_ret = element_size * length; + + /* Now free the original `data' allocated by GDK. */ + g_free (data); + + *data_ret = xdata; + *actual_type_ret = GDK_NONE; + *actual_size_ret = length; + *actual_format_ret = actual_format; + *actual_type_ret = actual_type; +} + +static Lisp_Object +pgtk_get_window_property_as_lisp_data (struct pgtk_display_info *dpyinfo, + GdkWindow *window, GdkAtom property, + Lisp_Object target_type, GdkAtom selection_atom, + bool for_multiple) +{ + GdkAtom actual_type; + int actual_format; + unsigned long actual_size; + unsigned char *data = 0; + ptrdiff_t bytes = 0; + Lisp_Object val; + GdkDisplay *display = dpyinfo->display; + + pgtk_get_window_property (window, &data, &bytes, + &actual_type, &actual_format, + &actual_size); + + if (!data) + { + if (for_multiple) + return Qnil; + + if (gdk_selection_owner_get_for_display (display, selection_atom)) + { + AUTO_STRING (format, "Selection owner couldn't convert: %s"); + CALLN (Fmessage, format, + actual_type + ? list2 (target_type, + gdk_atom_to_symbol (actual_type)) + : target_type); + return Qnil; + } + else + { + AUTO_STRING (format, "No selection: %s"); + CALLN (Fmessage, format, + gdk_atom_to_symbol (selection_atom)); + return Qnil; + } + } + + if (!for_multiple && property != GDK_NONE) + gdk_property_delete (window, property); + + /* It's been read. Now convert it to a lisp object in some semi-rational + manner. */ + val = selection_data_to_lisp_data (dpyinfo, data, bytes, + actual_type, actual_format); + + /* Use xfree, not g_free, because pgtk_get_window_property calls + xmalloc itself. */ + xfree (data); + return val; +} + + + +/* These functions convert from the selection data read from the + server into something that we can use from Lisp, and vice versa. + + Type: Format: Size: Lisp Type: + ----- ------- ----- ----------- + * 8 * String + ATOM 32 1 Symbol + ATOM 32 > 1 Vector of Symbols + * 16 1 Integer + * 16 > 1 Vector of Integers + * 32 1 if small enough: fixnum + otherwise: bignum + * 32 > 1 Vector of the above + + When converting an object to C, it may be of the form (SYMBOL + . <data>) where SYMBOL is what we should claim that the type is. + Format and representation are as above. + + Important: When format is 32, data should contain an array of int, + not an array of long as GDK returns. Unless TYPE is also + GDK_SELECTION_TYPE_ATOM, in which case data should be an array of + GdkAtom. This makes a difference when sizeof (long) != sizeof + (int). */ + +static Lisp_Object +selection_data_to_lisp_data (struct pgtk_display_info *dpyinfo, + const unsigned char *data, + ptrdiff_t size, GdkAtom type, int format) +{ + if (type == gdk_atom_intern_static_string ("NULL")) + return QNULL; + /* Convert any 8-bit data to a string, for compactness. */ + else if (format == 8) + { + Lisp_Object str, lispy_type; + + str = make_unibyte_string ((char *) data, size); + /* 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 (type == gdk_atom_intern_static_string ("COMPOUND_TEXT")) + lispy_type = QCOMPOUND_TEXT; + else if (type == gdk_atom_intern_static_string ("UTF8_STRING")) + lispy_type = QUTF8_STRING; + else + lispy_type = QSTRING; + + Fput_text_property (make_fixnum (0), make_fixnum (size), + Qforeign_selection, lispy_type, str); + return str; + } + /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to + a vector of symbols. */ + else if (format == 32 + && (type == GDK_SELECTION_TYPE_ATOM + /* Treat ATOM_PAIR type similar to list of atoms. */ + || type == gdk_atom_intern_static_string ("ATOM_PAIR"))) + { + ptrdiff_t i; + GdkAtom *idata = (GdkAtom *) data; + + if (size == sizeof (GdkAtom)) + return gdk_atom_to_symbol (idata[0]); + else + { + Lisp_Object v = make_nil_vector (size / sizeof (GdkAtom)); + + for (i = 0; i < size / sizeof (GdkAtom); i++) + ASET (v, i, gdk_atom_to_symbol (idata[i])); + return v; + } + } + + /* Convert a single 16-bit number or a small 32-bit number to a Lisp_Int. + If the number is 32 bits and won't fit in a Lisp_Int, convert it + to a bignum. + + INTEGER is a signed type, CARDINAL is unsigned. + Assume any other types are unsigned as well. + */ + else if (format == 32 && size == sizeof (int)) + { + if (type == GDK_SELECTION_TYPE_INTEGER) + return INT_TO_INTEGER (((int *) data) [0]); + else + return INT_TO_INTEGER (((unsigned int *) data) [0]); + } + else if (format == 16 && size == sizeof (short)) + { + if (type == GDK_SELECTION_TYPE_INTEGER) + return make_fixnum (((short *) data) [0]); + else + return make_fixnum (((unsigned short *) data) [0]); + } + /* Convert any other kind of data to a vector of numbers, represented + as above (as an integer, or a cons of two 16 bit integers.) + */ + else if (format == 16) + { + ptrdiff_t i; + Lisp_Object v = make_uninit_vector (size / 2); + + if (type == GDK_SELECTION_TYPE_INTEGER) + { + for (i = 0; i < size / 2; i++) + { + short j = ((short *) data) [i]; + ASET (v, i, make_fixnum (j)); + } + } + else + { + for (i = 0; i < size / 2; i++) + { + unsigned short j = ((unsigned short *) data) [i]; + ASET (v, i, make_fixnum (j)); + } + } + return v; + } + else + { + ptrdiff_t i; + Lisp_Object v = make_nil_vector (size / sizeof (gint)); + + if (type == GDK_SELECTION_TYPE_INTEGER) + { + for (i = 0; i < size / sizeof (gint); i++) + { + int j = ((gint *) data) [i]; + ASET (v, i, INT_TO_INTEGER (j)); + } + } + else + { + for (i = 0; i < size / sizeof (gint); i++) + { + unsigned int j = ((unsigned int *) data) [i]; + ASET (v, i, INT_TO_INTEGER (j)); + } + } + return v; + } +} + +/* Convert OBJ to an X long value, and return it as unsigned long. + OBJ should be an integer or a cons representing an integer. + Treat values in the range X_LONG_MAX + 1 .. X_ULONG_MAX as X + unsigned long values: in theory these values are supposed to be + signed but in practice unsigned 32-bit data are communicated via X + selections and we need to support that. */ +static unsigned long +cons_to_gdk_long (Lisp_Object obj) +{ + if (G_MAXUINT32 <= INTMAX_MAX + || NILP (Fnatnump (CONSP (obj) ? XCAR (obj) : obj))) + return cons_to_signed (obj, 0, min (G_MAXUINT32, INTMAX_MAX)); + else + return cons_to_unsigned (obj, G_MAXUINT32); +} + +/* Use xfree, not XFree, to free the data obtained with this function. */ + +static void +lisp_data_to_selection_data (struct pgtk_display_info *dpyinfo, + Lisp_Object obj, struct selection_data *cs) +{ + Lisp_Object type = Qnil; + + eassert (cs != NULL); + cs->nofree = false; + + if (CONSP (obj) && SYMBOLP (XCAR (obj))) + { + type = XCAR (obj); + obj = XCDR (obj); + if (CONSP (obj) && NILP (XCDR (obj))) + obj = XCAR (obj); + } + + if (EQ (obj, QNULL) || (EQ (type, QNULL))) + { /* This is not the same as declining */ + cs->format = 32; + cs->size = 0; + cs->data = NULL; + type = QNULL; + } + else if (STRINGP (obj)) + { + if (SCHARS (obj) < SBYTES (obj)) + /* OBJ is a multibyte string containing a non-ASCII char. */ + signal_error ("Non-ASCII string must be encoded in advance", obj); + if (NILP (type)) + type = QSTRING; + cs->format = 8; + cs->size = SBYTES (obj); + cs->data = SDATA (obj); + cs->nofree = true; + } + else if (SYMBOLP (obj)) + { + void *data = xmalloc (sizeof (GdkAtom) + 1); + GdkAtom *x_atom_ptr = data; + cs->data = data; + cs->format = 32; + cs->size = 1; + cs->data[sizeof (GdkAtom)] = 0; + *x_atom_ptr = symbol_to_gdk_atom (obj); + if (NILP (type)) type = QATOM; + } + else if (RANGED_FIXNUMP (SHRT_MIN, obj, SHRT_MAX)) + { + void *data = xmalloc (sizeof (short) + 1); + short *short_ptr = data; + cs->data = data; + cs->format = 16; + cs->size = 1; + cs->data[sizeof (short)] = 0; + *short_ptr = XFIXNUM (obj); + if (NILP (type)) type = QINTEGER; + } + else if (INTEGERP (obj) + || (CONSP (obj) && INTEGERP (XCAR (obj)) + && (FIXNUMP (XCDR (obj)) + || (CONSP (XCDR (obj)) + && FIXNUMP (XCAR (XCDR (obj))))))) + { + void *data = xmalloc (sizeof (unsigned long) + 1); + unsigned long *x_long_ptr = data; + cs->data = data; + cs->format = 32; + cs->size = 1; + cs->data[sizeof (unsigned long)] = 0; + *x_long_ptr = cons_to_gdk_long (obj); + if (NILP (type)) type = QINTEGER; + } + else if (VECTORP (obj)) + { + /* Lisp_Vectors may represent a set of ATOMs; + a set of 16 or 32 bit INTEGERs; + or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...] + */ + ptrdiff_t i; + ptrdiff_t size = ASIZE (obj); + + if (SYMBOLP (AREF (obj, 0))) + /* This vector is an ATOM set */ + { + void *data; + GdkAtom *x_atoms; + if (NILP (type)) type = QATOM; + for (i = 0; i < size; i++) + if (!SYMBOLP (AREF (obj, i))) + signal_error ("All elements of selection vector must have same type", obj); + + cs->data = data = xnmalloc (size, sizeof *x_atoms); + x_atoms = data; + cs->format = 32; + cs->size = size; + for (i = 0; i < size; i++) + x_atoms[i] = symbol_to_gdk_atom (AREF (obj, i)); + } + else + /* This vector is an INTEGER set, or something like it */ + { + int format = 16; + int data_size = sizeof (short); + void *data; + unsigned long *x_atoms; + short *shorts; + if (NILP (type)) type = QINTEGER; + for (i = 0; i < size; i++) + { + if (! RANGED_FIXNUMP (SHRT_MIN, AREF (obj, i), SHRT_MAX)) + { + /* Use sizeof (long) even if it is more than 32 bits. + See comment in x_get_window_property and + x_fill_property_data. */ + data_size = sizeof (long); + format = 32; + break; + } + } + cs->data = data = xnmalloc (size, data_size); + x_atoms = data; + shorts = data; + cs->format = format; + cs->size = size; + for (i = 0; i < size; i++) + { + if (format == 32) + x_atoms[i] = cons_to_gdk_long (AREF (obj, i)); + else + shorts[i] = XFIXNUM (AREF (obj, i)); + } + } + } + else + signal_error (/* Qselection_error */ "Unrecognized selection data", obj); + + cs->type = symbol_to_gdk_atom (type); +} + +static Lisp_Object +clean_local_selection_data (Lisp_Object obj) +{ + if (CONSP (obj) + && INTEGERP (XCAR (obj)) + && CONSP (XCDR (obj)) + && FIXNUMP (XCAR (XCDR (obj))) + && NILP (XCDR (XCDR (obj)))) + obj = Fcons (XCAR (obj), XCDR (obj)); + + if (CONSP (obj) + && INTEGERP (XCAR (obj)) + && FIXNUMP (XCDR (obj))) + { + if (BASE_EQ (XCAR (obj), make_fixnum (0))) + return XCDR (obj); + if (BASE_EQ (XCAR (obj), make_fixnum (-1))) + return make_fixnum (- XFIXNUM (XCDR (obj))); + } + if (VECTORP (obj)) + { + ptrdiff_t i; + ptrdiff_t size = ASIZE (obj); + Lisp_Object copy; + if (size == 1) + return clean_local_selection_data (AREF (obj, 0)); + copy = make_nil_vector (size); + for (i = 0; i < size; i++) + ASET (copy, i, clean_local_selection_data (AREF (obj, i))); + return copy; + } + return obj; +} + +DEFUN ("pgtk-own-selection-internal", Fpgtk_own_selection_internal, + Spgtk_own_selection_internal, 2, 3, 0, + doc: /* Assert a 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 GDK 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) +{ + if (NILP (frame)) frame = selected_frame; + if (!FRAME_LIVE_P (XFRAME (frame)) || !FRAME_PGTK_P (XFRAME (frame))) + error ("GDK selection unavailable for this frame"); + + CHECK_SYMBOL (selection); + if (NILP (value)) error ("VALUE may not be nil"); + pgtk_own_selection (selection, value, frame); + return value; +} + +/* Request the selection value from the owner. If we are the owner, + simply return our selection value. If we are not the owner, this + will block until all of the data has arrived. */ + +DEFUN ("pgtk-get-selection-internal", Fpgtk_get_selection_internal, + Spgtk_get_selection_internal, 2, 4, 0, + doc: /* Return text selected from some X window. +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'. + +TIME-STAMP is the time to use in the XConvertSelection call for foreign +selections. If omitted, defaults to the time for the last event. + +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_symbol, Lisp_Object target_type, + Lisp_Object time_stamp, Lisp_Object terminal) +{ + Lisp_Object val = Qnil; + Lisp_Object maybe_alias; + struct frame *f = frame_for_pgtk_selection (terminal); + + CHECK_SYMBOL (selection_symbol); + CHECK_SYMBOL (target_type); + + if (EQ (target_type, QMULTIPLE)) + error ("Retrieving MULTIPLE selections is currently unimplemented"); + if (!f) + error ("GDK selection unavailable for this frame"); + + /* Quitting inside this function is okay, so we don't have to use + FOR_EACH_TAIL_SAFE. */ + maybe_alias = Fassq (selection_symbol, Vpgtk_selection_alias_alist); + + if (!NILP (maybe_alias)) + { + selection_symbol = XCDR (maybe_alias); + CHECK_SYMBOL (selection_symbol); + } + + val = pgtk_get_local_selection (selection_symbol, target_type, true, + FRAME_DISPLAY_INFO (f)); + + if (NILP (val) && FRAME_LIVE_P (f)) + { + Lisp_Object frame; + XSETFRAME (frame, f); + return pgtk_get_foreign_selection (selection_symbol, target_type, + time_stamp, frame); + } + + if (CONSP (val) && SYMBOLP (XCAR (val))) + { + val = XCDR (val); + if (CONSP (val) && NILP (XCDR (val))) + val = XCAR (val); + } + return clean_local_selection_data (val); +} + +DEFUN ("pgtk-disown-selection-internal", Fpgtk_disown_selection_internal, + Spgtk_disown_selection_internal, 1, 3, 0, + doc: /* If we own the selection SELECTION, disown it. +Disowning it means there is no such selection. + +Sets the last-change time for the selection to TIME-OBJECT (by default +the time of the last event). + +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 time_object, Lisp_Object terminal) +{ + guint32 timestamp; + GdkAtom selection_atom; + struct frame *f = frame_for_pgtk_selection (terminal); + struct pgtk_display_info *dpyinfo; + + if (!f) + return Qnil; + + dpyinfo = FRAME_DISPLAY_INFO (f); + CHECK_SYMBOL (selection); + + /* Don't disown the selection when we're not the owner. */ + if (NILP (LOCAL_SELECTION (selection, dpyinfo))) + return Qnil; + + selection_atom = symbol_to_gdk_atom (selection); + + block_input (); + if (NILP (time_object)) + timestamp = dpyinfo->last_user_time; + else + CONS_TO_INTEGER (time_object, guint32, timestamp); + gdk_selection_owner_set_for_display (dpyinfo->display, NULL, + selection_atom, timestamp, + TRUE); + unblock_input (); + + return Qt; +} + +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 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 GDK 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 GDK +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); + + CHECK_SYMBOL (selection); + if (NILP (selection)) selection = QPRIMARY; + if (EQ (selection, Qt)) selection = QSECONDARY; + + if (f && !NILP (LOCAL_SELECTION (selection, FRAME_DISPLAY_INFO (f)))) + return Qt; + else + return Qnil; +} + +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 selection. +SELECTION should be the name of the selection in question, typically +one of the symbols `PRIMARY', `SECONDARY', `CLIPBOARD', or +`CLIPBOARD_MANAGER' (GDK 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 GDK +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) +{ + GdkWindow *owner; + GdkAtom atom; + struct frame *f = frame_for_pgtk_selection (terminal); + struct pgtk_display_info *dpyinfo; + + CHECK_SYMBOL (selection); + if (NILP (selection)) selection = QPRIMARY; + if (EQ (selection, Qt)) selection = QSECONDARY; + + if (!f) + return Qnil; + + dpyinfo = FRAME_DISPLAY_INFO (f); + + if (!NILP (LOCAL_SELECTION (selection, dpyinfo))) + return Qt; + + atom = symbol_to_gdk_atom (selection); + if (atom == 0) return Qnil; + block_input (); + owner = gdk_selection_owner_get_for_display (dpyinfo->display, atom); + unblock_input (); + return (owner ? Qt : Qnil); +} + +/* Called to handle GDK_SELECTION_NOTIFY events. + If it's the selection we are waiting for, stop waiting + by setting the car of reading_selection_reply to non-nil. + We store t there if the reply is successful, lambda if not. */ + +void +pgtk_handle_selection_notify (GdkEventSelection *event) +{ + /* GDK doesn't populate event->requestor, contrary to what the ICCCM + says should be done with SelectionNotify events. */ + + if (event->selection != reading_which_selection) + return; + + XSETCAR (reading_selection_reply, + (event->property != GDK_NONE ? Qt : Qlambda)); +} + + +/*********************************************************************** + Drag and drop support +***********************************************************************/ + +DEFUN ("pgtk-register-dnd-targets", Fpgtk_register_dnd_targets, + Spgtk_register_dnd_targets, 2, 2, 0, + doc: /* Register TARGETS on FRAME. +TARGETS should be a list of strings describing data types (selection +targets) that can be dropped on top of FRAME. */) + (Lisp_Object frame, Lisp_Object targets) +{ + struct frame *f; + GtkTargetEntry *entries; + GtkTargetList *list; + ptrdiff_t length, n; + Lisp_Object tem, t; + char *buf; + USE_SAFE_ALLOCA; + + f = decode_window_system_frame (frame); + CHECK_LIST (targets); + length = list_length (targets); + n = 0; + entries = SAFE_ALLOCA (sizeof *entries * length); + memset (entries, 0, sizeof *entries * length); + tem = targets; + + FOR_EACH_TAIL (tem) + { + if (!CONSP (tem)) + continue; + + t = XCAR (tem); + + CHECK_STRING (t); + SAFE_ALLOCA_STRING (buf, t); + + entries[n++].target = buf; + } + CHECK_LIST_END (tem, targets); + + if (n != length) + emacs_abort (); + + list = gtk_target_list_new (entries, n); + gtk_drag_dest_set_target_list (FRAME_GTK_WIDGET (f), list); + gtk_target_list_unref (list); + + SAFE_FREE (); + + return Qnil; +} + +DEFUN ("pgtk-drop-finish", Fpgtk_drop_finish, Spgtk_drop_finish, 3, 3, 0, + doc: /* Finish the drag-n-drop event that happened at TIMESTAMP. +SUCCESS is whether or not the drop was successful, i.e. the action +chosen in the last call to `pgtk-update-drop-status' was performed. +TIMESTAMP is the time associated with the drag-n-drop event that is +being finished. +DELETE is whether or not the action was `move'. */) + (Lisp_Object success, Lisp_Object timestamp, Lisp_Object delete) +{ + pgtk_finish_drop (success, timestamp, delete); + + return Qnil; +} + +DEFUN ("pgtk-update-drop-status", Fpgtk_update_drop_status, + Spgtk_update_drop_status, 2, 2, 0, + doc: /* Update the status of the current drag-and-drop operation. +ACTION is the action the drop source should take. +TIMESTAMP is the same as in `pgtk-drop-finish'. */) + (Lisp_Object action, Lisp_Object timestamp) +{ + pgtk_update_drop_status (action, timestamp); + + return Qnil; +} + +void +syms_of_pgtkselect (void) +{ + DEFSYM (QCLIPBOARD, "CLIPBOARD"); + DEFSYM (QSECONDARY, "SECONDARY"); + DEFSYM (QTEXT, "TEXT"); + DEFSYM (QFILE_NAME, "FILE_NAME"); + DEFSYM (QSTRING, "STRING"); + DEFSYM (QINTEGER, "INTEGER"); + DEFSYM (QTIMESTAMP, "TIMESTAMP"); + DEFSYM (QTEXT, "TEXT"); + DEFSYM (QMULTIPLE, "MULTIPLE"); + DEFSYM (QNULL, "NULL"); + DEFSYM (QATOM, "ATOM"); + DEFSYM (QTARGETS, "TARGETS"); + DEFSYM (QUTF8_STRING, "UTF8_STRING"); + DEFSYM (QCOMPOUND_TEXT, "COMPOUND_TEXT"); + + DEFSYM (Qforeign_selection, "foreign-selection"); + + DEFSYM (Qpgtk_sent_selection_functions, "pgtk-sent-selection-functions"); + DEFSYM (Qpgtk_lost_selection_functions, "pgtk-lost-selection-functions"); + + 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); + defsubr (&Spgtk_register_dnd_targets); + defsubr (&Spgtk_update_drop_status); + defsubr (&Spgtk_drop_finish); + + DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist, + doc: /* SKIP: real doc in xselect.c. */); + Vselection_converter_alist = Qnil; + + DEFVAR_LISP ("pgtk-lost-selection-functions", Vpgtk_lost_selection_functions, + doc: /* A list of functions to be called when Emacs loses a selection. +\(This happens when some other client makes its own selection +or when a Lisp program explicitly clears the selection.) +The functions are called with one argument, the selection type +\(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */); + Vpgtk_lost_selection_functions = Qnil; + + DEFVAR_LISP ("pgtk-sent-selection-functions", Vpgtk_sent_selection_functions, + doc: /* A list of functions to be called when Emacs answers a selection request. +The functions are called with three 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. +xThis hook doesn't let you change the behavior of Emacs's selection replies, +it merely informs you that they have happened. */); + Vpgtk_sent_selection_functions = Qnil; + + 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_INT ("pgtk-selection-timeout", pgtk_selection_timeout, + doc: /* Number of milliseconds to wait for a selection reply. +If the selection owner doesn't reply in this time, we give up. +A value of 0 means wait as long as necessary. */); + pgtk_selection_timeout = 0; + + DEFVAR_LISP ("pgtk-selection-alias-alist", Vpgtk_selection_alias_alist, + doc: /* List of selections to alias to another. +It should be an alist of a selection name to another. When a +selection request arrives for the first selection, Emacs will respond +as if the request was meant for the other. + +Note that this does not affect setting or owning selections. */); + Vpgtk_selection_alias_alist = Qnil; + + reading_selection_reply = Fcons (Qnil, Qnil); + staticpro (&reading_selection_reply); + + property_change_reply = Fcons (Qnil, Qnil); + staticpro (&property_change_reply); +} diff --git a/src/pgtkterm.c b/src/pgtkterm.c new file mode 100644 index 00000000000..b283cef7cde --- /dev/null +++ b/src/pgtkterm.c @@ -0,0 +1,7303 @@ +/* Communication module for window systems using GTK. + +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 "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; + +/* Chain of existing displays */ +struct pgtk_display_info *x_display_list; + +struct event_queue_t +{ + union buffered_input_event *q; + int nr, cap; +}; + +/* A queue of events that will be read by the read_socket_hook. */ +static struct event_queue_t event_q; + +/* 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; + +/* The default Emacs icon . */ +static Lisp_Object xg_default_icon_file; + +/* The current GdkDragContext of a drop. */ +static GdkDragContext *current_drop_context; + +/* Whether or not current_drop_context was set from a drop + handler. */ +static bool current_drop_context_drop; + +/* The time of the last drop. */ +static guint32 current_drop_time; + +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; + struct frame *frame; + struct pgtk_display_info *dpyinfo; + + 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; + + if (ev->ie.kind != SELECTION_REQUEST_EVENT + && ev->ie.kind != SELECTION_CLEAR_EVENT) + { + frame = NULL; + + if (WINDOWP (ev->ie.frame_or_window)) + frame = WINDOW_XFRAME (XWINDOW (ev->ie.frame_or_window)); + + if (FRAMEP (ev->ie.frame_or_window)) + frame = XFRAME (ev->ie.frame_or_window); + + if (frame) + { + dpyinfo = FRAME_DISPLAY_INFO (frame); + + if (dpyinfo->last_user_time < ev->ie.timestamp) + dpyinfo->last_user_time = ev->ie.timestamp; + } + } + + 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 +pgtk_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 +pgtk_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) + pgtk_free_frame_resources (f); + + dpyinfo->reference_count--; +} + +/* Calculate the absolute position in frame F + from its current recorded position values and gravity. */ + +static void +pgtk_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 = (pgtk_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 = (pgtk_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; + } + + pgtk_calc_absolute_position (f); + + block_input (); + xg_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; + xg_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) +{ + 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) +{ + gtk_widget_hide (FRAME_WIDGET (f)); + + /* Handle any pending map event(s), then make the frame visible + manually, to avoid race conditions. */ + 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 +pgtk_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 +pgtk_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; + xg_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 +pgtk_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 +pgtk_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) + { + pgtk_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 +pgtk_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 +pgtk_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 +pgtk_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; + } + + /* Pacify GCC 12 even though s->char2b is not used after this + function returns. */ + s->char2b = NULL; +} + +/* 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 + + +/* Compute 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 computed color in *PIXEL. F + is the frame to act on. */ + +static void +pgtk_compute_lighter_color (struct frame *f, unsigned long *pixel, + double factor, int delta) +{ + Emacs_Color color, new; + long bright; + + /* 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); + } + } + + new.pixel = (new.red >> 8 << 16 + | new.green >> 8 << 8 + | new.blue >> 8); + + 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); + } + + *pixel = new.pixel; +} + +static void +pgtk_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 +pgtk_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); +} + +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; + pgtk_compute_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 (!di->relief_background_valid_p + || di->relief_background != color) + { + di->relief_background_valid_p = 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 +pgtk_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 + pgtk_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 + pgtk_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) + pgtk_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 +pgtk_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 +pgtk_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) + pgtk_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); + pgtk_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 +pgtk_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); +} + +static void +pgtk_draw_underwave (struct glyph_string *s, unsigned long color) +{ + int wave_height = 3, wave_length = 2; + + pgtk_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 +pgtk_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); + pgtk_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 +pgtk_draw_glyph_string_bg_rect (struct glyph_string *s, int x, int y, int w, + int h) +{ + if (s->stippled_p) + fill_background (s, x, y, w, h); + else + pgtk_clear_glyph_string_rect (s, x, y, w, h); +} + +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); +} + +/* Draw foreground of image glyph string S. */ + +static void +pgtk_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); + pgtk_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 +pgtk_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; + + pgtk_draw_glyph_string_bg_rect (s, x, y, width, height); + + s->background_filled_p = true; + } + + /* Draw the foreground. */ + pgtk_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) + pgtk_draw_image_relief (s); +} + +/* Draw stretch glyph string S. */ + +static void +pgtk_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. */ + pgtk_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 (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) + pgtk_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) + pgtk_draw_stretch_glyph_string (next); + else + pgtk_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); + pgtk_draw_glyph_string_background (s, true); + pgtk_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: + pgtk_draw_image_glyph_string (s); + break; + + case XWIDGET_GLYPH: + x_draw_xwidget_glyph_string (s); + break; + + case STRETCH_GLYPH: + pgtk_draw_stretch_glyph_string (s); + break; + + case CHAR_GLYPH: + if (s->for_overlaps) + s->background_filled_p = true; + else + pgtk_draw_glyph_string_background (s, false); + pgtk_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 + pgtk_draw_glyph_string_background (s, true); + pgtk_draw_composite_glyph_string_foreground (s); + break; + + case GLYPHLESS_GLYPH: + if (s->for_overlaps) + s->background_filled_p = true; + else + pgtk_draw_glyph_string_background (s, true); + pgtk_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) + pgtk_draw_glyph_string_box (s); + + /* Draw underline. */ + if (s->face->underline) + { + if (s->face->underline == FACE_UNDER_WAVE) + { + if (s->face->underline_defaulted_p) + pgtk_draw_underwave (s, s->xgcv.foreground); + else + pgtk_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 + explicitly 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) + pgtk_draw_glyph_string_foreground (prev); + else + pgtk_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) + pgtk_draw_glyph_string_foreground (next); + else + pgtk_draw_composite_glyph_string_foreground (next); + cairo_restore (cr); + next->hl = save; + next->num_clips = 0; + next->clip_head = s->next; + } + } + } + + /* TODO: figure out in which cases the stipple is actually drawn on + PGTK. */ + if (!s->row->stipple_p) + s->row->stipple_p = s->face->stipple; + + /* 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 +pgtk_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 +pgtk_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: + pgtk_draw_hollow_cursor (w, glyph_row); + break; + + case FILLED_BOX_CURSOR: + draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); + break; + + case BAR_CURSOR: + pgtk_draw_bar_cursor (w, glyph_row, cursor_width, BAR_CURSOR); + break; + + case HBAR_CURSOR: + pgtk_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))) + f1 = dpyinfo->last_mouse_frame; + else + { + f1 = *fp; + 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; + } + + win = gtk_widget_get_window (FRAME_GTK_WIDGET (f1)); + 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 (f1 != NULL) + { + 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_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 pgtk_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) +{ + +} + +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); + + /* This creates a GDK_INPUT_ONLY window. */ + x->hourglass_widget = gtk_event_box_new (); + 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 wait for the signal handler to run. */ + 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); + } +} + +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, +}; + +void +pgtk_clear_frame (struct frame *f) +{ + 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)); + unblock_input (); +} + +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; +} + +/* Invert the middle quarter of the frame for .15 sec. */ + +static void +pgtk_flash (struct frame *f) +{ + cairo_surface_t *surface_orig, *surface; + cairo_t *cr; + int width, height, flash_height, flash_left, flash_right; + struct timespec delay; + + if (!FRAME_CR_CONTEXT (f)) + return; + + block_input (); + + surface_orig = FRAME_CR_SURFACE (f); + + width = FRAME_CR_SURFACE_DESIRED_WIDTH (f); + height = FRAME_CR_SURFACE_DESIRED_HEIGHT (f); + surface = cairo_surface_create_similar (surface_orig, + CAIRO_CONTENT_COLOR_ALPHA, + width, height); + + 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. */ + height = FRAME_PIXEL_HEIGHT (f); + /* Height of each line to flash. */ + flash_height = FRAME_LINE_HEIGHT (f); + /* These will be the left and right margins of the rectangles. */ + flash_left = FRAME_INTERNAL_BORDER_WIDTH (f); + flash_right = (FRAME_PIXEL_WIDTH (f) + - FRAME_INTERNAL_BORDER_WIDTH (f)); + 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; + + 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 +pgtk_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 +pgtk_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 * +pgtk_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) + pgtk_create_horizontal_toolkit_scroll_bar (f, bar); + else + pgtk_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 +pgtk_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 = pgtk_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 = pgtk_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); + + pgtk_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) +{ + block_input (); + 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) +{ + GtkWidget *w; + char *css; + GtkStyleContext *ctxt; + GtkCssProvider *css_provider, *old; + + block_input (); + + w = FRAME_WIDGET (f); + + css = g_strdup_printf ("decoration { border: dotted %dpx #ffffff; }", + f->border_width); + + ctxt = gtk_widget_get_style_context (w); + 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); + + 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; + + /* This is needed to make the pointer visible upon receiving a + motion notify event. */ + gdk_display_flush (FRAME_X_DISPLAY (f)); +} + +/* 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 +pgtk_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) +{ + 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 = pgtk_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 = pgtk_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 = pgtk_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)); + + 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 + || 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); + GdkWindowState new_state; + union buffered_input_event inev; + + new_state = event->window_state.new_window_state; + + EVENT_INIT (inev.ie); + inev.ie.kind = NO_EVENT; + inev.ie.arg = Qnil; + + if (f) + { + if (new_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 (new_state & GDK_WINDOW_STATE_FULLSCREEN) + store_frame_param (f, Qfullscreen, Qfullboth); + else if (new_state & GDK_WINDOW_STATE_MAXIMIZED) + store_frame_param (f, Qfullscreen, Qmaximized); + else if ((new_state & GDK_WINDOW_STATE_TOP_TILED) + && (new_state & GDK_WINDOW_STATE_BOTTOM_TILED) + && !(new_state & GDK_WINDOW_STATE_TOP_RESIZABLE) + && !(new_state & GDK_WINDOW_STATE_BOTTOM_RESIZABLE)) + store_frame_param (f, Qfullscreen, Qfullheight); + else if ((new_state & GDK_WINDOW_STATE_LEFT_TILED) + && (new_state & GDK_WINDOW_STATE_RIGHT_TILED) + && !(new_state & GDK_WINDOW_STATE_LEFT_RESIZABLE) + && !(new_state & GDK_WINDOW_STATE_RIGHT_RESIZABLE)) + store_frame_param (f, Qfullscreen, Qfullwidth); + else + store_frame_param (f, Qfullscreen, Qnil); + + if (new_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 (new_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 +pgtk_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) + { + pgtk_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; + pgtk_new_focus_frame (dpyinfo, NULL); + + 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)) + pgtk_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)) + pgtk_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; + + pgtk_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; + + pgtk_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; + + 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; +} + + + +/* C part of drop handling code. + The Lisp part is in pgtk-dnd.el. */ + +static GdkDragAction +symbol_to_drag_action (Lisp_Object act) +{ + if (EQ (act, Qcopy)) + return GDK_ACTION_COPY; + + if (EQ (act, Qmove)) + return GDK_ACTION_MOVE; + + if (EQ (act, Qlink)) + return GDK_ACTION_LINK; + + if (EQ (act, Qprivate)) + return GDK_ACTION_PRIVATE; + + if (NILP (act)) + return GDK_ACTION_DEFAULT; + + signal_error ("Invalid drag acction", act); +} + +static Lisp_Object +drag_action_to_symbol (GdkDragAction action) +{ + switch (action) + { + case GDK_ACTION_COPY: + return Qcopy; + + case GDK_ACTION_MOVE: + return Qmove; + + case GDK_ACTION_LINK: + return Qlink; + + case GDK_ACTION_PRIVATE: + return Qprivate; + + case GDK_ACTION_DEFAULT: + default: + return Qnil; + } +} + +void +pgtk_update_drop_status (Lisp_Object action, Lisp_Object event_time) +{ + guint32 time; + + CONS_TO_INTEGER (event_time, guint32, time); + + if (!current_drop_context || time < current_drop_time) + return; + + gdk_drag_status (current_drop_context, + symbol_to_drag_action (action), + time); +} + +void +pgtk_finish_drop (Lisp_Object success, Lisp_Object event_time, + Lisp_Object del) +{ + guint32 time; + + CONS_TO_INTEGER (event_time, guint32, time); + + if (!current_drop_context || time < current_drop_time) + return; + + gtk_drag_finish (current_drop_context, !NILP (success), + !NILP (del), time); + + if (current_drop_context_drop) + g_clear_pointer (¤t_drop_context, + g_object_unref); +} + +static void +drag_leave (GtkWidget *widget, GdkDragContext *context, + guint time, gpointer user_data) +{ + struct frame *f; + union buffered_input_event inev; + + f = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + + if (current_drop_context) + { + if (current_drop_context_drop) + gtk_drag_finish (current_drop_context, + FALSE, FALSE, current_drop_time); + + g_clear_pointer (¤t_drop_context, + g_object_unref); + } + + EVENT_INIT (inev.ie); + + inev.ie.kind = DRAG_N_DROP_EVENT; + inev.ie.modifiers = 0; + inev.ie.arg = Qnil; + inev.ie.timestamp = time; + + XSETINT (inev.ie.x, 0); + XSETINT (inev.ie.y, 0); + XSETFRAME (inev.ie.frame_or_window, f); + + evq_enqueue (&inev); +} + +static gboolean +drag_motion (GtkWidget *widget, GdkDragContext *context, + gint x, gint y, guint time) + +{ + struct frame *f; + union buffered_input_event inev; + GdkAtom name; + GdkDragAction suggestion; + + f = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + + if (!f) + return FALSE; + + if (current_drop_context) + { + if (current_drop_context_drop) + gtk_drag_finish (current_drop_context, + FALSE, FALSE, current_drop_time); + + g_clear_pointer (¤t_drop_context, + g_object_unref); + } + + current_drop_context = g_object_ref (context); + current_drop_time = time; + current_drop_context_drop = false; + + name = gdk_drag_get_selection (context); + suggestion = gdk_drag_context_get_suggested_action (context); + + EVENT_INIT (inev.ie); + + inev.ie.kind = DRAG_N_DROP_EVENT; + inev.ie.modifiers = 0; + inev.ie.arg = list4 (Qlambda, intern (gdk_atom_name (name)), + make_uint (time), + drag_action_to_symbol (suggestion)); + inev.ie.timestamp = time; + + XSETINT (inev.ie.x, x); + XSETINT (inev.ie.y, y); + XSETFRAME (inev.ie.frame_or_window, f); + + evq_enqueue (&inev); + + return TRUE; +} + +static gboolean +drag_drop (GtkWidget *widget, GdkDragContext *context, + int x, int y, guint time, gpointer user_data) +{ + struct frame *f; + union buffered_input_event inev; + GdkAtom name; + GdkDragAction selected_action; + + f = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + + if (!f) + return FALSE; + + if (current_drop_context) + { + if (current_drop_context_drop) + gtk_drag_finish (current_drop_context, + FALSE, FALSE, current_drop_time); + + g_clear_pointer (¤t_drop_context, + g_object_unref); + } + + current_drop_context = g_object_ref (context); + current_drop_time = time; + current_drop_context_drop = true; + + name = gdk_drag_get_selection (context); + selected_action = gdk_drag_context_get_selected_action (context); + + EVENT_INIT (inev.ie); + + inev.ie.kind = DRAG_N_DROP_EVENT; + inev.ie.modifiers = 0; + inev.ie.arg = list4 (Qquote, intern (gdk_atom_name (name)), + make_uint (time), + drag_action_to_symbol (selected_action)); + inev.ie.timestamp = time; + + XSETINT (inev.ie.x, x); + XSETINT (inev.ie.y, y); + XSETFRAME (inev.ie.frame_or_window, f); + + evq_enqueue (&inev); + + return TRUE; +} + +static void +pgtk_monitors_changed_cb (GdkScreen *screen, gpointer user_data) +{ + struct terminal *terminal; + union buffered_input_event inev; + + EVENT_INIT (inev.ie); + terminal = user_data; + inev.ie.kind = MONITORS_CHANGED_EVENT; + XSETTERMINAL (inev.ie.arg, terminal); + + evq_enqueue (&inev); +} + +static gboolean pgtk_selection_event (GtkWidget *, GdkEvent *, gpointer); + +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), 0, NULL, 0, + (GDK_ACTION_MOVE | GDK_ACTION_COPY + | GDK_ACTION_LINK | GDK_ACTION_PRIVATE)); + + 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)), "configure-event", + G_CALLBACK (configure_event), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "drag-leave", + G_CALLBACK (drag_leave), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "drag-motion", + G_CALLBACK (drag_motion), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "drag-drop", + G_CALLBACK (drag_drop), 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)), "property-notify-event", + G_CALLBACK (pgtk_selection_event), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "selection-clear-event", + G_CALLBACK (pgtk_selection_event), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "selection-request-event", + G_CALLBACK (pgtk_selection_event), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "selection-notify-event", + G_CALLBACK (pgtk_selection_event), 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')); +} + +static struct frame * +pgtk_find_selection_owner (GdkWindow *window) +{ + Lisp_Object tail, tem; + struct frame *f; + + FOR_EACH_FRAME (tail, tem) + { + f = XFRAME (tem); + + if (FRAME_PGTK_P (f) + && (FRAME_GDK_WINDOW (f) == window)) + return f; + } + + return NULL; +} + +static gboolean +pgtk_selection_event (GtkWidget *widget, GdkEvent *event, + gpointer user_data) +{ + struct frame *f; + union buffered_input_event inev; + + if (event->type == GDK_PROPERTY_NOTIFY) + pgtk_handle_property_notify (&event->property); + else if (event->type == GDK_SELECTION_CLEAR + || event->type == GDK_SELECTION_REQUEST) + { + f = pgtk_find_selection_owner (event->selection.window); + + if (f) + { + EVENT_INIT (inev.ie); + + inev.sie.kind = (event->type == GDK_SELECTION_CLEAR + ? SELECTION_CLEAR_EVENT + : SELECTION_REQUEST_EVENT); + + SELECTION_EVENT_DPYINFO (&inev.sie) = FRAME_DISPLAY_INFO (f); + SELECTION_EVENT_SELECTION (&inev.sie) = event->selection.selection; + SELECTION_EVENT_TIME (&inev.sie) = event->selection.time; + + if (event->type == GDK_SELECTION_REQUEST) + { + /* FIXME: when does GDK destroy the requestor GdkWindow + object? + + It would make sense to wait for the transfer to + complete. But I don't know if GDK actually does + that. */ + SELECTION_EVENT_REQUESTOR (&inev.sie) = event->selection.requestor; + SELECTION_EVENT_TARGET (&inev.sie) = event->selection.target; + SELECTION_EVENT_PROPERTY (&inev.sie) = event->selection.property; + } + + evq_enqueue (&inev); + return TRUE; + } + } + else if (event->type == GDK_SELECTION_NOTIFY) + pgtk_handle_selection_notify (&event->selection); + + return FALSE; +} + +/* 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; + GdkScreen *gscr; + gdouble dpi; + + 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); + + gscr = gdk_display_get_default_screen (dpyinfo->gdpy); + dpi = gdk_screen_get_resolution (gscr); + + if (dpi < 0) + dpi = 96.0; + + dpyinfo->resx = dpi; + dpyinfo->resy = dpi; + + g_signal_connect (G_OBJECT (gscr), "monitors-changed", + G_CALLBACK (pgtk_monitors_changed_cb), + terminal); + + /* Set up scrolling increments. */ + dpyinfo->scroll.x_per_char = 1; + dpyinfo->scroll.y_per_line = 1; + + 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_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"); + + DEFSYM (Qcopy, "copy"); + DEFSYM (Qmove, "move"); + DEFSYM (Qlink, "link"); + DEFSYM (Qprivate, "private"); + + + 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)); +} diff --git a/src/pgtkterm.h b/src/pgtkterm.h new file mode 100644 index 00000000000..fcc6c5310e9 --- /dev/null +++ b/src/pgtkterm.h @@ -0,0 +1,648 @@ +/* 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 coordinate 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; + + union + { + /* This says how to access this display through GDK. */ + GdkDisplay *gdpy; + + /* An alias defined to make porting X code easier. */ + GdkDisplay *display; + }; + + /* 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; + + /* Time of last user interaction. */ + guint32 last_user_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; + + /* Whether or not a relief background has been computed for this + frame. */ + bool_bf relief_background_valid_p : 1; + + /* 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)) + +#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_GDK_WINDOW(f) \ + (gtk_widget_get_window (FRAME_GTK_WIDGET (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) + + +/* If a struct input_event has a kind which is SELECTION_REQUEST_EVENT + or SELECTION_CLEAR_EVENT, then its contents are really described + by this structure. */ + +/* For an event of kind SELECTION_REQUEST_EVENT, + this structure really describes the contents. */ + +struct selection_input_event +{ + ENUM_BF (event_kind) kind : EVENT_KIND_WIDTH; + struct pgtk_display_info *dpyinfo; + /* We spell it with an "o" here because X does. */ + GdkWindow *requestor; + GdkAtom selection, target, property; + guint32 time; +}; + +/* Unlike macros below, this can't be used as an lvalue. */ +INLINE GdkDisplay * +SELECTION_EVENT_DISPLAY (struct selection_input_event *ev) +{ + return ev->dpyinfo->display; +} +#define SELECTION_EVENT_DPYINFO(eventp) \ + ((eventp)->dpyinfo) +/* We spell it with an "o" here because X does. */ +#define SELECTION_EVENT_REQUESTOR(eventp) \ + ((eventp)->requestor) +#define SELECTION_EVENT_SELECTION(eventp) \ + ((eventp)->selection) +#define SELECTION_EVENT_TARGET(eventp) \ + ((eventp)->target) +#define SELECTION_EVENT_PROPERTY(eventp) \ + ((eventp)->property) +#define SELECTION_EVENT_TIME(eventp) \ + ((eventp)->time) + +extern void pgtk_handle_selection_event (struct selection_input_event *); +extern void pgtk_clear_frame_selections (struct frame *); +extern void pgtk_handle_property_notify (GdkEventProperty *); +extern void pgtk_handle_selection_notify (GdkEventSelection *); + +/* Display init/shutdown functions implemented in pgtkterm.c */ +extern struct pgtk_display_info *pgtk_term_init (Lisp_Object, char *); +extern void pgtk_term_shutdown (int); + +/* Implemented in pgtkterm, published in or needed from pgtkfns. */ +extern void pgtk_clear_frame (struct frame *); +extern char *pgtk_xlfd_to_fontname (const char *); + +/* Implemented in pgtkfns.c. */ +extern void pgtk_set_doc_edited (void); +extern const char *pgtk_get_defaults_value (const char *); +extern const char *pgtk_get_string_resource (XrmDatabase, const char *, const char *); +extern void pgtk_implicitly_set_name (struct frame *, Lisp_Object, Lisp_Object); + +/* Color management implemented in pgtkterm. */ +extern bool pgtk_defined_color (struct frame *, const char *, + Emacs_Color *, bool, bool); +extern void pgtk_query_color (struct frame *, Emacs_Color *); +extern void pgtk_query_colors (struct frame *, Emacs_Color *, int); +extern int pgtk_parse_color (struct frame *, const char *, Emacs_Color *); + +/* Implemented in pgtkterm.c */ +extern void pgtk_clear_area (struct frame *, int, int, int, int); +extern int pgtk_gtk_to_emacs_modifiers (struct pgtk_display_info *, int); +extern void pgtk_clear_under_internal_border (struct frame *); +extern void pgtk_set_event_handler (struct frame *); + +/* Implemented in pgtkterm.c */ +extern int pgtk_display_pixel_height (struct pgtk_display_info *); +extern int pgtk_display_pixel_width (struct pgtk_display_info *); + +extern void pgtk_destroy_window (struct frame *); +extern void pgtk_set_parent_frame (struct frame *, 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 *); +extern void pgtk_end_cr_clip (struct frame *); +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 *, struct frame *); +extern void pgtk_cr_destroy_frame_context (struct frame *); +extern Lisp_Object pgtk_cr_export_frames (Lisp_Object , cairo_surface_type_t); + +/* Defined in pgtkmenu.c */ +extern Lisp_Object pgtk_popup_dialog (struct frame *, Lisp_Object, Lisp_Object); +extern Lisp_Object pgtk_dialog_show (struct frame *, Lisp_Object, Lisp_Object, + const char **); +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 mark_pgtkterm (void); +extern void pgtk_delete_terminal (struct terminal *); + +extern void pgtk_make_frame_visible (struct frame *); +extern void pgtk_make_frame_invisible (struct frame *); +extern void pgtk_free_frame_resources (struct frame *); +extern void pgtk_iconify_frame (struct frame *); +extern void pgtk_focus_frame (struct frame *, bool); +extern void pgtk_set_scroll_bar_default_width (struct frame *); +extern void pgtk_set_scroll_bar_default_height (struct frame *); +extern Lisp_Object pgtk_get_focus_frame (struct frame *); + +extern void pgtk_frame_rehighlight (struct pgtk_display_info *); + +extern void pgtk_change_tab_bar_height (struct frame *, int); + +extern struct pgtk_display_info *check_pgtk_display_info (Lisp_Object); + +extern void pgtk_default_font_parameter (struct frame *, Lisp_Object); + +extern void pgtk_menu_set_in_use (bool); + +/* Drag and drop functions used by Lisp. */ +extern void pgtk_update_drop_status (Lisp_Object, Lisp_Object); +extern void pgtk_finish_drop (Lisp_Object, Lisp_Object, Lisp_Object); + +extern void pgtk_enqueue_string (struct frame *, gchar *); +extern void pgtk_enqueue_preedit (struct frame *, Lisp_Object); +extern void pgtk_im_focus_in (struct frame *); +extern void pgtk_im_focus_out (struct frame *); +extern bool pgtk_im_filter_keypress (struct frame *, GdkEventKey *); +extern void pgtk_im_set_cursor_location (struct frame *, int, int, + int, int); +extern void pgtk_im_init (struct pgtk_display_info *); +extern void pgtk_im_finish (struct pgtk_display_info *); + +extern bool xg_set_icon (struct frame *, Lisp_Object); +extern bool xg_set_icon_from_xpm_data (struct frame *, const char **); + +extern bool pgtk_text_icon (struct frame *, const char *); + +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 43ec0934ba1..b5a621f80aa 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)); \ @@ -467,8 +467,7 @@ print_string (Lisp_Object string, Lisp_Object printcharfun) if (chars < bytes) { newstr = make_uninit_multibyte_string (chars, bytes); - memcpy (SDATA (newstr), SDATA (string), chars); - str_to_multibyte (SDATA (newstr), bytes, chars); + str_to_multibyte (SDATA (newstr), SDATA (string), chars); string = newstr; } } @@ -556,7 +555,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 +563,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); @@ -620,7 +619,86 @@ If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */) return val; } -DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0, +static Lisp_Object Vprint_variable_mapping; + +static void +print_bind_all_defaults (void) +{ + for (Lisp_Object vars = Vprint_variable_mapping; !NILP (vars); + vars = XCDR (vars)) + { + Lisp_Object elem = XCDR (XCAR (vars)); + specbind (XCAR (elem), XCAR (XCDR (elem))); + } +} + +static void +print_create_variable_mapping (void) +{ + Lisp_Object total[] = { + list3 (intern ("length"), intern ("print-length"), Qnil), + list3 (intern ("level"), intern ("print-level"), Qnil), + list3 (intern ("circle"), intern ("print-circle"), Qnil), + list3 (intern ("quoted"), intern ("print-quoted"), Qt), + list3 (intern ("escape-newlines"), intern ("print-escape-newlines"), Qnil), + list3 (intern ("escape-control-characters"), + intern ("print-escape-control-characters"), Qnil), + list3 (intern ("escape-nonascii"), intern ("print-escape-nonascii"), Qnil), + list3 (intern ("escape-multibyte"), + intern ("print-escape-multibyte"), Qnil), + list3 (intern ("charset-text-property"), + intern ("print-charset-text-property"), Qnil), + list3 (intern ("unreadeable-function"), + intern ("print-unreadable-function"), Qnil), + list3 (intern ("gensym"), intern ("print-gensym"), Qnil), + list3 (intern ("continuous-numbering"), + intern ("print-continuous-numbering"), Qnil), + list3 (intern ("number-table"), intern ("print-number-table"), Qnil), + list3 (intern ("float-format"), intern ("float-output-format"), Qnil), + list3 (intern ("integers-as-characters"), + intern ("print-integers-as-characters"), Qnil), + }; + + Vprint_variable_mapping = CALLMANY (Flist, total); +} + +static void +print_bind_overrides (Lisp_Object overrides) +{ + if (NILP (Vprint_variable_mapping)) + print_create_variable_mapping (); + + if (EQ (overrides, Qt)) + print_bind_all_defaults (); + else if (!CONSP (overrides)) + xsignal (Qwrong_type_argument, Qconsp); + else + { + while (!NILP (overrides)) + { + Lisp_Object setting = XCAR (overrides); + if (EQ (setting, Qt)) + print_bind_all_defaults (); + else if (!CONSP (setting)) + xsignal (Qwrong_type_argument, Qconsp); + else + { + Lisp_Object key = XCAR (setting), + value = XCDR (setting); + Lisp_Object map = Fassq (key, Vprint_variable_mapping); + if (NILP (map)) + xsignal2 (Qwrong_type_argument, Qsymbolp, map); + specbind (XCAR (XCDR (map)), value); + } + + if (!NILP (XCDR (overrides)) && !CONSP (XCDR (overrides))) + xsignal (Qwrong_type_argument, Qconsp); + overrides = XCDR (overrides); + } + } +} + +DEFUN ("prin1", Fprin1, Sprin1, 1, 3, 0, doc: /* Output the printed representation of OBJECT, any Lisp object. Quoting characters are printed when needed to make output that `read' can handle, whenever this is possible. For complex objects, the behavior @@ -642,21 +720,43 @@ of these: - t, in which case the output is displayed in the echo area. If PRINTCHARFUN is omitted, the value of `standard-output' (which see) -is used instead. */) - (Lisp_Object object, Lisp_Object printcharfun) +is used instead. + +Optional argument OVERRIDES should be a list of settings for print-related +variables. An element in this list can be the symbol t, which means "reset +all the values to their defaults". Otherwise, an element should be a pair, +where the `car' or the pair is the setting symbol, and the `cdr' is the +value of the setting to use for this `prin1' call. + +For instance: + + (prin1 object nil \\='((length . 100) (circle . t))). + +See the manual entry `(elisp)Output Overrides' for a list of possible +values. + +As a special case, OVERRIDES can also simply be the symbol t, which +means "use default values for all the print-related settings". */) + (Lisp_Object object, Lisp_Object printcharfun, Lisp_Object overrides) { + specpdl_ref count = SPECPDL_INDEX (); + if (NILP (printcharfun)) printcharfun = Vstandard_output; + if (!NILP (overrides)) + print_bind_overrides (overrides); + PRINTPREPARE; print (object, printcharfun, 1); PRINTFINISH; - return object; + + return unbind_to (count, object); } /* A buffer which is used to hold output being built by prin1-to-string. */ Lisp_Object Vprin1_to_string_buffer; -DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0, +DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 3, 0, doc: /* Return a string containing the printed representation of OBJECT. OBJECT can be any Lisp object. This function outputs quoting characters when necessary to make output that `read' can handle, whenever possible, @@ -666,13 +766,18 @@ the behavior is controlled by `print-level' and `print-length', which see. OBJECT is any of the Lisp data types: a number, a string, a symbol, a list, a buffer, a window, a frame, etc. +See `prin1' for the meaning of OVERRIDES. + A printed representation of an object is text which describes that object. */) - (Lisp_Object object, Lisp_Object noescape) + (Lisp_Object object, Lisp_Object noescape, Lisp_Object overrides) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_modification_hooks, Qt); + if (!NILP (overrides)) + print_bind_overrides (overrides); + /* Save and restore this: we are altering a buffer but we don't want to deactivate the mark just for that. No need for specbind, since errors deactivate the mark. */ @@ -728,7 +833,13 @@ is used instead. */) if (NILP (printcharfun)) printcharfun = Vstandard_output; PRINTPREPARE; - print (object, printcharfun, 0); + if (STRINGP (object) + && !string_intervals (object) + && NILP (Vprint_continuous_numbering)) + /* fast path for plain strings */ + print_string (object, printcharfun); + else + print (object, printcharfun, 0); PRINTFINISH; return object; } @@ -768,6 +879,16 @@ is used instead. */) return object; } +DEFUN ("flush-standard-output", Fflush_standard_output, Sflush_standard_output, + 0, 0, 0, + doc: /* Flush standard-output. +This can be useful after using `princ' and the like in scripts. */) + (void) +{ + fflush (stdout); + return Qnil; +} + DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0, doc: /* Write CHARACTER to stderr. You can call `print' while debugging emacs, and pass it this function @@ -837,7 +958,7 @@ append to existing target file. */) void debug_print (Lisp_Object arg) { - Fprin1 (arg, Qexternal_debugging_output); + Fprin1 (arg, Qexternal_debugging_output, Qnil); fputs ("\r\n", stderr); } @@ -985,7 +1106,7 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context, || EQ (errname, Qend_of_file) || EQ (errname, Quser_error)) Fprinc (obj, stream); else - Fprin1 (obj, stream); + Fprin1 (obj, stream, Qnil); } } } @@ -1133,7 +1254,6 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) { /* Construct Vprint_number_table. This increments print_number_index for the objects added. */ - print_depth = 0; print_preprocess (obj); if (HASH_TABLE_P (Vprint_number_table)) @@ -1145,7 +1265,7 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) for (i = 0; i < HASH_TABLE_SIZE (h); ++i) { Lisp_Object key = HASH_KEY (h, i); - if (!EQ (key, Qunbound) + if (!BASE_EQ (key, Qunbound) && EQ (HASH_VALUE (h, i), Qt)) Fremhash (key, Vprint_number_table); } @@ -1157,10 +1277,7 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) } #define PRINT_CIRCLE_CANDIDATE_P(obj) \ - ((STRINGP (obj) \ - && (string_intervals (obj) \ - || print_depth > 1 \ - || !NILP (Vprint_continuous_numbering))) \ + (STRINGP (obj) \ || CONSP (obj) \ || (VECTORLIKEP (obj) \ && (VECTORP (obj) || COMPILEDP (obj) \ @@ -1171,6 +1288,78 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) && SYMBOLP (obj) \ && !SYMBOL_INTERNED_P (obj))) +/* The print preprocess stack, used to traverse data structures. */ + +struct print_pp_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; +}; + +struct print_pp_stack { + struct print_pp_entry *stack; /* base of stack */ + ptrdiff_t size; /* allocated size in entries */ + ptrdiff_t sp; /* current number of entries */ +}; + +static struct print_pp_stack ppstack = {NULL, 0, 0}; + +NO_INLINE static void +grow_pp_stack (void) +{ + struct print_pp_stack *ps = &ppstack; + eassert (ps->sp == ps->size); + ps->stack = xpalloc (ps->stack, &ps->size, 1, -1, sizeof *ps->stack); + eassert (ps->sp < ps->size); +} + +static inline void +pp_stack_push_value (Lisp_Object value) +{ + if (ppstack.sp >= ppstack.size) + grow_pp_stack (); + ppstack.stack[ppstack.sp++] = (struct print_pp_entry){.n = 0, + .u.value = value}; +} + +static inline void +pp_stack_push_values (Lisp_Object *values, ptrdiff_t n) +{ + eassume (n >= 0); + if (n == 0) + return; + if (ppstack.sp >= ppstack.size) + grow_pp_stack (); + ppstack.stack[ppstack.sp++] = (struct print_pp_entry){.n = n, + .u.values = values}; +} + +static inline bool +pp_stack_empty_p (void) +{ + return ppstack.sp <= 0; +} + +static inline Lisp_Object +pp_stack_pop (void) +{ + eassume (!pp_stack_empty_p ()); + struct print_pp_entry *e = &ppstack.stack[ppstack.sp - 1]; + if (e->n == 0) /* single value */ + { + --ppstack.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) + --ppstack.sp; /* last value consumed */ + return (++e->u.values)[-1]; +} + /* Construct Vprint_number_table for the print-circle feature according to the structure of OBJ. OBJ itself and all its elements will be added to Vprint_number_table recursively if it is a list, @@ -1182,86 +1371,81 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) static void print_preprocess (Lisp_Object obj) { - int i; - ptrdiff_t size; - int loop_count = 0; - Lisp_Object halftail; - eassert (!NILP (Vprint_circle)); + ptrdiff_t base_sp = ppstack.sp; - print_depth++; - halftail = obj; - - loop: - if (PRINT_CIRCLE_CANDIDATE_P (obj)) + for (;;) { - if (!HASH_TABLE_P (Vprint_number_table)) - Vprint_number_table = CALLN (Fmake_hash_table, QCtest, Qeq); - - Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil); - if (!NILP (num) - /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym, - always print the gensym with a number. This is a special for - the lisp function byte-compile-output-docform. */ - || (!NILP (Vprint_continuous_numbering) - && SYMBOLP (obj) - && !SYMBOL_INTERNED_P (obj))) - { /* OBJ appears more than once. Let's remember that. */ - if (!FIXNUMP (num)) - { - print_number_index++; - /* Negative number indicates it hasn't been printed yet. */ - Fputhash (obj, make_fixnum (- print_number_index), - Vprint_number_table); + if (PRINT_CIRCLE_CANDIDATE_P (obj)) + { + if (!HASH_TABLE_P (Vprint_number_table)) + Vprint_number_table = CALLN (Fmake_hash_table, QCtest, Qeq); + + Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil); + if (!NILP (num) + /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym, + always print the gensym with a number. This is a special for + the lisp function byte-compile-output-docform. */ + || (!NILP (Vprint_continuous_numbering) + && SYMBOLP (obj) + && !SYMBOL_INTERNED_P (obj))) + { /* OBJ appears more than once. Let's remember that. */ + if (!FIXNUMP (num)) + { + print_number_index++; + /* Negative number indicates it hasn't been printed yet. */ + Fputhash (obj, make_fixnum (- print_number_index), + Vprint_number_table); + } } - print_depth--; - return; - } - else - /* OBJ is not yet recorded. Let's add to the table. */ - Fputhash (obj, Qt, Vprint_number_table); + else + { + /* OBJ is not yet recorded. Let's add to the table. */ + Fputhash (obj, Qt, Vprint_number_table); - switch (XTYPE (obj)) - { - case Lisp_String: - /* A string may have text properties, which can be circular. */ - traverse_intervals_noorder (string_intervals (obj), - print_preprocess_string, NULL); - break; + switch (XTYPE (obj)) + { + case Lisp_String: + /* A string may have text properties, + which can be circular. */ + traverse_intervals_noorder (string_intervals (obj), + print_preprocess_string, NULL); + break; - case Lisp_Cons: - /* Use HALFTAIL and LOOP_COUNT to detect circular lists, - just as in print_object. */ - if (loop_count && EQ (obj, halftail)) - break; - print_preprocess (XCAR (obj)); - obj = XCDR (obj); - loop_count++; - if (!(loop_count & 1)) - halftail = XCDR (halftail); - goto loop; - - case Lisp_Vectorlike: - size = ASIZE (obj); - if (size & PSEUDOVECTOR_FLAG) - size &= PSEUDOVECTOR_SIZE_MASK; - for (i = (SUB_CHAR_TABLE_P (obj) - ? SUB_CHAR_TABLE_OFFSET : 0); i < size; i++) - print_preprocess (AREF (obj, i)); - if (HASH_TABLE_P (obj)) - { /* For hash tables, the key_and_value slot is past - `size' because it needs to be marked specially in case - the table is weak. */ - struct Lisp_Hash_Table *h = XHASH_TABLE (obj); - print_preprocess (h->key_and_value); - } - break; + case Lisp_Cons: + if (!NILP (XCDR (obj))) + pp_stack_push_value (XCDR (obj)); + obj = XCAR (obj); + continue; - default: - break; + case Lisp_Vectorlike: + { + struct Lisp_Vector *vec = XVECTOR (obj); + ptrdiff_t size = ASIZE (obj); + if (size & PSEUDOVECTOR_FLAG) + size &= PSEUDOVECTOR_SIZE_MASK; + ptrdiff_t start = (SUB_CHAR_TABLE_P (obj) + ? SUB_CHAR_TABLE_OFFSET : 0); + pp_stack_push_values (vec->contents + start, size - start); + if (HASH_TABLE_P (obj)) + { + struct Lisp_Hash_Table *h = XHASH_TABLE (obj); + obj = h->key_and_value; + continue; + } + break; + } + + default: + break; + } + } } + + if (ppstack.sp <= base_sp) + break; + obj = pp_stack_pop (); } - print_depth--; } DEFUN ("print--preprocess", Fprint_preprocess, Sprint_preprocess, 1, 1, 0, @@ -1394,6 +1578,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: @@ -1405,8 +1590,84 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, strout (str, len, len, printcharfun); SAFE_FREE (); } + return true; + + case PVEC_BOOL_VECTOR: + { + EMACS_INT size = bool_vector_size (obj); + ptrdiff_t size_in_bytes = bool_vector_bytes (size); + ptrdiff_t real_size_in_bytes = size_in_bytes; + unsigned char *data = bool_vector_uchar_data (obj); + + int len = sprintf (buf, "#&%"pI"d\"", size); + strout (buf, len, len, printcharfun); + + /* Don't print more bytes than the specified maximum. + Negative values of print-length are invalid. Treat them + like a print-length of nil. */ + if (FIXNATP (Vprint_length) + && XFIXNAT (Vprint_length) < size_in_bytes) + size_in_bytes = XFIXNAT (Vprint_length); + + for (ptrdiff_t i = 0; i < size_in_bytes; i++) + { + maybe_quit (); + unsigned char c = data[i]; + if (c == '\n' && print_escape_newlines) + print_c_string ("\\n", printcharfun); + else if (c == '\f' && print_escape_newlines) + print_c_string ("\\f", printcharfun); + else if (c > '\177' + || (print_escape_control_characters && c_iscntrl (c))) + { + /* Use octal escapes to avoid encoding issues. */ + octalout (c, data, i + 1, size_in_bytes, printcharfun); + } + else + { + if (c == '\"' || c == '\\') + printchar ('\\', printcharfun); + printchar (c, printcharfun); + } + } + + if (size_in_bytes < real_size_in_bytes) + 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? */ @@ -1423,6 +1684,30 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, 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) @@ -1444,7 +1729,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, print_c_string ("#<user-ptr ", printcharfun); int i = sprintf (buf, "ptr=%p finalizer=%p", XUSER_PTR (obj)->p, - XUSER_PTR (obj)->finalizer); + (void *) XUSER_PTR (obj)->finalizer); strout (buf, i, i, printcharfun); printchar ('>', printcharfun); } @@ -1477,59 +1762,37 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, print_string (XPROCESS (obj)->name, printcharfun); break; - case PVEC_BOOL_VECTOR: - { - EMACS_INT size = bool_vector_size (obj); - ptrdiff_t size_in_bytes = bool_vector_bytes (size); - ptrdiff_t real_size_in_bytes = size_in_bytes; - unsigned char *data = bool_vector_uchar_data (obj); - - int len = sprintf (buf, "#&%"pI"d\"", size); - strout (buf, len, len, printcharfun); - - /* Don't print more bytes than the specified maximum. - Negative values of print-length are invalid. Treat them - like a print-length of nil. */ - if (FIXNATP (Vprint_length) - && XFIXNAT (Vprint_length) < size_in_bytes) - size_in_bytes = XFIXNAT (Vprint_length); - - for (ptrdiff_t i = 0; i < size_in_bytes; i++) - { - maybe_quit (); - unsigned char c = data[i]; - if (c == '\n' && print_escape_newlines) - print_c_string ("\\n", printcharfun); - else if (c == '\f' && print_escape_newlines) - print_c_string ("\\f", printcharfun); - else if (c > '\177' - || (print_escape_control_characters && c_iscntrl (c))) - { - /* Use octal escapes to avoid encoding issues. */ - octalout (c, data, i + 1, size_in_bytes, printcharfun); - } - else - { - if (c == '\"' || c == '\\') - printchar ('\\', printcharfun); - printchar (c, printcharfun); - } - } - - if (size_in_bytes < real_size_in_bytes) - 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); + 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; @@ -1562,79 +1825,6 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, } break; - case PVEC_HASH_TABLE: - { - struct Lisp_Hash_Table *h = XHASH_TABLE (obj); - /* Implement a readable output, e.g.: - #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */ - /* Always print the size. */ - int len = sprintf (buf, "#s(hash-table size %"pD"d", - HASH_TABLE_SIZE (h)); - strout (buf, len, len, printcharfun); - - if (!NILP (h->test.name)) - { - print_c_string (" test ", printcharfun); - print_object (h->test.name, printcharfun, escapeflag); - } - - if (!NILP (h->weak)) - { - print_c_string (" weakness ", printcharfun); - print_object (h->weak, printcharfun, escapeflag); - } - - print_c_string (" rehash-size ", printcharfun); - print_object (Fhash_table_rehash_size (obj), - printcharfun, escapeflag); - - print_c_string (" rehash-threshold ", printcharfun); - print_object (Fhash_table_rehash_threshold (obj), - printcharfun, escapeflag); - - if (h->purecopy) - { - print_c_string (" purecopy ", printcharfun); - print_object (h->purecopy ? Qt : Qnil, printcharfun, escapeflag); - } - - print_c_string (" data ", printcharfun); - - /* Print the data here as a plist. */ - ptrdiff_t real_size = HASH_TABLE_SIZE (h); - ptrdiff_t size = h->count; - - /* Don't print more elements than the specified maximum. */ - if (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size) - size = XFIXNAT (Vprint_length); - - printchar ('(', printcharfun); - ptrdiff_t j = 0; - for (ptrdiff_t i = 0; i < real_size; i++) - { - Lisp_Object key = HASH_KEY (h, i); - if (!EQ (key, Qunbound)) - { - if (j++) printchar (' ', printcharfun); - print_object (key, printcharfun, escapeflag); - printchar (' ', printcharfun); - print_object (HASH_VALUE (h, i), printcharfun, escapeflag); - if (j == size) - break; - } - } - - if (j < h->count) - { - if (j) - printchar (' ', printcharfun); - print_c_string ("...", printcharfun); - } - - print_c_string ("))", printcharfun); - } - break; - case PVEC_BUFFER: if (!BUFFER_LIVE_P (XBUFFER (obj))) print_c_string ("#<killed buffer>", printcharfun); @@ -1710,7 +1900,8 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, print_string (XTHREAD (obj)->name, printcharfun); else { - int len = sprintf (buf, "%p", XTHREAD (obj)); + void *p = XTHREAD (obj); + int len = sprintf (buf, "%p", p); strout (buf, len, len, printcharfun); } printchar ('>', printcharfun); @@ -1722,7 +1913,8 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, print_string (XMUTEX (obj)->name, printcharfun); else { - int len = sprintf (buf, "%p", XMUTEX (obj)); + void *p = XMUTEX (obj); + int len = sprintf (buf, "%p", p); strout (buf, len, len, printcharfun); } printchar ('>', printcharfun); @@ -1734,95 +1926,13 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, print_string (XCONDVAR (obj)->name, printcharfun); else { - int len = sprintf (buf, "%p", XCONDVAR (obj)); + void *p = XCONDVAR (obj); + int len = sprintf (buf, "%p", p); strout (buf, len, len, printcharfun); } 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: { @@ -1864,6 +1974,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 (); } @@ -1889,32 +2015,132 @@ named_escape (int i) return 0; } +enum print_entry_type + { + PE_list, /* print rest of list */ + PE_rbrac, /* print ")" */ + PE_vector, /* print rest of vector */ + PE_hash, /* print rest of hash data */ + }; + +struct print_stack_entry +{ + enum print_entry_type type; + + union + { + struct + { + Lisp_Object last; /* cons whose car was just printed */ + intmax_t maxlen; /* max number of elements left to print */ + /* State for Brent cycle detection. See + Brent RP. BIT. 1980;20(2):176-184. doi:10.1007/BF01933190 + https://maths-people.anu.edu.au/~brent/pd/rpb051i.pdf */ + Lisp_Object tortoise; /* slow pointer */ + ptrdiff_t n; /* tortoise step countdown */ + ptrdiff_t m; /* tortoise step period */ + intmax_t tortoise_idx; /* index of tortoise */ + } list; + + struct + { + Lisp_Object obj; /* object to print after " . " */ + } dotted_cdr; + + struct + { + Lisp_Object obj; /* vector object */ + ptrdiff_t size; /* length of vector */ + ptrdiff_t idx; /* index of next element */ + const char *end; /* string to print at end */ + bool truncated; /* whether to print "..." before end */ + } vector; + + struct + { + Lisp_Object obj; /* hash-table object */ + ptrdiff_t nobjs; /* number of keys and values to print */ + ptrdiff_t idx; /* index of key-value pair */ + ptrdiff_t printed; /* number of keys and values printed */ + bool truncated; /* whether to print "..." before end */ + } hash; + } u; +}; + +struct print_stack +{ + struct print_stack_entry *stack; /* base of stack */ + ptrdiff_t size; /* allocated size in entries */ + ptrdiff_t sp; /* current number of entries */ +}; + +static struct print_stack prstack = {NULL, 0, 0}; + +NO_INLINE static void +grow_print_stack (void) +{ + struct print_stack *ps = &prstack; + eassert (ps->sp == ps->size); + ps->stack = xpalloc (ps->stack, &ps->size, 1, -1, sizeof *ps->stack); + eassert (ps->sp < ps->size); +} + +static inline void +print_stack_push (struct print_stack_entry e) +{ + if (prstack.sp >= prstack.size) + grow_print_stack (); + prstack.stack[prstack.sp++] = e; +} + +static void +print_stack_push_vector (const char *lbrac, const char *rbrac, + Lisp_Object obj, ptrdiff_t start, ptrdiff_t size, + Lisp_Object printcharfun) +{ + print_c_string (lbrac, printcharfun); + + ptrdiff_t print_size = ((FIXNATP (Vprint_length) + && XFIXNAT (Vprint_length) < size) + ? XFIXNAT (Vprint_length) : size); + print_stack_push ((struct print_stack_entry){ + .type = PE_vector, + .u.vector.obj = obj, + .u.vector.size = print_size, + .u.vector.idx = start, + .u.vector.end = rbrac, + .u.vector.truncated = (print_size < size), + }); +} + static void print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) { + ptrdiff_t base_depth = print_depth; + ptrdiff_t base_sp = prstack.sp; char buf[max (sizeof "from..to..in " + 2 * INT_STRLEN_BOUND (EMACS_INT), max (sizeof " . #" + INT_STRLEN_BOUND (intmax_t), max ((sizeof " with data 0x" + (sizeof (uintmax_t) * CHAR_BIT + 4 - 1) / 4), 40)))]; current_thread->stack_top = buf; + + print_obj: maybe_quit (); /* Detect circularities and truncate them. */ if (NILP (Vprint_circle)) { /* Simple but incomplete way. */ - int i; - if (print_depth >= PRINT_CIRCLE) error ("Apparently circular structure being printed"); - for (i = 0; i < print_depth; i++) - if (EQ (obj, being_printed[i])) + for (int i = 0; i < print_depth; i++) + if (BASE_EQ (obj, being_printed[i])) { int len = sprintf (buf, "#%d", i); strout (buf, len, len, printcharfun); - return; + goto next_obj; } being_printed[print_depth] = obj; } @@ -1938,7 +2164,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) /* Just print #n# if OBJ has already been printed. */ int len = sprintf (buf, "#%"pI"d#", n); strout (buf, len, len, printcharfun); - return; + goto next_obj; } } } @@ -1972,8 +2198,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; @@ -2010,7 +2238,8 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) for (i = 0, i_byte = 0; i_byte < size_byte;) { /* Here, we must convert each multi-byte form to the - corresponding character code before handing it to printchar. */ + corresponding character code before handing it to + printchar. */ int c = fetch_string_char_advance (obj, &i, &i_byte); maybe_quit (); @@ -2030,7 +2259,8 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) else if (multibyte && ! ASCII_CHAR_P (c) && print_escape_multibyte) { - /* When requested, print multibyte chars using hex escapes. */ + /* When requested, print multibyte chars using + hex escapes. */ char outbuf[sizeof "\\x" + INT_STRLEN_BOUND (c)]; int len = sprintf (outbuf, "\\x%04x", c + 0u); strout (outbuf, len, len, printcharfun); @@ -2083,14 +2313,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)) @@ -2113,8 +2348,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) { @@ -2136,14 +2371,22 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) && EQ (XCAR (obj), Qquote)) { printchar ('\'', printcharfun); - print_object (XCAR (XCDR (obj)), printcharfun, escapeflag); + obj = XCAR (XCDR (obj)); + --print_depth; /* tail recursion */ + goto print_obj; } else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj))) && EQ (XCAR (obj), Qfunction)) { print_c_string ("#'", printcharfun); - print_object (XCAR (XCDR (obj)), printcharfun, escapeflag); + obj = XCAR (XCDR (obj)); + --print_depth; /* tail recursion */ + goto print_obj; } + /* FIXME: Do we really need the new_backquote_output gating of + special syntax for comma and comma-at? There is basically no + benefit from it at all, and it would be nice to get rid of + the recursion here without additional complexity. */ else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj))) && EQ (XCAR (obj), Qbackquote)) { @@ -2153,9 +2396,9 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) new_backquote_output--; } else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj))) - && new_backquote_output && (EQ (XCAR (obj), Qcomma) - || EQ (XCAR (obj), Qcomma_at))) + || EQ (XCAR (obj), Qcomma_at)) + && new_backquote_output) { print_object (XCAR (obj), printcharfun, false); new_backquote_output--; @@ -2165,70 +2408,135 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) else { printchar ('(', printcharfun); - /* Negative values of print-length are invalid in CL. Treat them like nil, as CMUCL does. */ intmax_t print_length = (FIXNATP (Vprint_length) ? XFIXNAT (Vprint_length) : INTMAX_MAX); - Lisp_Object objtail = Qnil; - intmax_t i = 0; - FOR_EACH_TAIL_SAFE (obj) + if (print_length == 0) + print_c_string ("...)", printcharfun); + else { - if (i != 0) - { - printchar (' ', printcharfun); - - if (!NILP (Vprint_circle)) - { - /* With the print-circle feature. */ - Lisp_Object num = Fgethash (obj, Vprint_number_table, - Qnil); - if (FIXNUMP (num)) - { - print_c_string (". ", printcharfun); - print_object (obj, printcharfun, escapeflag); - goto end_of_list; - } - } - } - - if (print_length <= i) - { - print_c_string ("...", printcharfun); - goto end_of_list; - } - - i++; - print_object (XCAR (obj), printcharfun, escapeflag); - objtail = XCDR (obj); + print_stack_push ((struct print_stack_entry){ + .type = PE_list, + .u.list.last = obj, + .u.list.maxlen = print_length, + .u.list.tortoise = obj, + .u.list.n = 2, + .u.list.m = 2, + .u.list.tortoise_idx = 0, + }); + /* print the car */ + obj = XCAR (obj); + goto print_obj; } + } + break; - /* OBJTAIL non-nil here means it's the end of a dotted list - or FOR_EACH_TAIL_SAFE detected a circular list. */ - if (!NILP (objtail)) - { - print_c_string (" . ", printcharfun); + case Lisp_Vectorlike: + /* First do all the vectorlike types that have a readable syntax. */ + switch (PSEUDOVECTOR_TYPE (XVECTOR (obj))) + { + case PVEC_NORMAL_VECTOR: + { + print_stack_push_vector ("[", "]", obj, 0, ASIZE (obj), + printcharfun); + goto next_obj; + } + case PVEC_RECORD: + { + print_stack_push_vector ("#s(", ")", obj, 0, PVSIZE (obj), + printcharfun); + goto next_obj; + } + case PVEC_COMPILED: + { + print_stack_push_vector ("#[", "]", obj, 0, PVSIZE (obj), + printcharfun); + goto next_obj; + } + case PVEC_CHAR_TABLE: + { + print_stack_push_vector ("#^[", "]", obj, 0, PVSIZE (obj), + printcharfun); + goto next_obj; + } + case PVEC_SUB_CHAR_TABLE: + { + /* Make each lowest sub_char_table start a new line. + Otherwise we'll make a line extremely long, which + results in slow redisplay. */ + if (XSUB_CHAR_TABLE (obj)->depth == 3) + printchar ('\n', printcharfun); + print_c_string ("#^^[", printcharfun); + int n = sprintf (buf, "%d %d", + XSUB_CHAR_TABLE (obj)->depth, + XSUB_CHAR_TABLE (obj)->min_char); + strout (buf, n, n, printcharfun); + print_stack_push_vector ("", "]", obj, + SUB_CHAR_TABLE_OFFSET, PVSIZE (obj), + printcharfun); + goto next_obj; + } + case PVEC_HASH_TABLE: + { + struct Lisp_Hash_Table *h = XHASH_TABLE (obj); + /* Implement a readable output, e.g.: + #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */ + /* Always print the size. */ + int len = sprintf (buf, "#s(hash-table size %"pD"d", + HASH_TABLE_SIZE (h)); + strout (buf, len, len, printcharfun); - if (CONSP (objtail) && NILP (Vprint_circle)) - { - int len = sprintf (buf, "#%"PRIdMAX, i >> 1); - strout (buf, len, len, printcharfun); - goto end_of_list; - } + if (!NILP (h->test.name)) + { + print_c_string (" test ", printcharfun); + print_object (h->test.name, printcharfun, escapeflag); + } - print_object (objtail, printcharfun, escapeflag); - } + if (!NILP (h->weak)) + { + print_c_string (" weakness ", printcharfun); + print_object (h->weak, printcharfun, escapeflag); + } - end_of_list: - printchar (')', printcharfun); + print_c_string (" rehash-size ", printcharfun); + print_object (Fhash_table_rehash_size (obj), + printcharfun, escapeflag); + + print_c_string (" rehash-threshold ", printcharfun); + print_object (Fhash_table_rehash_threshold (obj), + printcharfun, escapeflag); + + if (h->purecopy) + print_c_string (" purecopy t", printcharfun); + + print_c_string (" data (", printcharfun); + + ptrdiff_t size = h->count; + /* Don't print more elements than the specified maximum. */ + if (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size) + size = XFIXNAT (Vprint_length); + + print_stack_push ((struct print_stack_entry){ + .type = PE_hash, + .u.hash.obj = obj, + .u.hash.nobjs = size * 2, + .u.hash.idx = 0, + .u.hash.printed = 0, + .u.hash.truncated = (size < h->count), + }); + goto next_obj; + } + + default: + break; } - break; - case Lisp_Vectorlike: if (print_vectorlike (obj, printcharfun, escapeflag, buf)) break; FALLTHROUGH; + default: { int len; @@ -2243,10 +2551,157 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) print_c_string ((" Save your buffers immediately" " and please report this bug>"), printcharfun); + break; } } - print_depth--; + + next_obj: + if (prstack.sp > base_sp) + { + /* Handle a continuation on the print stack. */ + struct print_stack_entry *e = &prstack.stack[prstack.sp - 1]; + switch (e->type) + { + case PE_list: + { + /* after "(" ELEM (* " " ELEM) */ + Lisp_Object next = XCDR (e->u.list.last); + if (NILP (next)) + { + /* end of list: print ")" */ + printchar (')', printcharfun); + --prstack.sp; + --print_depth; + goto next_obj; + } + else if (CONSP (next)) + { + if (!NILP (Vprint_circle)) + { + /* With the print-circle feature. */ + Lisp_Object num = Fgethash (next, Vprint_number_table, + Qnil); + if (FIXNUMP (num)) + { + print_c_string (" . ", printcharfun); + obj = next; + e->type = PE_rbrac; + goto print_obj; + } + } + + /* list continues: print " " ELEM ... */ + + printchar (' ', printcharfun); + + --e->u.list.maxlen; + if (e->u.list.maxlen <= 0) + { + print_c_string ("...)", printcharfun); + --prstack.sp; + --print_depth; + goto next_obj; + } + + e->u.list.last = next; + e->u.list.n--; + if (e->u.list.n == 0) + { + /* Double tortoise update period and teleport it. */ + e->u.list.tortoise_idx += e->u.list.m; + e->u.list.m <<= 1; + e->u.list.n = e->u.list.m; + e->u.list.tortoise = next; + } + else if (BASE_EQ (next, e->u.list.tortoise)) + { + /* FIXME: This #N tail index is somewhat ambiguous; + see bug#55395. */ + int len = sprintf (buf, ". #%" PRIdMAX ")", + e->u.list.tortoise_idx); + strout (buf, len, len, printcharfun); + --prstack.sp; + --print_depth; + goto next_obj; + } + obj = XCAR (next); + } + else + { + /* non-nil ending: print " . " ELEM ")" */ + print_c_string (" . ", printcharfun); + obj = next; + e->type = PE_rbrac; + } + break; + } + + case PE_rbrac: + printchar (')', printcharfun); + --prstack.sp; + --print_depth; + goto next_obj; + + case PE_vector: + if (e->u.vector.idx >= e->u.vector.size) + { + if (e->u.vector.truncated) + { + if (e->u.vector.idx > 0) + printchar (' ', printcharfun); + print_c_string ("...", printcharfun); + } + print_c_string (e->u.vector.end, printcharfun); + --prstack.sp; + --print_depth; + goto next_obj; + } + if (e->u.vector.idx > 0) + printchar (' ', printcharfun); + obj = AREF (e->u.vector.obj, e->u.vector.idx); + e->u.vector.idx++; + break; + + case PE_hash: + if (e->u.hash.printed >= e->u.hash.nobjs) + { + if (e->u.hash.truncated) + { + if (e->u.hash.printed) + printchar (' ', printcharfun); + print_c_string ("...", printcharfun); + } + print_c_string ("))", printcharfun); + --prstack.sp; + --print_depth; + goto next_obj; + } + + if (e->u.hash.printed) + printchar (' ', printcharfun); + + struct Lisp_Hash_Table *h = XHASH_TABLE (e->u.hash.obj); + if ((e->u.hash.printed & 1) == 0) + { + Lisp_Object key; + ptrdiff_t idx = e->u.hash.idx; + while (BASE_EQ ((key = HASH_KEY (h, idx)), Qunbound)) + idx++; + e->u.hash.idx = idx; + obj = key; + } + else + { + obj = HASH_VALUE (h, e->u.hash.idx); + e->u.hash.idx++; + } + e->u.hash.printed++; + break; + } + goto print_obj; + } + eassert (print_depth == base_depth); } @@ -2414,6 +2869,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); @@ -2432,4 +2894,24 @@ 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"); + + defsubr (&Sflush_standard_output); + + /* Initialized in print_create_variable_mapping. */ + staticpro (&Vprint_variable_mapping); } diff --git a/src/process.c b/src/process.c index 8b587aaa4e1..d6d51b26e11 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); @@ -1071,13 +1071,24 @@ record_deleted_pid (pid_t pid, Lisp_Object filename) } -DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0, +DEFUN ("delete-process", Fdelete_process, Sdelete_process, 0, 1, + "(list 'message)", doc: /* Delete PROCESS: kill it and forget about it immediately. PROCESS may be a process, a buffer, the name of a process or buffer, or -nil, indicating the current buffer's process. */) +nil, indicating the current buffer's process. + +Interactively, it will kill the current buffer's process. */) (register Lisp_Object process) { register struct Lisp_Process *p; + bool mess = false; + + /* We use this to see whether we were called interactively. */ + if (EQ (process, Qmessage)) + { + mess = true; + process = Qnil; + } process = get_process (process); p = XPROCESS (process); @@ -1131,6 +1142,8 @@ nil, indicating the current buffer's process. */) } } remove_process (process); + if (mess) + message ("Deleted process"); return Qnil; } @@ -1268,7 +1281,7 @@ Return BUFFER. */) update_process_mark (p); } if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p)) - pset_childp (p, Fplist_put (p->childp, QCbuffer, buffer)); + pset_childp (p, plist_put (p->childp, QCbuffer, buffer)); setup_process_coding_systems (process); return buffer; } @@ -1347,7 +1360,7 @@ The string argument is normally a multibyte string, except: pset_filter (p, filter); if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p)) - pset_childp (p, Fplist_put (p->childp, QCfilter, filter)); + pset_childp (p, plist_put (p->childp, QCfilter, filter)); setup_process_coding_systems (process); return filter; } @@ -1379,7 +1392,7 @@ It gets two arguments: the process, and a string describing the change. */) pset_sentinel (p, sentinel); if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p)) - pset_childp (p, Fplist_put (p->childp, QCsentinel, sentinel)); + pset_childp (p, plist_put (p->childp, QCsentinel, sentinel)); return sentinel; } @@ -1540,25 +1553,25 @@ waiting for the process to be fully set up.*/) if (DATAGRAM_CONN_P (process) && (EQ (key, Qt) || EQ (key, QCremote))) - contact = Fplist_put (contact, QCremote, - Fprocess_datagram_address (process)); + contact = plist_put (contact, QCremote, + Fprocess_datagram_address (process)); #endif if ((!NETCONN_P (process) && !SERIALCONN_P (process) && !PIPECONN_P (process)) || EQ (key, Qt)) return contact; if (NILP (key) && NETCONN_P (process)) - return list2 (Fplist_get (contact, QChost), - Fplist_get (contact, QCservice)); + return list2 (plist_get (contact, QChost), + plist_get (contact, QCservice)); if (NILP (key) && SERIALCONN_P (process)) - return list2 (Fplist_get (contact, QCport), - Fplist_get (contact, QCspeed)); + return list2 (plist_get (contact, QCport), + plist_get (contact, QCspeed)); /* FIXME: Return a meaningful value (e.g., the child end of the pipe) if the pipe process is useful for purposes other than receiving stderr. */ if (NILP (key) && PIPECONN_P (process)) return Qt; - return Fplist_get (contact, key); + return plist_get (contact, key); } DEFUN ("process-plist", Fprocess_plist, Sprocess_plist, @@ -1752,7 +1765,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; @@ -1760,7 +1773,7 @@ usage: (make-process &rest ARGS) */) /* Save arguments for process-contact and clone-process. */ contact = Flist (nargs, args); - if (!NILP (Fplist_get (contact, QCfile_handler))) + if (!NILP (plist_get (contact, QCfile_handler))) { Lisp_Object file_handler = Ffind_file_name_handler (BVAR (current_buffer, directory), @@ -1769,7 +1782,7 @@ usage: (make-process &rest ARGS) */) return CALLN (Fapply, file_handler, Qmake_process, contact); } - buffer = Fplist_get (contact, QCbuffer); + buffer = plist_get (contact, QCbuffer); if (!NILP (buffer)) buffer = Fget_buffer_create (buffer, Qnil); @@ -1779,10 +1792,10 @@ usage: (make-process &rest ARGS) */) chdir, since it's in a vfork. */ current_dir = get_current_directory (true); - name = Fplist_get (contact, QCname); + name = plist_get (contact, QCname); CHECK_STRING (name); - command = Fplist_get (contact, QCcommand); + command = plist_get (contact, QCcommand); if (CONSP (command)) program = XCAR (command); else @@ -1791,10 +1804,10 @@ usage: (make-process &rest ARGS) */) if (!NILP (program)) CHECK_STRING (program); - bool query_on_exit = NILP (Fplist_get (contact, QCnoquery)); + bool query_on_exit = NILP (plist_get (contact, QCnoquery)); stderrproc = Qnil; - xstderr = Fplist_get (contact, QCstderr); + xstderr = plist_get (contact, QCstderr); if (PROCESSP (xstderr)) { if (!PIPECONN_P (xstderr)) @@ -1820,18 +1833,18 @@ usage: (make-process &rest ARGS) */) eassert (NILP (XPROCESS (proc)->plist)); pset_type (XPROCESS (proc), Qreal); pset_buffer (XPROCESS (proc), buffer); - pset_sentinel (XPROCESS (proc), Fplist_get (contact, QCsentinel)); - pset_filter (XPROCESS (proc), Fplist_get (contact, QCfilter)); + pset_sentinel (XPROCESS (proc), plist_get (contact, QCsentinel)); + pset_filter (XPROCESS (proc), plist_get (contact, QCfilter)); pset_command (XPROCESS (proc), Fcopy_sequence (command)); if (!query_on_exit) XPROCESS (proc)->kill_without_query = 1; - tem = Fplist_get (contact, QCstop); + tem = plist_get (contact, QCstop); /* Normal processes can't be started in a stopped state, see Bug#30460. */ CHECK_TYPE (NILP (tem), Qnull, tem); - tem = Fplist_get (contact, QCconnection_type); + tem = plist_get (contact, QCconnection_type); if (EQ (tem, Qpty)) XPROCESS (proc)->pty_flag = true; else if (EQ (tem, Qpipe)) @@ -1873,7 +1886,7 @@ usage: (make-process &rest ARGS) */) Lisp_Object coding_systems = Qt; Lisp_Object val, *args2; - tem = Fplist_get (contact, QCcoding); + tem = plist_get (contact, QCcoding); if (!NILP (tem)) { val = tem; @@ -2132,6 +2145,10 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) inchannel = p->open_fd[READ_FROM_SUBPROCESS]; forkout = p->open_fd[SUBPROCESS_STDOUT]; +#if defined(GNU_LINUX) && defined(F_SETPIPE_SZ) + fcntl (inchannel, F_SETPIPE_SZ, read_process_output_max); +#endif + if (!NILP (p->stderrproc)) { struct Lisp_Process *pp = XPROCESS (p->stderrproc); @@ -2169,10 +2186,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 +2305,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 +2357,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) @@ -2346,10 +2364,10 @@ usage: (make-pipe-process &rest ARGS) */) contact = Flist (nargs, args); - name = Fplist_get (contact, QCname); + name = plist_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); @@ -2378,25 +2396,26 @@ usage: (make-pipe-process &rest ARGS) */) if (inchannel > max_desc) max_desc = inchannel; - buffer = Fplist_get (contact, QCbuffer); + buffer = plist_get (contact, QCbuffer); if (NILP (buffer)) buffer = name; buffer = Fget_buffer_create (buffer, Qnil); pset_buffer (p, buffer); pset_childp (p, contact); - pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist))); + pset_plist (p, Fcopy_sequence (plist_get (contact, QCplist))); pset_type (p, Qpipe); - pset_sentinel (p, Fplist_get (contact, QCsentinel)); - pset_filter (p, Fplist_get (contact, QCfilter)); + pset_sentinel (p, plist_get (contact, QCsentinel)); + pset_filter (p, plist_get (contact, QCfilter)); eassert (NILP (p->log)); - if (tem = Fplist_get (contact, QCnoquery), !NILP (tem)) + if (tem = plist_get (contact, QCnoquery), !NILP (tem)) p->kill_without_query = 1; - if (tem = Fplist_get (contact, QCstop), !NILP (tem)) + if (tem = plist_get (contact, QCstop), !NILP (tem)) 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 @@ -2412,7 +2431,7 @@ usage: (make-pipe-process &rest ARGS) */) Lisp_Object coding_systems = Qt; Lisp_Object val; - tem = Fplist_get (contact, QCcoding); + tem = plist_get (contact, QCcoding); val = Qnil; if (!NILP (tem)) { @@ -2468,7 +2487,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; } @@ -2899,7 +2918,7 @@ set up yet, this function will block until socket setup has completed. */) if (set_socket_option (s, option, value)) { - pset_childp (p, Fplist_put (p->childp, option, value)); + pset_childp (p, plist_put (p->childp, option, value)); return Qt; } @@ -2977,19 +2996,19 @@ usage: (serial-process-configure &rest ARGS) */) contact = Flist (nargs, args); - proc = Fplist_get (contact, QCprocess); + proc = plist_get (contact, QCprocess); if (NILP (proc)) - proc = Fplist_get (contact, QCname); + proc = plist_get (contact, QCname); if (NILP (proc)) - proc = Fplist_get (contact, QCbuffer); + proc = plist_get (contact, QCbuffer); if (NILP (proc)) - proc = Fplist_get (contact, QCport); + proc = plist_get (contact, QCport); proc = get_process (proc); p = XPROCESS (proc); if (!EQ (p->type, Qserial)) error ("Not a serial process"); - if (NILP (Fplist_get (p->childp, QCspeed))) + if (NILP (plist_get (p->childp, QCspeed))) return Qnil; serial_configure (p, contact); @@ -3076,29 +3095,28 @@ 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; contact = Flist (nargs, args); - port = Fplist_get (contact, QCport); + port = plist_get (contact, QCport); if (NILP (port)) error ("No port specified"); CHECK_STRING (port); - if (NILP (Fplist_member (contact, QCspeed))) + if (NILP (plist_member (contact, QCspeed))) error (":speed not specified"); - if (!NILP (Fplist_get (contact, QCspeed))) - CHECK_FIXNUM (Fplist_get (contact, QCspeed)); + if (!NILP (plist_get (contact, QCspeed))) + CHECK_FIXNUM (plist_get (contact, QCspeed)); - name = Fplist_get (contact, QCname); + name = plist_get (contact, QCname); if (NILP (name)) 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); @@ -3113,30 +3131,31 @@ usage: (make-serial-process &rest ARGS) */) eassert (0 <= fd && fd < FD_SETSIZE); chan_process[fd] = proc; - buffer = Fplist_get (contact, QCbuffer); + buffer = plist_get (contact, QCbuffer); if (NILP (buffer)) buffer = name; buffer = Fget_buffer_create (buffer, Qnil); pset_buffer (p, buffer); pset_childp (p, contact); - pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist))); + pset_plist (p, Fcopy_sequence (plist_get (contact, QCplist))); pset_type (p, Qserial); - pset_sentinel (p, Fplist_get (contact, QCsentinel)); - pset_filter (p, Fplist_get (contact, QCfilter)); + pset_sentinel (p, plist_get (contact, QCsentinel)); + pset_filter (p, plist_get (contact, QCfilter)); eassert (NILP (p->log)); - if (tem = Fplist_get (contact, QCnoquery), !NILP (tem)) + if (tem = plist_get (contact, QCnoquery), !NILP (tem)) p->kill_without_query = 1; - if (tem = Fplist_get (contact, QCstop), !NILP (tem)) + if (tem = plist_get (contact, QCstop), !NILP (tem)) 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); - tem = Fplist_get (contact, QCcoding); + tem = plist_get (contact, QCcoding); val = Qnil; if (!NILP (tem)) @@ -3175,7 +3194,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; } @@ -3190,7 +3209,7 @@ set_network_socket_coding_system (Lisp_Object proc, Lisp_Object host, Lisp_Object coding_systems = Qt; Lisp_Object val; - tem = Fplist_get (contact, QCcoding); + tem = plist_get (contact, QCcoding); /* Setup coding systems for communicating with the network stream. */ /* Qt denotes we have not yet called Ffind_operation_coding_system. */ @@ -3278,8 +3297,8 @@ finish_after_tls_connection (Lisp_Object proc) if (!NILP (Ffboundp (Qnsm_verify_connection))) result = call3 (Qnsm_verify_connection, proc, - Fplist_get (contact, QChost), - Fplist_get (contact, QCservice)); + plist_get (contact, QChost), + plist_get (contact, QCservice)); eassert (p->outfd < FD_SETSIZE); if (NILP (result)) @@ -3337,9 +3356,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)) { @@ -3460,7 +3479,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, if (getsockname (s, psa1, &len1) == 0) { Lisp_Object service = make_fixnum (ntohs (sa1.sin_port)); - contact = Fplist_put (contact, QCservice, service); + contact = plist_put (contact, QCservice, service); /* Save the port number so that we can stash it in the process object later. */ DECLARE_POINTER_ALIAS (psa, struct sockaddr_in, sa); @@ -3524,7 +3543,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) @@ -3551,7 +3570,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, { Lisp_Object remote; memset (datagram_address[s].sa, 0, addrlen); - if (remote = Fplist_get (contact, QCremote), !NILP (remote)) + if (remote = plist_get (contact, QCremote), !NILP (remote)) { int rfamily; ptrdiff_t rlen = get_lisp_to_sockaddr_size (remote, &rfamily); @@ -3566,8 +3585,8 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, } #endif - contact = Fplist_put (contact, p->is_server? QClocal: QCremote, - conv_sockaddr_to_lisp (sa, addrlen)); + contact = plist_put (contact, p->is_server? QClocal: QCremote, + conv_sockaddr_to_lisp (sa, addrlen)); #ifdef HAVE_GETSOCKNAME if (!p->is_server) { @@ -3575,8 +3594,8 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, socklen_t len1 = sizeof (sa1); DECLARE_POINTER_ALIAS (psa1, struct sockaddr, &sa1); if (getsockname (s, psa1, &len1) == 0) - contact = Fplist_put (contact, QClocal, - conv_sockaddr_to_lisp (psa1, len1)); + contact = plist_put (contact, QClocal, + conv_sockaddr_to_lisp (psa1, len1)); } #endif } @@ -3595,7 +3614,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 +3636,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 +3894,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; @@ -3889,7 +3908,7 @@ usage: (make-network-process &rest ARGS) */) #endif /* :type TYPE (nil: stream, datagram */ - tem = Fplist_get (contact, QCtype); + tem = plist_get (contact, QCtype); if (NILP (tem)) socktype = SOCK_STREAM; #ifdef DATAGRAM_SOCKETS @@ -3903,13 +3922,13 @@ usage: (make-network-process &rest ARGS) */) else error ("Unsupported connection type"); - name = Fplist_get (contact, QCname); - buffer = Fplist_get (contact, QCbuffer); - filter = Fplist_get (contact, QCfilter); - sentinel = Fplist_get (contact, QCsentinel); - use_external_socket_p = Fplist_get (contact, QCuse_external_socket); - Lisp_Object server = Fplist_get (contact, QCserver); - bool nowait = !NILP (Fplist_get (contact, QCnowait)); + name = plist_get (contact, QCname); + buffer = plist_get (contact, QCbuffer); + filter = plist_get (contact, QCfilter); + sentinel = plist_get (contact, QCsentinel); + use_external_socket_p = plist_get (contact, QCuse_external_socket); + Lisp_Object server = plist_get (contact, QCserver); + bool nowait = !NILP (plist_get (contact, QCnowait)); if (!NILP (server) && nowait) error ("`:server' is incompatible with `:nowait'"); @@ -3917,9 +3936,9 @@ usage: (make-network-process &rest ARGS) */) /* :local ADDRESS or :remote ADDRESS */ if (NILP (server)) - address = Fplist_get (contact, QCremote); + address = plist_get (contact, QCremote); else - address = Fplist_get (contact, QClocal); + address = plist_get (contact, QClocal); if (!NILP (address)) { host = service = Qnil; @@ -3932,7 +3951,7 @@ usage: (make-network-process &rest ARGS) */) } /* :family FAMILY -- nil (for Inet), local, or integer. */ - tem = Fplist_get (contact, QCfamily); + tem = plist_get (contact, QCfamily); if (NILP (tem)) { #ifdef AF_INET6 @@ -3957,10 +3976,10 @@ usage: (make-network-process &rest ARGS) */) error ("Unknown address family"); /* :service SERVICE -- string, integer (port number), or t (random port). */ - service = Fplist_get (contact, QCservice); + service = plist_get (contact, QCservice); /* :host HOST -- hostname, ip address, or 'local for localhost. */ - host = Fplist_get (contact, QChost); + host = plist_get (contact, QChost); if (NILP (host)) { /* The "connection" function gets it bind info from the address we're @@ -3999,7 +4018,7 @@ usage: (make-network-process &rest ARGS) */) if (!NILP (host)) { message (":family local ignores the :host property"); - contact = Fplist_put (contact, QChost, Qnil); + contact = plist_put (contact, QChost, Qnil); host = Qnil; } CHECK_STRING (service); @@ -4153,16 +4172,16 @@ usage: (make-network-process &rest ARGS) */) record_unwind_protect (remove_process, proc); p = XPROCESS (proc); pset_childp (p, contact); - pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist))); + pset_plist (p, Fcopy_sequence (plist_get (contact, QCplist))); pset_type (p, Qnetwork); pset_buffer (p, buffer); pset_sentinel (p, sentinel); pset_filter (p, filter); - pset_log (p, Fplist_get (contact, QClog)); - if (tem = Fplist_get (contact, QCnoquery), !NILP (tem)) + pset_log (p, plist_get (contact, QClog)); + if (tem = plist_get (contact, QCnoquery), !NILP (tem)) p->kill_without_query = 1; - if ((tem = Fplist_get (contact, QCstop), !NILP (tem))) + if ((tem = plist_get (contact, QCstop), !NILP (tem))) pset_command (p, Qt); eassert (p->pid == 0); p->backlog = 5; @@ -4174,7 +4193,7 @@ usage: (make-network-process &rest ARGS) */) eassert (! p->dns_request); #endif #ifdef HAVE_GNUTLS - tem = Fplist_get (contact, QCtls_parameters); + tem = plist_get (contact, QCtls_parameters); CHECK_LIST (tem); p->gnutls_boot_parameters = tem; #endif @@ -4204,7 +4223,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 +4395,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 +4409,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 +4658,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; @@ -4757,7 +4775,7 @@ corresponding connection was closed. */) /* Can't wait for a process that is dedicated to a different thread. */ - if (!NILP (proc->thread) && !EQ (proc->thread, Fcurrent_thread ())) + if (!NILP (proc->thread) && !BASE_EQ (proc->thread, Fcurrent_thread ())) { Lisp_Object proc_thread_name = XTHREAD (proc->thread)->name; @@ -4765,7 +4783,7 @@ corresponding connection was closed. */) SDATA (proc->name), STRINGP (proc_thread_name) ? SDATA (proc_thread_name) - : SDATA (Fprin1_to_string (proc->thread, Qt))); + : SDATA (Fprin1_to_string (proc->thread, Qt, Qnil))); } } else @@ -4835,7 +4853,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 +4874,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++; @@ -4952,17 +4969,17 @@ server_accept_connection (Lisp_Object server, int channel) /* Build new contact information for this setup. */ contact = Fcopy_sequence (ps->childp); - contact = Fplist_put (contact, QCserver, Qnil); - contact = Fplist_put (contact, QChost, host); + contact = plist_put (contact, QCserver, Qnil); + contact = plist_put (contact, QChost, host); if (!NILP (service)) - contact = Fplist_put (contact, QCservice, service); - contact = Fplist_put (contact, QCremote, - conv_sockaddr_to_lisp (&saddr.sa, len)); + contact = plist_put (contact, QCservice, service); + contact = plist_put (contact, QCremote, + conv_sockaddr_to_lisp (&saddr.sa, len)); #ifdef HAVE_GETSOCKNAME len = sizeof saddr; if (getsockname (s, &saddr.sa, &len) == 0) - contact = Fplist_put (contact, QClocal, - conv_sockaddr_to_lisp (&saddr.sa, len)); + contact = plist_put (contact, QClocal, + conv_sockaddr_to_lisp (&saddr.sa, len)); #endif pset_childp (p, contact); @@ -4976,7 +4993,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 +5190,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 (); @@ -5475,7 +5492,17 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, triggered by processing X events). In the latter case, set nfds to 1 to avoid breaking the loop. */ no_avail = 0; - if ((read_kbd || !NILP (wait_for_cell)) + if ((read_kbd + /* The following code doesn't make any sense for just the + wait_for_cell case, because detect_input_pending returns + whether or not the keyboard buffer isn't empty or there + is mouse movement. Any keyboard input that arrives + while waiting for a cell will cause the select call to + be skipped, and gobble_input to be called even when + there is no input available from the terminal itself. + Skipping the call to select also causes the timeout to + be ignored. (bug#46935) */ + /* || !NILP (wait_for_cell) */) && detect_input_pending ()) { nfds = read_kbd ? 0 : 1; @@ -5586,6 +5613,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 +5755,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 +5763,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 +6019,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 +6050,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 +6266,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 +6276,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 +6323,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 +6438,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 +6948,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 +7052,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 +7108,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, "(list (read-string \"Process (name or number): \") (read-signal-name))", + 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 +7159,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 +7458,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 +7468,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 +7774,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 +8221,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 +8290,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); } @@ -8252,6 +8317,27 @@ If QUERY is `all', also count processors not available. */) #endif } +DEFUN ("signal-names", Fsignal_names, Ssignal_names, 0, 0, 0, + doc: /* Return a list of known signal names on this system. */) + (void) +{ +#ifndef MSDOS + int i; + char name[SIG2STR_MAX]; + Lisp_Object names = Qnil; + + for (i = 0; i <= SIGNUM_BOUND; ++i) + { + if (!sig2str (i, name)) + names = Fcons (build_string (name), names); + } + + return names; +#else + return Qnil; +#endif +} + #ifdef subprocesses /* Arrange to catch SIGCHLD if this hasn't already been arranged. Invoke this after init_process_emacs, and after glib and/or GNUstep @@ -8406,6 +8492,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 +8652,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; @@ -8571,15 +8666,29 @@ returns non-nil. */); DEFVAR_INT ("read-process-output-max", read_process_output_max, doc: /* Maximum number of bytes to read from subprocess in a single chunk. Enlarge the value only if the subprocess generates very large (megabytes) -amounts of data in one go. */); +amounts of data in one go. + +On GNU/Linux systems, the value should not exceed +/proc/sys/fs/pipe-max-size. See pipe(7) manpage for details. */); 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"); + DEFSYM (Qmessage, "message"); defsubr (&Sprocessp); defsubr (&Sget_process); @@ -8632,6 +8741,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); @@ -8681,4 +8791,5 @@ amounts of data in one go. */); defsubr (&Slist_system_processes); defsubr (&Sprocess_attributes); defsubr (&Snum_processors); + defsubr (&Ssignal_names); } diff --git a/src/profiler.c b/src/profiler.c index 31a46d1b5e5..5cb42d54fa6 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -132,7 +132,7 @@ static void evict_lower_half (log_t *log) XSET_HASH_TABLE (tmp, log); /* FIXME: Use make_lisp_ptr. */ Fremhash (key, tmp); } - eassert (EQ (Qunbound, HASH_KEY (log, i))); + eassert (BASE_EQ (Qunbound, HASH_KEY (log, i))); eassert (log->next_free == i); eassert (VECTORP (key)); @@ -158,7 +158,7 @@ record_backtrace (log_t *log, EMACS_INT count) /* Get a "working memory" vector. */ Lisp_Object backtrace = HASH_VALUE (log, index); - eassert (EQ (Qunbound, HASH_KEY (log, index))); + eassert (BASE_EQ (Qunbound, HASH_KEY (log, index))); get_backtrace (backtrace); { /* We basically do a `gethash+puthash' here, except that we have to be diff --git a/src/regex-emacs.c b/src/regex-emacs.c index 7c172fe63a2..9b2c14c413d 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -33,6 +33,7 @@ #include "buffer.h" #include "syntax.h" #include "category.h" +#include "dispextern.h" /* Maximum number of duplicates an interval can allow. Some systems define this in other header files, but we want our value, so remove @@ -1244,21 +1245,22 @@ static int analyze_first (re_char *p, re_char *pend, return REG_ESIZE; \ ptrdiff_t b_off = b - old_buffer; \ ptrdiff_t begalt_off = begalt - old_buffer; \ - bool fixup_alt_jump_set = !!fixup_alt_jump; \ - bool laststart_set = !!laststart; \ - bool pending_exact_set = !!pending_exact; \ - ptrdiff_t fixup_alt_jump_off, laststart_off, pending_exact_off; \ - if (fixup_alt_jump_set) fixup_alt_jump_off = fixup_alt_jump - old_buffer; \ - if (laststart_set) laststart_off = laststart - old_buffer; \ - if (pending_exact_set) pending_exact_off = pending_exact - old_buffer; \ + ptrdiff_t fixup_alt_jump_off = \ + fixup_alt_jump ? fixup_alt_jump - old_buffer : -1; \ + ptrdiff_t laststart_off = laststart ? laststart - old_buffer : -1; \ + ptrdiff_t pending_exact_off = \ + pending_exact ? pending_exact - old_buffer : -1; \ bufp->buffer = xpalloc (bufp->buffer, &bufp->allocated, \ requested_extension, MAX_BUF_SIZE, 1); \ unsigned char *new_buffer = bufp->buffer; \ b = new_buffer + b_off; \ begalt = new_buffer + begalt_off; \ - if (fixup_alt_jump_set) fixup_alt_jump = new_buffer + fixup_alt_jump_off; \ - if (laststart_set) laststart = new_buffer + laststart_off; \ - if (pending_exact_set) pending_exact = new_buffer + pending_exact_off; \ + if (0 <= fixup_alt_jump_off) \ + fixup_alt_jump = new_buffer + fixup_alt_jump_off; \ + if (0 <= laststart_off) \ + laststart = new_buffer + laststart_off; \ + if (0 <= pending_exact_off) \ + pending_exact = new_buffer + pending_exact_off; \ } while (false) @@ -3952,6 +3954,9 @@ re_match_2_internal (struct re_pattern_buffer *bufp, and need to test it, it's not garbage. */ re_char *match_end = NULL; + /* This keeps track of how many buffer/string positions we examined. */ + ptrdiff_t nchars = 0; + #ifdef DEBUG_COMPILES_ARGUMENTS /* Counts the total number of registers pushed. */ ptrdiff_t num_regs_pushed = 0; @@ -3963,7 +3968,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 @@ -4208,6 +4213,12 @@ re_match_2_internal (struct re_pattern_buffer *bufp, unbind_to (count, Qnil); SAFE_FREE (); + /* The factor of 50 below is a heuristic that needs to be tuned. It + means we consider 50 buffer positions examined by this function + roughly equivalent to the display engine iterating over a single + buffer position. */ + if (max_redisplay_ticks > 0 && nchars > 0) + update_redisplay_ticks (nchars / 50 + 1, NULL); return dcnt; } @@ -4260,6 +4271,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, p += pat_charlen; d += buf_charlen; mcnt -= pat_charlen; + nchars++; } while (mcnt > 0); else @@ -4297,6 +4309,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, p += pat_charlen; d++; mcnt -= pat_charlen; + nchars++; } while (mcnt > 0); @@ -4320,6 +4333,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, DEBUG_PRINT (" Matched \"%d\".\n", *d); d += buf_charlen; + nchars++; } break; @@ -4372,6 +4386,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, goto fail; d += len; + nchars++; } break; @@ -4491,6 +4506,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, goto fail; } d += dcnt, d2 += dcnt; + nchars++; } } break; @@ -4772,10 +4788,12 @@ re_match_2_internal (struct re_pattern_buffer *bufp, ptrdiff_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset) - 1; UPDATE_SYNTAX_TABLE (charpos); GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2); + nchars++; s1 = SYNTAX (c1); UPDATE_SYNTAX_TABLE_FORWARD (charpos + 1); PREFETCH_NOLIMIT (); GET_CHAR_AFTER (c2, d, dummy); + nchars++; s2 = SYNTAX (c2); if (/* Case 2: Only one of S1 and S2 is Sword. */ @@ -4811,6 +4829,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, UPDATE_SYNTAX_TABLE (charpos); PREFETCH (); GET_CHAR_AFTER (c2, d, dummy); + nchars++; s2 = SYNTAX (c2); /* Case 2: S2 is not Sword. */ @@ -4821,6 +4840,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, if (!AT_STRINGS_BEG (d)) { GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2); + nchars++; UPDATE_SYNTAX_TABLE_BACKWARD (charpos - 1); s1 = SYNTAX (c1); @@ -4851,6 +4871,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, ptrdiff_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset) - 1; UPDATE_SYNTAX_TABLE (charpos); GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2); + nchars++; s1 = SYNTAX (c1); /* Case 2: S1 is not Sword. */ @@ -4862,6 +4883,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, { PREFETCH_NOLIMIT (); GET_CHAR_AFTER (c2, d, dummy); + nchars++; UPDATE_SYNTAX_TABLE_FORWARD (charpos + 1); s2 = SYNTAX (c2); @@ -4892,6 +4914,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, UPDATE_SYNTAX_TABLE (charpos); PREFETCH (); c2 = RE_STRING_CHAR (d, target_multibyte); + nchars++; s2 = SYNTAX (c2); /* Case 2: S2 is neither Sword nor Ssymbol. */ @@ -4902,6 +4925,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, if (!AT_STRINGS_BEG (d)) { GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2); + nchars++; UPDATE_SYNTAX_TABLE_BACKWARD (charpos - 1); s1 = SYNTAX (c1); @@ -4930,6 +4954,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, ptrdiff_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset) - 1; UPDATE_SYNTAX_TABLE (charpos); GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2); + nchars++; s1 = SYNTAX (c1); /* Case 2: S1 is neither Ssymbol nor Sword. */ @@ -4941,6 +4966,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, { PREFETCH_NOLIMIT (); c2 = RE_STRING_CHAR (d, target_multibyte); + nchars++; UPDATE_SYNTAX_TABLE_FORWARD (charpos + 1); s2 = SYNTAX (c2); @@ -4972,6 +4998,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, if ((SYNTAX (c) != (enum syntaxcode) mcnt) ^ not) goto fail; d += len; + nchars++; } } break; @@ -4998,6 +5025,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, if ((!CHAR_HAS_CATEGORY (c, mcnt)) ^ not) goto fail; d += len; + nchars++; } } break; @@ -5059,6 +5087,9 @@ re_match_2_internal (struct re_pattern_buffer *bufp, unbind_to (count, Qnil); SAFE_FREE (); + if (max_redisplay_ticks > 0 && nchars > 0) + update_redisplay_ticks (nchars / 50 + 1, NULL); + return -1; /* Failure to match. */ } diff --git a/src/search.c b/src/search.c index 88ee584504f..9d6bd074e1b 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,36 @@ looking_at_1 (Lisp_Object string, bool posix) return unbind_to (count, val); } -DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 1, 0, +DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 2, 0, doc: /* Return t if text after point matches regular expression REGEXP. -This function modifies the match data that `match-beginning', -`match-end' and `match-data' access; save and restore the match -data if you want to preserve them. */) - (Lisp_Object regexp) +By default, this function modifies the match data that +`match-beginning', `match-end' and `match-data' access. If +INHIBIT-MODIFY is non-nil, don't modify the match data. */) + (Lisp_Object regexp, Lisp_Object inhibit_modify) { - return looking_at_1 (regexp, 0); + return looking_at_1 (regexp, 0, NILP (inhibit_modify)); } -DEFUN ("posix-looking-at", Fposix_looking_at, Sposix_looking_at, 1, 1, 0, +DEFUN ("posix-looking-at", Fposix_looking_at, Sposix_looking_at, 1, 2, 0, doc: /* Return t if text after point matches REGEXP according to Posix rules. Find the longest match, in accordance with Posix regular expression rules. -This function modifies the match data that `match-beginning', -`match-end' and `match-data' access; save and restore the match -data if you want to preserve them. */) - (Lisp_Object regexp) + +By default, this function modifies the match data that +`match-beginning', `match-end' and `match-data' access. If +INHIBIT-MODIFY is non-nil, don't modify the match data. */) + (Lisp_Object regexp, Lisp_Object inhibit_modify) { - return looking_at_1 (regexp, 1); + return looking_at_1 (regexp, 1, NILP (inhibit_modify)); } static Lisp_Object string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, - bool posix) + bool posix, bool modify_data) { ptrdiff_t val; - struct re_pattern_buffer *bufp; EMACS_INT pos; ptrdiff_t pos_byte, i; + bool modify_match_data = NILP (Vinhibit_changing_match_data) && modify_data; if (running_asynch_code) save_search_regs (); @@ -399,29 +400,32 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, set_char_table_extras (BVAR (current_buffer, case_canon_table), 2, BVAR (current_buffer, case_eqv_table)); - bufp = &compile_pattern (regexp, - (NILP (Vinhibit_changing_match_data) - ? &search_regs : NULL), - (!NILP (BVAR (current_buffer, case_fold_search)) - ? BVAR (current_buffer, case_canon_table) : Qnil), - posix, - STRING_MULTIBYTE (string))->buf; + specpdl_ref count = SPECPDL_INDEX (); + struct regexp_cache *cache_entry + = compile_pattern (regexp, + modify_match_data ? &search_regs : NULL, + (!NILP (BVAR (current_buffer, case_fold_search)) + ? BVAR (current_buffer, case_canon_table) + : Qnil), + posix, + STRING_MULTIBYTE (string)); + freeze_pattern (cache_entry); re_match_object = string; - val = re_search (bufp, SSDATA (string), + val = re_search (&cache_entry->buf, SSDATA (string), SBYTES (string), pos_byte, SBYTES (string) - pos_byte, - (NILP (Vinhibit_changing_match_data) - ? &search_regs : NULL)); + (modify_match_data ? &search_regs : NULL)); + unbind_to (count, Qnil); /* 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 +438,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, @@ -470,15 +484,15 @@ ptrdiff_t fast_string_match_internal (Lisp_Object regexp, Lisp_Object string, Lisp_Object table) { - ptrdiff_t val; - struct re_pattern_buffer *bufp; - - bufp = &compile_pattern (regexp, 0, table, - 0, STRING_MULTIBYTE (string))->buf; re_match_object = string; - val = re_search (bufp, SSDATA (string), - SBYTES (string), 0, - SBYTES (string), 0); + specpdl_ref count = SPECPDL_INDEX (); + struct regexp_cache *cache_entry + = compile_pattern (regexp, 0, table, 0, STRING_MULTIBYTE (string)); + freeze_pattern (cache_entry); + ptrdiff_t val = re_search (&cache_entry->buf, SSDATA (string), + SBYTES (string), 0, + SBYTES (string), 0); + unbind_to (count, Qnil); return val; } @@ -491,15 +505,14 @@ ptrdiff_t fast_c_string_match_ignore_case (Lisp_Object regexp, const char *string, ptrdiff_t len) { - ptrdiff_t val; - struct re_pattern_buffer *bufp; - regexp = string_make_unibyte (regexp); - bufp = &compile_pattern (regexp, 0, - Vascii_canon_table, 0, - 0)->buf; + specpdl_ref count = SPECPDL_INDEX (); + struct regexp_cache *cache_entry + = compile_pattern (regexp, 0, Vascii_canon_table, 0, 0); + freeze_pattern (cache_entry); re_match_object = Qt; - val = re_search (bufp, string, len, 0, len, 0); + ptrdiff_t val = re_search (&cache_entry->buf, string, len, 0, len, 0); + unbind_to (count, Qnil); return val; } @@ -558,7 +571,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 +1201,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 +2830,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/sheap.h b/src/sheap.h index 297b7cf317d..9133f0b292f 100644 --- a/src/sheap.h +++ b/src/sheap.h @@ -23,7 +23,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ /* Size of the static heap. Guess a value that is probably too large, by up to a factor of four or so. Typically the unused part is not paged in and so does not cost much. */ -enum { STATIC_HEAP_SIZE = sizeof (Lisp_Object) << 22 }; +enum { STATIC_HEAP_SIZE = sizeof (Lisp_Object) << 23 }; extern char bss_sbrk_buffer[STATIC_HEAP_SIZE]; extern char *max_bss_sbrk_ptr; diff --git a/src/sort.c b/src/sort.c new file mode 100644 index 00000000000..d10ae692d33 --- /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 beginning 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..0a307828008 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 @@ -357,10 +361,10 @@ parse_sound (Lisp_Object sound, Lisp_Object *attrs) return 0; sound = XCDR (sound); - attrs[SOUND_FILE] = Fplist_get (sound, QCfile); - attrs[SOUND_DATA] = Fplist_get (sound, QCdata); - attrs[SOUND_DEVICE] = Fplist_get (sound, QCdevice); - attrs[SOUND_VOLUME] = Fplist_get (sound, QCvolume); + attrs[SOUND_FILE] = plist_get (sound, QCfile); + attrs[SOUND_DATA] = plist_get (sound, QCdata); + attrs[SOUND_DEVICE] = plist_get (sound, QCdevice); + attrs[SOUND_VOLUME] = plist_get (sound, QCvolume); #ifndef WINDOWSNT /* File name or data must be specified. */ @@ -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..54bfb7b6c61 --- /dev/null +++ b/src/sqlite.c @@ -0,0 +1,784 @@ +/* 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_blob, + (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_blob +# 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_blob fn_sqlite3_bind_blob +# 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_blob); + 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) +{ + Lisp_Object name; + int flags = (SQLITE_OPEN_CREATE | SQLITE_OPEN_READWRITE); +#ifdef SQLITE_OPEN_FULLMUTEX + flags |= SQLITE_OPEN_FULLMUTEX; +#endif +#ifdef SQLITE_OPEN_URI + flags |= SQLITE_OPEN_URI; +#endif + + if (!init_sqlite_functions ()) + xsignal1 (Qerror, build_string ("sqlite support is not available")); + + if (!NILP (file)) + name = ENCODE_FILE (Fexpand_file_name (file, Qnil)); + else + { +#ifdef SQLITE_OPEN_MEMORY + /* In-memory database. These have to have different names to + refer to different databases. */ + AUTO_STRING (memory_fmt, ":memory:%d"); + name = CALLN (Fformat, memory_fmt, make_int (++db_count)); + flags |= SQLITE_OPEN_MEMORY; +#else + xsignal1 (Qerror, build_string ("sqlite in-memory is not available")); +#endif + } + + sqlite3 *sdb; + if (sqlite3_open_v2 (SSDATA (name), &sdb, flags, NULL) != SQLITE_OK) + return Qnil; + + return make_sqlite (false, sdb, NULL, xstrdup (SSDATA (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; + bool blob = false; + + if (SBYTES (value) == 0) + encoded = value; + else + { + Lisp_Object coding_system = + Fget_text_property (make_fixnum (0), Qcoding_system, value); + if (NILP (coding_system)) + /* Default to utf-8. */ + encoded = encode_string (value); + else if (EQ (coding_system, Qbinary)) + blob = true; + else + encoded = Fencode_coding_string (value, coding_system, + Qnil, Qnil); + } + + if (blob) + { + if (SBYTES (value) != SCHARS (value)) + xsignal1 (Qerror, build_string ("BLOB values must be unibyte")); + ret = sqlite3_bind_blob (stmt, i + 1, + SSDATA (value), SBYTES (value), + NULL); + } + else + 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 = make_unibyte_string (sqlite3_column_blob (stmt, i), + sqlite3_column_bytes (stmt, i)); + 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"); + DEFSYM (Qbinary, "binary"); + DEFSYM (Qcoding_system, "coding-system"); +} diff --git a/src/syntax.c b/src/syntax.c index 9df878b8edf..15625b4d0e2 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -20,6 +20,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <config.h> #include "lisp.h" +#include "dispextern.h" #include "character.h" #include "buffer.h" #include "regex-emacs.h" @@ -1074,7 +1075,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 +1102,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)]); } @@ -3194,6 +3196,7 @@ scan_sexps_forward (struct lisp_parse_state *state, ptrdiff_t out_bytepos, out_charpos; int temp; unsigned short int quit_count = 0; + ptrdiff_t started_from = from; prev_from = from; prev_from_byte = from_byte; @@ -3473,6 +3476,13 @@ do { prev_from = from; \ state->levelstarts); state->prev_syntax = (SYNTAX_FLAGS_COMSTARTEND_FIRST (prev_from_syntax) || state->quoted) ? prev_from_syntax : Smax; + + /* The factor of 10 below is a heuristic that needs to be tuned. It + means we consider 10 buffer positions examined by this function + roughly equivalent to the display engine iterating over a single + buffer position. */ + if (max_redisplay_ticks > 0 && from > started_from) + update_redisplay_ticks ((from - started_from) / 10 + 1, NULL); } /* Convert a (lisp) parse state to the internal form used in 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 72be25f6610..c1545622dfc 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 @@ -2302,6 +2330,20 @@ emacs_fstatat (int dirfd, char const *filename, void *st, int flags) return r; } +static int +sys_openat (int dirfd, char const *file, int oflags, int mode) +{ +#ifdef O_PATH + return openat (dirfd, file, oflags, mode); +#else + /* On platforms without O_PATH, emacs_openat's callers arrange for + DIRFD to be AT_FDCWD, so it should be safe to just call 'open'. + This ports to old platforms like OS X 10.9 that lack openat. */ + eassert (dirfd == AT_FDCWD); + return open (file, oflags, mode); +#endif +} + /* Assuming the directory DIRFD, open FILE for Emacs use, using open flags OFLAGS and mode MODE. Use binary I/O on systems that care about text vs binary I/O. @@ -2317,7 +2359,7 @@ emacs_openat (int dirfd, char const *file, int oflags, int mode) if (! (oflags & O_TEXT)) oflags |= O_BINARY; oflags |= O_CLOEXEC; - while ((fd = openat (dirfd, file, oflags, mode)) < 0 && errno == EINTR) + while ((fd = sys_openat (dirfd, file, oflags, mode)) < 0 && errno == EINTR) maybe_quit (); return fd; } @@ -2330,26 +2372,19 @@ emacs_open (char const *file, int oflags, int mode) /* Same as above, but doesn't allow the user to quit. */ -static int -emacs_openat_noquit (int dirfd, const char *file, int oflags, - int mode) +int +emacs_open_noquit (char const *file, int oflags, int mode) { int fd; if (! (oflags & O_TEXT)) oflags |= O_BINARY; oflags |= O_CLOEXEC; do - fd = openat (dirfd, file, oflags, mode); + fd = open (file, oflags, mode); while (fd < 0 && errno == EINTR); return fd; } -int -emacs_open_noquit (char const *file, int oflags, int mode) -{ - return emacs_openat_noquit (AT_FDCWD, file, oflags, mode); -} - /* Open FILE as a stream for Emacs use, with mode MODE. Act like emacs_open with respect to threads, signals, and quits. */ @@ -2772,6 +2807,7 @@ static const struct speed_struct speeds[] = #ifdef B150 { 150, B150 }, #endif +#ifndef HAVE_TINY_SPEED_T #ifdef B200 { 200, B200 }, #endif @@ -2859,6 +2895,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., @@ -2902,21 +2939,21 @@ serial_configure (struct Lisp_Process *p, #endif /* Configure speed. */ - if (!NILP (Fplist_member (contact, QCspeed))) - tem = Fplist_get (contact, QCspeed); + if (!NILP (plist_member (contact, QCspeed))) + tem = plist_get (contact, QCspeed); else - tem = Fplist_get (p->childp, QCspeed); + tem = plist_get (p->childp, QCspeed); CHECK_FIXNUM (tem); err = cfsetspeed (&attr, convert_speed (XFIXNUM (tem))); if (err != 0) report_file_error ("Failed cfsetspeed", tem); - childp2 = Fplist_put (childp2, QCspeed, tem); + childp2 = plist_put (childp2, QCspeed, tem); /* Configure bytesize. */ - if (!NILP (Fplist_member (contact, QCbytesize))) - tem = Fplist_get (contact, QCbytesize); + if (!NILP (plist_member (contact, QCbytesize))) + tem = plist_get (contact, QCbytesize); else - tem = Fplist_get (p->childp, QCbytesize); + tem = plist_get (p->childp, QCbytesize); if (NILP (tem)) tem = make_fixnum (8); CHECK_FIXNUM (tem); @@ -2931,13 +2968,13 @@ serial_configure (struct Lisp_Process *p, if (XFIXNUM (tem) != 8) error ("Bytesize cannot be changed"); #endif - childp2 = Fplist_put (childp2, QCbytesize, tem); + childp2 = plist_put (childp2, QCbytesize, tem); /* Configure parity. */ - if (!NILP (Fplist_member (contact, QCparity))) - tem = Fplist_get (contact, QCparity); + if (!NILP (plist_member (contact, QCparity))) + tem = plist_get (contact, QCparity); else - tem = Fplist_get (p->childp, QCparity); + tem = plist_get (p->childp, QCparity); if (!NILP (tem) && !EQ (tem, Qeven) && !EQ (tem, Qodd)) error (":parity must be nil (no parity), `even', or `odd'"); #if defined (PARENB) && defined (PARODD) && defined (IGNPAR) && defined (INPCK) @@ -2964,13 +3001,13 @@ serial_configure (struct Lisp_Process *p, if (!NILP (tem)) error ("Parity cannot be configured"); #endif - childp2 = Fplist_put (childp2, QCparity, tem); + childp2 = plist_put (childp2, QCparity, tem); /* Configure stopbits. */ - if (!NILP (Fplist_member (contact, QCstopbits))) - tem = Fplist_get (contact, QCstopbits); + if (!NILP (plist_member (contact, QCstopbits))) + tem = plist_get (contact, QCstopbits); else - tem = Fplist_get (p->childp, QCstopbits); + tem = plist_get (p->childp, QCstopbits); if (NILP (tem)) tem = make_fixnum (1); CHECK_FIXNUM (tem); @@ -2986,13 +3023,13 @@ serial_configure (struct Lisp_Process *p, if (XFIXNUM (tem) != 1) error ("Stopbits cannot be configured"); #endif - childp2 = Fplist_put (childp2, QCstopbits, tem); + childp2 = plist_put (childp2, QCstopbits, tem); /* Configure flowcontrol. */ - if (!NILP (Fplist_member (contact, QCflowcontrol))) - tem = Fplist_get (contact, QCflowcontrol); + if (!NILP (plist_member (contact, QCflowcontrol))) + tem = plist_get (contact, QCflowcontrol); else - tem = Fplist_get (p->childp, QCflowcontrol); + tem = plist_get (p->childp, QCflowcontrol); if (!NILP (tem) && !EQ (tem, Qhw) && !EQ (tem, Qsw)) error (":flowcontrol must be nil (no flowcontrol), `hw', or `sw'"); #if defined (CRTSCTS) @@ -3026,14 +3063,14 @@ serial_configure (struct Lisp_Process *p, error ("Software flowcontrol (XON/XOFF) not supported"); #endif } - childp2 = Fplist_put (childp2, QCflowcontrol, tem); + childp2 = plist_put (childp2, QCflowcontrol, tem); /* Activate configuration. */ err = tcsetattr (p->outfd, TCSANOW, &attr); if (err != 0) report_file_error ("Failed tcsetattr", Qnil); - childp2 = Fplist_put (childp2, QCsummary, build_string (summary)); + childp2 = plist_put (childp2, QCsummary, build_string (summary)); pset_childp (p, childp2); } #endif /* not DOS_NT */ @@ -3120,8 +3157,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 +3169,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; - } +#if defined (GNU_LINUX) || defined (CYGWIN) - 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); } @@ -3228,6 +3241,7 @@ get_up_time (void) return up; } +# ifdef GNU_LINUX #define MAJOR(d) (((unsigned)(d) >> 8) & 0xfff) #define MINOR(d) (((unsigned)(d) & 0xff) | (((unsigned)(d) & 0xfff00000) >> 12)) @@ -3273,6 +3287,7 @@ procfs_ttyname (int rdev) unblock_input (); return build_string (name); } +# endif /* GNU_LINUX */ static uintmax_t procfs_get_total_memory (void) @@ -3340,11 +3355,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 +3382,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"); @@ -3409,7 +3422,7 @@ system_process_attributes (Lisp_Object pid) utime stime cutime cstime priority nice thcount . start vsize rss */ if (q && (sscanf (q + 2, ("%c %d %d %d %d %d %*u %lu %lu %lu %lu " - "%Lu %Lu %Lu %Lu %ld %ld %d %*d %Lu %lu %ld"), + "%llu %llu %llu %llu %ld %ld %d %*d %llu %lu %ld"), &c, &ppid, &pgrp, &sess, &tty, &tpgid, &minflt, &cminflt, &majflt, &cmajflt, &u_time, &s_time, &cutime, &cstime, @@ -3423,53 +3436,49 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qppid, INT_TO_INTEGER (ppid)), attrs); attrs = Fcons (Fcons (Qpgrp, INT_TO_INTEGER (pgrp)), attrs); attrs = Fcons (Fcons (Qsess, INT_TO_INTEGER (sess)), attrs); +# ifdef GNU_LINUX attrs = Fcons (Fcons (Qttname, procfs_ttyname (tty)), attrs); +# endif attrs = Fcons (Fcons (Qtpgid, INT_TO_INTEGER (tpgid)), attrs); attrs = Fcons (Fcons (Qminflt, INT_TO_INTEGER (minflt)), attrs); 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; @@ -3478,6 +3487,26 @@ system_process_attributes (Lisp_Object pid) } unbind_to (count, Qnil); +# ifdef CYGWIN + /* ttname */ + strcpy (procfn_end, "/ctty"); + fd = emacs_open (fn, O_RDONLY, 0); + if (fd < 0) + nread = 0; + else + { + record_unwind_protect_int (close_file_unwind, fd); + nread = emacs_read_quit (fd, procbuf, sizeof procbuf); + } + /* /proc/<pid>/ctty should always end in newline. */ + if (0 < nread && procbuf[nread - 1] == '\n') + procbuf[nread - 1] = '\0'; + else + procbuf[0] = '\0'; + attrs = Fcons (Fcons (Qttname, build_string (procbuf)), attrs); + unbind_to (count, Qnil); +# endif /* CYGWIN */ + /* args */ strcpy (procfn_end, "/cmdline"); fd = emacs_open (fn, O_RDONLY, 0); @@ -3491,7 +3520,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 +3554,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 +3603,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 +3627,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 +3715,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 +3795,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) @@ -3847,7 +3869,7 @@ system_process_attributes (Lisp_Object pid) Lisp_Object system_process_attributes (Lisp_Object pid) { - int proc_id, nentries, fscale, i; + int proc_id, fscale, i; int pagesize = getpagesize (); int mib[6]; size_t len; @@ -3856,7 +3878,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 +3959,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 +3976,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 +3986,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; @@ -4038,7 +4054,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; @@ -4156,23 +4171,22 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (rusage->ru_majflt)), attrs); - attrs = Fcons (Fcons (Qutime, make_lisp_timeval (rusage->ru_utime)), - attrs); - attrs = Fcons (Fcons (Qstime, make_lisp_timeval (rusage->ru_stime)), - attrs); - struct timespec t = timespec_add (timeval_to_timespec (rusage->ru_utime), - timeval_to_timespec (rusage->ru_stime)); - attrs = Fcons (Fcons (Qtime, make_lisp_time (t)), 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; @@ -4224,8 +4238,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..efedc3e450b 100644 --- a/src/sysstdio.h +++ b/src/sysstdio.h @@ -24,9 +24,12 @@ 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 ATTRIBUTE_DEALLOC (fclose, 1); 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..085a7ddeaba 100644 --- a/src/systime.h +++ b/src/systime.h @@ -26,6 +26,9 @@ INLINE_HEADER_BEGIN #ifdef HAVE_X_WINDOWS # include <X11/X.h> +#elif defined HAVE_HAIKU +# include <support/SupportDefs.h> +typedef int64 Time; #else typedef unsigned long Time; #endif @@ -80,8 +83,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 +94,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..3bea621dbda 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; @@ -2281,9 +2287,9 @@ A suspended tty may be resumed by calling `resume-tty' on it. */) delete_keyboard_wait_descriptor (fileno (f)); #ifndef MSDOS - fclose (f); if (f != t->display_info.tty->output) fclose (t->display_info.tty->output); + fclose (f); #endif t->display_info.tty->input = 0; @@ -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..c5f1e286e92 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -31,7 +31,8 @@ struct glyph; INLINE_HEADER_BEGIN -enum scroll_bar_part { +enum scroll_bar_part +{ scroll_bar_nowhere, scroll_bar_above_handle, scroll_bar_handle, @@ -60,7 +61,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 +81,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 +141,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. */ @@ -253,8 +278,11 @@ enum event_kind #endif #ifdef HAVE_XWIDGETS - /* events generated by xwidgets*/ + /* An event generated by an xwidget to tell us something. */ , XWIDGET_EVENT + + /* Event generated when WebKit asks us to display another widget. */ + , XWIDGET_DISPLAY_EVENT #endif #ifdef USE_FILE_NOTIFY @@ -262,6 +290,48 @@ 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 + + /* In a MONITORS_CHANGED_EVENT, .arg gives the terminal on which the + monitor configuration changed. .timestamp gives the time on + which the monitors changed. */ + , MONITORS_CHANGED_EVENT }; /* Bit width of an enum event_kind tag at the start of structs and unions. */ @@ -310,9 +380,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 +520,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 +595,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 +846,20 @@ 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 *); + +#ifdef HAVE_WINDOW_SYSTEM + /* Called to determine if the mouse is grabbed on the given display. + If either dpyinfo->grabbed or this returns true, then the display + will be considered as grabbed. */ + bool (*any_grab_hook) (Display_Info *); +#endif } GCALIGNED_STRUCT; INLINE bool @@ -830,6 +924,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..dcde8e9f557 100644 --- a/src/terminal.c +++ b/src/terminal.c @@ -290,13 +290,13 @@ create_terminal (enum output_method type, struct redisplay_interface *rif) keyboard_coding = find_symbol_value (intern ("default-keyboard-coding-system")); if (NILP (keyboard_coding) - || EQ (keyboard_coding, Qunbound) + || BASE_EQ (keyboard_coding, Qunbound) || NILP (Fcoding_system_p (keyboard_coding))) keyboard_coding = Qno_conversion; terminal_coding = find_symbol_value (intern ("default-terminal-coding-system")); if (NILP (terminal_coding) - || EQ (terminal_coding, Qunbound) + || BASE_EQ (terminal_coding, Qunbound) || NILP (Fcoding_system_p (terminal_coding))) terminal_coding = Qundecided; @@ -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..96d07b44be8 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -341,7 +341,7 @@ set_properties (Lisp_Object properties, INTERVAL interval, Lisp_Object object) for (sym = properties; PLIST_ELT_P (sym, value); sym = XCDR (value)) - if (EQ (property_value (interval->plist, XCAR (sym)), Qunbound)) + if (BASE_EQ (property_value (interval->plist, XCAR (sym)), Qunbound)) { record_property_change (interval->position, LENGTH (interval), XCAR (sym), Qnil, @@ -561,8 +561,13 @@ DEFUN ("text-properties-at", Ftext_properties_at, doc: /* Return the list of properties of the character at POSITION in OBJECT. If the optional second argument OBJECT is a buffer (or nil, which means the current buffer), POSITION is a buffer position (integer or marker). + If OBJECT is a string, POSITION is a 0-based index into it. -If POSITION is at the end of OBJECT, the value is nil. + +If POSITION is at the end of OBJECT, the value is nil, but note that +buffer narrowing does not affect the value. That is, if OBJECT is a +buffer or nil, and the buffer is narrowed and POSITION is at the end +of the narrowed buffer, the result may be non-nil. If you want to display the text properties at point in a human-readable form, use the `describe-text-properties' command. */) @@ -590,7 +595,11 @@ DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0, doc: /* Return the value of POSITION's property PROP, in OBJECT. OBJECT should be a buffer or a string; if omitted or nil, it defaults to the current buffer. -If POSITION is at the end of OBJECT, the value is nil. */) + +If POSITION is at the end of OBJECT, the value is nil, but note that +buffer narrowing does not affect the value. That is, if the buffer is +narrowed and POSITION is at the end of the narrowed buffer, the result +may be non-nil. */) (Lisp_Object position, Lisp_Object prop, Lisp_Object object) { return textget (Ftext_properties_at (position, object), prop); @@ -792,7 +801,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 +888,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 +1173,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 +1388,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, @@ -1398,8 +1407,8 @@ set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties, /* If we want no properties for a whole string, get rid of its intervals. */ if (NILP (properties) && STRINGP (object) - && EQ (start, make_fixnum (0)) - && EQ (end, make_fixnum (SCHARS (object)))) + && BASE_EQ (start, make_fixnum (0)) + && BASE_EQ (end, make_fixnum (SCHARS (object)))) { if (!string_intervals (object)) return Qnil; @@ -1462,7 +1471,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 +1567,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 +1692,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, @@ -2240,7 +2249,7 @@ verify_interval_modification (struct buffer *buf, tem = textget (i->plist, Qfront_sticky); if (TMEM (Qread_only, tem) - || (NILP (Fplist_get (i->plist, Qread_only)) + || (NILP (plist_get (i->plist, Qread_only)) && TMEM (Qcategory, tem))) text_read_only (after); } @@ -2260,7 +2269,7 @@ verify_interval_modification (struct buffer *buf, tem = textget (prev->plist, Qrear_nonsticky); if (! TMEM (Qread_only, tem) - && (! NILP (Fplist_get (prev->plist,Qread_only)) + && (! NILP (plist_get (prev->plist,Qread_only)) || ! TMEM (Qcategory, tem))) text_read_only (before); } @@ -2279,13 +2288,13 @@ verify_interval_modification (struct buffer *buf, tem = textget (i->plist, Qfront_sticky); if (TMEM (Qread_only, tem) - || (NILP (Fplist_get (i->plist, Qread_only)) + || (NILP (plist_get (i->plist, Qread_only)) && TMEM (Qcategory, tem))) text_read_only (after); tem = textget (prev->plist, Qrear_nonsticky); if (! TMEM (Qread_only, tem) - && (! NILP (Fplist_get (prev->plist, Qread_only)) + && (! NILP (plist_get (prev->plist, Qread_only)) || ! TMEM (Qcategory, tem))) text_read_only (after); } 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..9df50eaecc3 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -69,20 +69,9 @@ 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. - To try this now, compile with -DCURRENT_TIME_LIST=0. */ +/* current-time-list defaults to t, typically generating (HI LO US PS) + timestamps. To change the default to nil, generating (TICKS . HZ) + timestamps, compile with -DCURRENT_TIME_LIST=0. */ #ifndef CURRENT_TIME_LIST enum { CURRENT_TIME_LIST = true }; #endif @@ -223,7 +212,7 @@ tzlookup (Lisp_Object zone, bool settz) if (NILP (zone)) return local_tz; - else if (EQ (zone, Qt) || EQ (zone, make_fixnum (0))) + else if (BASE_EQ (zone, make_fixnum (0)) || BASE2_EQ (zone, Qt)) { zone_string = "UTC0"; new_tz = utc_tz; @@ -232,7 +221,7 @@ tzlookup (Lisp_Object zone, bool settz) { bool plain_integer = FIXNUMP (zone); - if (EQ (zone, Qwall)) + if (BASE2_EQ (zone, Qwall)) zone_string = 0; else if (STRINGP (zone)) zone_string = SSDATA (ENCODE_SYSTEM (zone)); @@ -352,7 +341,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"); @@ -527,7 +516,7 @@ lisp_time_hz_ticks (struct lisp_time t, Lisp_Object hz) /* The idea is to return the floor of ((T.ticks * HZ) / T.hz). */ /* For speed, just return T.ticks if T.hz == HZ. */ - if (FASTER_TIMEFNS && EQ (t.hz, hz)) + if (FASTER_TIMEFNS && BASE_EQ (t.hz, hz)) return t.ticks; /* Check HZ for validity. */ @@ -579,7 +568,7 @@ lisp_time_seconds (struct lisp_time t) Lisp_Object make_lisp_time (struct timespec t) { - if (CURRENT_TIME_LIST) + if (current_time_list) { time_t s = t.tv_sec; int ns = t.tv_nsec; @@ -740,7 +729,7 @@ decode_time_components (enum timeform form, case TIMEFORM_TICKS_HZ: if (INTEGERP (high) - && (!NILP (Fnatnump (low)) && !EQ (low, make_fixnum (0)))) + && !NILP (Fnatnump (low)) && !BASE_EQ (low, make_fixnum (0))) return decode_ticks_hz (high, low, result, dresult); return EINVAL; @@ -817,14 +806,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 +818,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 +839,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 +862,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 +878,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) @@ -931,7 +923,7 @@ lisp_to_timespec (struct lisp_time t) yielding quotient Q (tv_sec) and remainder NS (tv_nsec). Return an invalid timespec if Q does not fit in time_t. For speed, prefer fixnum arithmetic if it works. */ - if (FASTER_TIMEFNS && EQ (t.hz, timespec_hz)) + if (FASTER_TIMEFNS && BASE_EQ (t.hz, timespec_hz)) { if (FIXNUMP (t.ticks)) { @@ -950,7 +942,7 @@ lisp_to_timespec (struct lisp_time t) else ns = mpz_fdiv_q_ui (*q, *xbignum_val (t.ticks), TIMESPEC_HZ); } - else if (FASTER_TIMEFNS && EQ (t.hz, make_fixnum (1))) + else if (FASTER_TIMEFNS && BASE_EQ (t.hz, make_fixnum (1))) { ns = 0; if (FIXNUMP (t.ticks)) @@ -1008,8 +1000,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 +1025,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 (); @@ -1053,7 +1043,7 @@ lispint_arith (Lisp_Object a, Lisp_Object b, bool subtract) if (FASTER_TIMEFNS && FIXNUMP (b)) { - if (EQ (b, make_fixnum (0))) + if (BASE_EQ (b, make_fixnum (0))) return a; /* For speed, use EMACS_INT arithmetic if it will do. */ @@ -1087,7 +1077,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; @@ -1100,14 +1090,14 @@ time_arith (Lisp_Object a, Lisp_Object b, bool subtract) quicker while we're at it. Compare here rather than earlier, to handle NaNs and check formats. */ struct lisp_time tb; - if (EQ (a, b)) + if (BASE_EQ (a, b)) bform = aform, tb = ta; else tb = lisp_time_struct (b, &bform); Lisp_Object ticks, hz; - if (FASTER_TIMEFNS && EQ (ta.hz, tb.hz)) + if (FASTER_TIMEFNS && BASE_EQ (ta.hz, tb.hz)) { hz = ta.hz; ticks = lispint_arith (ta.ticks, tb.ticks, subtract); @@ -1138,24 +1128,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 +1149,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 @@ -1200,13 +1171,13 @@ time_arith (Lisp_Object a, Lisp_Object b, bool subtract) } /* Return an integer if the timestamp resolution is 1, - otherwise the (TICKS . HZ) form if !CURRENT_TIME_LIST or if + otherwise the (TICKS . HZ) form if !current_time_list or if either input used (TICKS . HZ) form or the result can't be expressed exactly in (HI LO US PS) form, otherwise the (HI LO US PS) form for backward compatibility. */ - return (EQ (hz, make_fixnum (1)) + return (BASE_EQ (hz, make_fixnum (1)) ? ticks - : (!CURRENT_TIME_LIST + : (!current_time_list || aform == TIMEFORM_TICKS_HZ || bform == TIMEFORM_TICKS_HZ || !trillion_factor (hz)) @@ -1247,20 +1218,20 @@ 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. */ - if (EQ (a, b)) + 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 (BASE_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); - if (! (FASTER_TIMEFNS && EQ (ta.hz, tb.hz))) + if (! (FASTER_TIMEFNS && BASE_EQ (ta.hz, tb.hz))) { /* This could be sped up by looking at the signs, sizes, and number of bits of the two sides; see how GMP does mpq_cmp. @@ -1302,9 +1273,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 @@ -1494,7 +1463,7 @@ usage: (format-time-string FORMAT-STRING &optional TIME ZONE) */) } DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 3, 0, - doc: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST UTCOFF). + doc: /* Decode a timestamp into (SEC MINUTE HOUR DAY MONTH YEAR DOW DST UTCOFF). The optional TIME is the time value to convert. See `format-time-string' for the various forms of a time value. @@ -1566,7 +1535,7 @@ usage: (decode-time &optional TIME ZONE FORM) */) /* Compute SEC from LOCAL_TM.tm_sec and HZ. */ Lisp_Object hz = lt.hz, sec; - if (EQ (hz, make_fixnum (1)) || !EQ (form, Qt)) + if (BASE_EQ (hz, make_fixnum (1)) || !BASE2_EQ (form, Qt)) sec = make_fixnum (local_tm.tm_sec); else { @@ -1639,28 +1608,32 @@ check_tm_member (Lisp_Object obj, int offset) DEFUN ("encode-time", Fencode_time, Sencode_time, 1, MANY, 0, doc: /* Convert TIME to a timestamp. -TIME is a list (SECOND MINUTE HOUR DAY MONTH YEAR IGNORED DST ZONE). +TIME is a list (SECOND MINUTE HOUR DAY MONTH YEAR IGNORED DST ZONE) in the style of `decode-time', so that (encode-time (decode-time ...)) works. In this list, ZONE can be nil for Emacs local time, t for Universal Time, `wall' for system wall clock time, or a string as in the TZ -environment variable. It can also be a list (as from +environment variable. ZONE can also be a list (as from `current-time-zone') or an integer (as from `decode-time') applied without consideration for daylight saving time. If ZONE specifies a time zone with daylight-saving transitions, DST is t for daylight saving time, nil for standard time, and -1 to cause the daylight saving flag to be guessed. +TIME can also be a list (SECOND MINUTE HOUR DAY MONTH YEAR), which is +equivalent to (SECOND MINUTE HOUR DAY MONTH YEAR nil -1 nil). + 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 is -1 and ZONE defaults to nil. -Years before 1970 are not guaranteed to work. On some systems, -year values as low as 1901 do work. +The range of supported years is at least 1970 to the near future. +Out-of-range values for SECOND through MONTH are brought into range +via date arithmetic. This can be tricky especially when combined with +DST; see Info node `(elisp)Time Conversion' for details and caveats. usage: (encode-time TIME &rest OBSOLESCENT-ARGUMENTS) */) (ptrdiff_t nargs, Lisp_Object *args) @@ -1674,7 +1647,7 @@ usage: (encode-time TIME &rest OBSOLESCENT-ARGUMENTS) */) if (nargs == 1) { Lisp_Object tail = a; - for (int i = 0; i < 9; i++, tail = XCDR (tail)) + for (int i = 0; i < 6; i++, tail = XCDR (tail)) CHECK_CONS (tail); secarg = XCAR (a); a = XCDR (a); minarg = XCAR (a); a = XCDR (a); @@ -1682,11 +1655,17 @@ usage: (encode-time TIME &rest OBSOLESCENT-ARGUMENTS) */) mdayarg = XCAR (a); a = XCDR (a); monarg = XCAR (a); a = XCDR (a); yeararg = XCAR (a); a = XCDR (a); - a = XCDR (a); - Lisp_Object dstflag = XCAR (a); a = XCDR (a); - zone = XCAR (a); - if (SYMBOLP (dstflag) && !FIXNUMP (zone) && !CONSP (zone)) - tm.tm_isdst = !NILP (dstflag); + if (! NILP (a)) + { + CHECK_CONS (a); + a = XCDR (a); + CHECK_CONS (a); + Lisp_Object dstflag = XCAR (a); a = XCDR (a); + CHECK_CONS (a); + zone = XCAR (a); + if (SYMBOLP (dstflag) && !FIXNUMP (zone) && !CONSP (zone)) + tm.tm_isdst = !NILP (dstflag); + } } else if (nargs < 6) xsignal2 (Qwrong_number_of_arguments, Qencode_time, make_fixnum (nargs)); @@ -1704,9 +1683,9 @@ 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))) + if (FASTER_TIMEFNS && BASE_EQ (hz, make_fixnum (1))) { sec = lt.ticks; subsecticks = make_fixnum (0); @@ -1736,8 +1715,8 @@ usage: (encode-time TIME &rest OBSOLESCENT-ARGUMENTS) */) if (tm.tm_wday < 0) time_error (mktime_errno); - if (EQ (hz, make_fixnum (1))) - return (CURRENT_TIME_LIST + if (BASE_EQ (hz, make_fixnum (1))) + return (current_time_list ? list2 (hi_time (value), lo_time (value)) : INT_TO_INTEGER (value)); else @@ -1757,9 +1736,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,37 +1745,51 @@ 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)) + form = current_time_list ? Qlist : Qt; + if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (form)) + form = SYMBOL_WITH_POS_SYM (form); + if (BASE_EQ (form, Qlist)) return ticks_hz_list4 (t.ticks, t.hz); - if (EQ (form, Qinteger)) + if (BASE_EQ (form, Qinteger)) return FASTER_TIMEFNS && INTEGERP (time) ? time : lisp_time_seconds (t); - if (EQ (form, Qt)) + if (BASE_EQ (form, Qt)) form = t.hz; if (FASTER_TIMEFNS - && input_form == TIMEFORM_TICKS_HZ && EQ (form, XCDR (time))) + && input_form == TIMEFORM_TICKS_HZ && BASE_EQ (form, XCDR (time))) return time; return Fcons (lisp_time_hz_ticks (t, form), form); } DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0, doc: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00. -The time is returned as a list of integers (HIGH LOW USEC PSEC). -HIGH has the most significant bits of the seconds, while LOW has the -least significant 16 bits. USEC and PSEC are the microsecond and -picosecond counts. - -In a future Emacs version, the format of the returned timestamp is -planned to change. Use `time-convert' if you need a particular -timestamp form; for example, (time-convert nil \\='integer) returns -the current time in seconds. */) +If the variable `current-time-list' is nil, the time is returned as a +pair of integers (TICKS . HZ), where TICKS counts clock ticks and HZ +is the clock ticks per second. Otherwise, the time is returned as a +list of integers (HIGH LOW USEC PSEC) where HIGH has the most +significant bits of the seconds, LOW has the least significant 16 +bits, and USEC and PSEC are the microsecond and picosecond counts. + +You can use `time-convert' to get a particular timestamp form +regardless of the value of `current-time-list'. */) (void) { return make_lisp_time (current_timespec ()); } +#ifdef CLOCKS_PER_SEC +DEFUN ("current-cpu-time", Fcurrent_cpu_time, Scurrent_cpu_time, 0, 0, 0, + doc: /* Return the current CPU time along with its resolution. +The return value is a pair (CPU-TICKS . TICKS-PER-SEC). +The CPU-TICKS counter can wrap around, so values cannot be meaningfully +compared if too much time has passed between them. */) + (void) +{ + return Fcons (make_int (clock ()), make_int (CLOCKS_PER_SEC)); +} +#endif + DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, 0, 2, 0, doc: /* Return the current local time, as a human-readable string. @@ -2037,7 +2028,23 @@ syms_of_timefns (void) DEFSYM (Qencode_time, "encode-time"); + DEFVAR_BOOL ("current-time-list", current_time_list, + doc: /* Whether `current-time' should return list or (TICKS . HZ) form. + +This boolean variable is a transition aid. If t, `current-time' and +related functions return timestamps in list form, typically +\(HIGH LOW USEC PSEC); otherwise, they use (TICKS . HZ) form. +Currently this variable defaults to t, for behavior compatible with +previous Emacs versions. Developers are encouraged to test +timestamp-related code with this variable set to nil, as it will +default to nil in a future Emacs version, and will be removed in some +version after that. */); + current_time_list = CURRENT_TIME_LIST; + defsubr (&Scurrent_time); +#ifdef CLOCKS_PER_SEC + defsubr (&Scurrent_cpu_time); +#endif defsubr (&Stime_convert); defsubr (&Stime_add); defsubr (&Stime_subtract); diff --git a/src/tparam.h b/src/tparam.h index 6361f138eaa..4f4bdc8820f 100644 --- a/src/tparam.h +++ b/src/tparam.h @@ -20,6 +20,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #ifndef EMACS_TPARAM_H #define EMACS_TPARAM_H +#include <stdlib.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. */ @@ -30,7 +34,8 @@ int tgetnum (const char *); char *tgetstr (const char *, char **); char *tgoto (const char *, int, int); -char *tparam (const char *, char *, int, int, int, int, int) ATTRIBUTE_MALLOC; +char *tparam (const char *, char *, int, int, int, int, int) + ATTRIBUTE_MALLOC ATTRIBUTE_DEALLOC_FREE; extern char PC; extern char *BC; diff --git a/src/undo.c b/src/undo.c index 5d705945c4c..f76977dbe50 100644 --- a/src/undo.c +++ b/src/undo.c @@ -218,7 +218,7 @@ record_first_change (void) base_buffer = base_buffer->base_buffer; bset_undo_list (current_buffer, - Fcons (Fcons (Qt, Fvisited_file_modtime ()), + Fcons (Fcons (Qt, buffer_visited_file_modtime (base_buffer)), BVAR (current_buffer, undo_list))); } @@ -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..e4c6d007661 100644 --- a/src/w32.c +++ b/src/w32.c @@ -71,6 +71,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #undef localtime +#undef clock + char *sys_ctime (const time_t *); int sys_chdir (const char *); int sys_creat (const char *, int); @@ -87,6 +89,7 @@ struct tm *sys_localtime (const time_t *); compiler to emit a warning about sys_strerror having no prototype. */ char *sys_strerror (int); +clock_t sys_clock (void); #ifdef HAVE_MODULES extern void dynlib_reset_last_error (void); @@ -348,6 +351,7 @@ static BOOL g_b_init_reg_open_key_ex_w; static BOOL g_b_init_reg_query_value_ex_w; static BOOL g_b_init_expand_environment_strings_w; static BOOL g_b_init_get_user_default_ui_language; +static BOOL g_b_init_get_console_font_size; BOOL g_b_init_compare_string_w; BOOL g_b_init_debug_break_process; @@ -537,6 +541,22 @@ typedef LONG (WINAPI *RegQueryValueExW_Proc) (HKEY,LPCWSTR,LPDWORD,LPDWORD,LPBYT typedef DWORD (WINAPI *ExpandEnvironmentStringsW_Proc) (LPCWSTR,LPWSTR,DWORD); typedef LANGID (WINAPI *GetUserDefaultUILanguage_Proc) (void); +typedef COORD (WINAPI *GetConsoleFontSize_Proc) (HANDLE, DWORD); + +#if _WIN32_WINNT < 0x0501 +typedef struct +{ + DWORD nFont; + COORD dwFontSize; +} CONSOLE_FONT_INFO; +#endif + +typedef BOOL (WINAPI *GetCurrentConsoleFont_Proc) ( + HANDLE, + BOOL, + CONSOLE_FONT_INFO *); + + /* ** A utility function ** */ static BOOL is_windows_9x (void) @@ -2820,53 +2840,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 +3050,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) { @@ -4687,6 +4660,9 @@ sys_open (const char * path, int oflag, int mode) return res; } +/* This is not currently used, but might be needed again at some + point; DO NOT DELETE! */ +#if 0 int openat (int fd, const char * path, int oflag, int mode) { @@ -4707,6 +4683,7 @@ openat (int fd, const char * path, int oflag, int mode) return sys_open (path, oflag, mode); } +#endif int fchmod (int fd, mode_t mode) @@ -8595,7 +8572,7 @@ fcntl (int s, int cmd, int options) int sys_close (int fd) { - int rc; + int rc = -1; if (fd < 0) { @@ -8650,14 +8627,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; } @@ -10164,6 +10158,32 @@ sys_localtime (const time_t *t) return localtime (t); } +/* The Windows CRT implementation of 'clock' doesn't really return CPU + time of the process (it returns the elapsed time since the process + started), so we provide a better emulation here, if possible. */ +clock_t +sys_clock (void) +{ + if (get_process_times_fn) + { + FILETIME create, exit, kernel, user; + HANDLE proc = GetCurrentProcess (); + if ((*get_process_times_fn) (proc, &create, &exit, &kernel, &user)) + { + LARGE_INTEGER user_int, kernel_int, total; + user_int.LowPart = user.dwLowDateTime; + user_int.HighPart = user.dwHighDateTime; + kernel_int.LowPart = kernel.dwLowDateTime; + kernel_int.HighPart = kernel.dwHighDateTime; + total.QuadPart = user_int.QuadPart + kernel_int.QuadPart; + /* We could redefine CLOCKS_PER_SEC to provide a finer + resolution, but with the basic 15.625 msec resolution of + the Windows clock, it doesn't really sound worth the hassle. */ + return total.QuadPart / (10000000 / CLOCKS_PER_SEC); + } + } + return clock (); +} /* Try loading LIBRARY_ID from the file(s) specified in @@ -10277,7 +10297,8 @@ check_windows_init_file (void) openp (Vload_path, init_file, Fget_load_suffixes (), NULL, Qnil, 0, 0); if (fd < 0) { - Lisp_Object load_path_print = Fprin1_to_string (Vload_path, Qnil); + Lisp_Object load_path_print = Fprin1_to_string (Vload_path, + Qnil, Qnil); char *init_file_name = SSDATA (init_file); char *load_path = SSDATA (load_path_print); char *buffer = alloca (1024 @@ -10644,6 +10665,120 @@ realpath (const char *file_name, char *resolved_name) return xstrdup (tgt); } +static void +get_console_font_size (HANDLE hscreen, int *font_width, int *font_height) +{ + static GetCurrentConsoleFont_Proc s_pfn_Get_Current_Console_Font = NULL; + static GetConsoleFontSize_Proc s_pfn_Get_Console_Font_Size = NULL; + + /* Default guessed values, for when we cannot obtain the actual ones. */ + *font_width = 8; + *font_height = 12; + + if (!is_windows_9x ()) + { + if (g_b_init_get_console_font_size == 0) + { + HMODULE hm_kernel32 = LoadLibrary ("Kernel32.dll"); + if (hm_kernel32) + { + s_pfn_Get_Current_Console_Font = (GetCurrentConsoleFont_Proc) + get_proc_addr (hm_kernel32, "GetCurrentConsoleFont"); + s_pfn_Get_Console_Font_Size = (GetConsoleFontSize_Proc) + get_proc_addr (hm_kernel32, "GetConsoleFontSize"); + } + g_b_init_get_console_font_size = 1; + } + } + if (s_pfn_Get_Current_Console_Font && s_pfn_Get_Console_Font_Size) + { + CONSOLE_FONT_INFO font_info; + + if (s_pfn_Get_Current_Console_Font (hscreen, FALSE, &font_info)) + { + COORD font_size = s_pfn_Get_Console_Font_Size (hscreen, + font_info.nFont); + if (font_size.X > 0) + *font_width = font_size.X; + if (font_size.Y > 0) + *font_height = font_size.Y; + } + } +} + +/* A replacement for Posix execvp, used to restart Emacs. This is + needed because the low-level Windows API to start processes accepts + the command-line arguments as a single string, so we cannot safely + use the MSVCRT execvp emulation, because elements of argv[] that + have embedded blanks and tabs will not be passed correctly to the + restarted Emacs. */ +int +w32_reexec_emacs (char *cmd_line, const char *wdir) +{ + STARTUPINFO si; + BOOL status; + PROCESS_INFORMATION proc_info; + DWORD dwCreationFlags = NORMAL_PRIORITY_CLASS; + + GetStartupInfo (&si); /* Use the same startup info as the caller. */ + if (inhibit_window_system) + { + HANDLE screen_handle; + CONSOLE_SCREEN_BUFFER_INFO screen_info; + + screen_handle = GetStdHandle (STD_OUTPUT_HANDLE); + if (screen_handle != INVALID_HANDLE_VALUE + && GetConsoleScreenBufferInfo (screen_handle, &screen_info)) + { + int font_width, font_height; + + /* Make the restarted Emacs's console window the same + dimensions as ours. */ + si.dwXCountChars = screen_info.dwSize.X; + si.dwYCountChars = screen_info.dwSize.Y; + get_console_font_size (screen_handle, &font_width, &font_height); + si.dwXSize = + (screen_info.srWindow.Right - screen_info.srWindow.Left + 1) + * font_width; + si.dwYSize = + (screen_info.srWindow.Bottom - screen_info.srWindow.Top + 1) + * font_height; + si.dwFlags |= STARTF_USESIZE | STARTF_USECOUNTCHARS; + } + /* This is a kludge: it causes the restarted "emacs -nw" to have + a new console window created for it, and that new window + might have different (default) properties, not the ones of + the parent process's console window. But without this, + restarting Emacs in the -nw mode simply doesn't work, + probably because the parent's console is still in use. + FIXME! */ + dwCreationFlags = CREATE_NEW_CONSOLE; + } + + /* Make sure we are in the original directory, in case the command + line specifies the program as a relative file name. */ + chdir (wdir); + + status = CreateProcess (NULL, /* no program, take from command line */ + cmd_line, /* command line */ + NULL, + NULL, /* thread attributes */ + FALSE, /* unherit handles? */ + dwCreationFlags, + NULL, /* environment */ + wdir, /* initial directory */ + &si, /* startup info */ + &proc_info); + if (status) + { + CloseHandle (proc_info.hThread); + CloseHandle (proc_info.hProcess); + exit (0); + } + errno = ENOEXEC; + return -1; +} + /* globals_of_w32 is used to initialize those global variables that must always be initialized on startup even when the global variable @@ -10704,6 +10839,7 @@ globals_of_w32 (void) g_b_init_compare_string_w = 0; g_b_init_debug_break_process = 0; g_b_init_get_user_default_ui_language = 0; + g_b_init_get_console_font_size = 0; num_of_processors = 0; /* The following sets a handler for shutdown notifications for console apps. This actually applies to Emacs in both console and @@ -10817,19 +10953,19 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact) dcb.EvtChar = 0; /* Configure speed. */ - if (!NILP (Fplist_member (contact, QCspeed))) - tem = Fplist_get (contact, QCspeed); + if (!NILP (plist_member (contact, QCspeed))) + tem = plist_get (contact, QCspeed); else - tem = Fplist_get (p->childp, QCspeed); + tem = plist_get (p->childp, QCspeed); CHECK_FIXNUM (tem); dcb.BaudRate = XFIXNUM (tem); - childp2 = Fplist_put (childp2, QCspeed, tem); + childp2 = plist_put (childp2, QCspeed, tem); /* Configure bytesize. */ - if (!NILP (Fplist_member (contact, QCbytesize))) - tem = Fplist_get (contact, QCbytesize); + if (!NILP (plist_member (contact, QCbytesize))) + tem = plist_get (contact, QCbytesize); else - tem = Fplist_get (p->childp, QCbytesize); + tem = plist_get (p->childp, QCbytesize); if (NILP (tem)) tem = make_fixnum (8); CHECK_FIXNUM (tem); @@ -10837,13 +10973,13 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact) error (":bytesize must be nil (8), 7, or 8"); dcb.ByteSize = XFIXNUM (tem); summary[0] = XFIXNUM (tem) + '0'; - childp2 = Fplist_put (childp2, QCbytesize, tem); + childp2 = plist_put (childp2, QCbytesize, tem); /* Configure parity. */ - if (!NILP (Fplist_member (contact, QCparity))) - tem = Fplist_get (contact, QCparity); + if (!NILP (plist_member (contact, QCparity))) + tem = plist_get (contact, QCparity); else - tem = Fplist_get (p->childp, QCparity); + tem = plist_get (p->childp, QCparity); if (!NILP (tem) && !EQ (tem, Qeven) && !EQ (tem, Qodd)) error (":parity must be nil (no parity), `even', or `odd'"); dcb.fParity = FALSE; @@ -10867,13 +11003,13 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact) dcb.Parity = ODDPARITY; dcb.fErrorChar = TRUE; } - childp2 = Fplist_put (childp2, QCparity, tem); + childp2 = plist_put (childp2, QCparity, tem); /* Configure stopbits. */ - if (!NILP (Fplist_member (contact, QCstopbits))) - tem = Fplist_get (contact, QCstopbits); + if (!NILP (plist_member (contact, QCstopbits))) + tem = plist_get (contact, QCstopbits); else - tem = Fplist_get (p->childp, QCstopbits); + tem = plist_get (p->childp, QCstopbits); if (NILP (tem)) tem = make_fixnum (1); CHECK_FIXNUM (tem); @@ -10884,13 +11020,13 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact) dcb.StopBits = ONESTOPBIT; else if (XFIXNUM (tem) == 2) dcb.StopBits = TWOSTOPBITS; - childp2 = Fplist_put (childp2, QCstopbits, tem); + childp2 = plist_put (childp2, QCstopbits, tem); /* Configure flowcontrol. */ - if (!NILP (Fplist_member (contact, QCflowcontrol))) - tem = Fplist_get (contact, QCflowcontrol); + if (!NILP (plist_member (contact, QCflowcontrol))) + tem = plist_get (contact, QCflowcontrol); else - tem = Fplist_get (p->childp, QCflowcontrol); + tem = plist_get (p->childp, QCflowcontrol); if (!NILP (tem) && !EQ (tem, Qhw) && !EQ (tem, Qsw)) error (":flowcontrol must be nil (no flowcontrol), `hw', or `sw'"); dcb.fOutxCtsFlow = FALSE; @@ -10917,13 +11053,13 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact) dcb.fOutX = TRUE; dcb.fInX = TRUE; } - childp2 = Fplist_put (childp2, QCflowcontrol, tem); + childp2 = plist_put (childp2, QCflowcontrol, tem); /* Activate configuration. */ if (!SetCommState (hnd, &dcb)) error ("SetCommState() failed"); - childp2 = Fplist_put (childp2, QCsummary, build_string (summary)); + childp2 = plist_put (childp2, QCsummary, build_string (summary)); pset_childp (p, childp2); } @@ -10945,6 +11081,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..dc91c595c43 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); @@ -242,6 +244,9 @@ extern int w32_init_random (void *, ptrdiff_t); extern Lisp_Object w32_read_registry (HKEY, Lisp_Object, Lisp_Object); +/* Used instead of execvp to restart Emacs. */ +extern int w32_reexec_emacs (char *, const char *); + #ifdef HAVE_GNUTLS #include <gnutls/gnutls.h> diff --git a/src/w32console.c b/src/w32console.c index 12e1f397894..09749126e03 100644 --- a/src/w32console.c +++ b/src/w32console.c @@ -716,10 +716,10 @@ initialize_w32_display (struct terminal *term, int *width, int *height) if (cur_screen == INVALID_HANDLE_VALUE) { - printf ("CreateConsoleScreenBuffer failed in ResetTerm\n"); + printf ("CreateConsoleScreenBuffer failed in initialize_w32_display\n"); printf ("LastError = 0x%lx\n", GetLastError ()); fflush (stdout); - exit (0); + exit (1); } #else cur_screen = prev_screen; @@ -760,7 +760,13 @@ initialize_w32_display (struct terminal *term, int *width, int *height) } } - GetConsoleScreenBufferInfo (cur_screen, &info); + if (!GetConsoleScreenBufferInfo (cur_screen, &info)) + { + printf ("GetConsoleScreenBufferInfo failed in initialize_w32_display\n"); + printf ("LastError = 0x%lx\n", GetLastError ()); + fflush (stdout); + exit (1); + } char_attr_normal = info.wAttributes; diff --git a/src/w32fns.c b/src/w32fns.c index be57d9de4da..51540e1880c 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; @@ -226,6 +247,8 @@ static HWND w32_visible_system_caret_hwnd; static int w32_unicode_gui; +static bool w32_selection_dialog_open; + /* From w32menu.c */ int menubar_in_use = 0; @@ -252,6 +275,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; @@ -771,13 +797,6 @@ w32_default_color_map (void) return (cmap); } -DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map, - 0, 0, 0, doc: /* Return the default color map. */) - (void) -{ - return w32_default_color_map (); -} - static Lisp_Object w32_color_map_lookup (const char *colorname) { @@ -1193,7 +1212,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 +1228,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 +1237,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 +1247,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 +1258,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 +1268,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 @@ -1437,7 +1456,7 @@ w32_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) return; if (STRINGP (arg) && STRINGP (oldval) - && EQ (Fstring_equal (oldval, arg), Qt)) + && BASE_EQ (Fstring_equal (oldval, arg), Qt)) return; if (SYMBOLP (arg) && SYMBOLP (oldval) && EQ (arg, oldval)) @@ -1460,7 +1479,7 @@ w32_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { if (STRINGP (arg)) { - if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt)) + if (STRINGP (oldval) && BASE_EQ (Fstring_equal (oldval, arg), Qt)) return; } else if (!NILP (arg) || NILP (oldval)) @@ -1778,6 +1797,32 @@ w32_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) w32_change_tool_bar_height (f, nlines * FRAME_LINE_HEIGHT (f)); } +/* Enable or disable double buffering on frame F. + + When double buffering is enabled, all drawing happens on a back + buffer (a bitmap), which is then displayed as a single operation + after redisplay is complete. This avoids flicker caused by the + results of an incomplete redisplay becoming visible. */ +static void +w32_set_inhibit_double_buffering (struct frame *f, + Lisp_Object new_value, + /* This parameter is unused. */ + Lisp_Object old_value) +{ + block_input (); + + if (NILP (new_value)) + FRAME_OUTPUT_DATA (f)->want_paint_buffer = 1; + else + { + FRAME_OUTPUT_DATA (f)->want_paint_buffer = 0; + w32_release_paint_buffer (f); + + SET_FRAME_GARBAGED (f); + } + + unblock_input (); +} /* Set the pixel height of the tool bar of frame F to HEIGHT. */ void @@ -2279,10 +2324,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 +2362,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 +2379,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 +2467,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); @@ -4034,7 +4114,10 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) { case WM_ERASEBKGND: f = w32_window_to_frame (dpyinfo, hwnd); - if (f) + + enter_crit (); + if (f && (w32_disable_double_buffering + || !FRAME_OUTPUT_DATA (f)->paint_buffer)) { HDC hdc = get_frame_dc (f); GetUpdateRect (hwnd, &wmsg.rect, FALSE); @@ -4048,6 +4131,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) wmsg.rect.right, wmsg.rect.bottom)); #endif /* W32_DEBUG_DISPLAY */ } + leave_crit (); return 1; case WM_PALETTECHANGED: /* ignore our own changes */ @@ -4095,6 +4179,16 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) update_rect.left, update_rect.top, update_rect.right, update_rect.bottom)); #endif + /* Under double-buffering, update the frame from the back + buffer, to prevent a "ghost" of the selection dialog to + be left on display while the user selects in the dialog. */ + if (w32_selection_dialog_open + && !w32_disable_double_buffering + && FRAME_OUTPUT_DATA (f)->paint_dc) + BitBlt (FRAME_OUTPUT_DATA (f)->paint_buffer_handle, + 0, 0, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f), + FRAME_OUTPUT_DATA (f)->paint_dc, 0, 0, SRCCOPY); + EndPaint (hwnd, &paintStruct); leave_crit (); @@ -5114,6 +5208,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 (); @@ -5440,11 +5541,11 @@ my_create_window (struct frame * f) RES_TYPE_NUMBER); top = gui_display_get_arg (dpyinfo, Qnil, Qtop, "top", "Top", RES_TYPE_NUMBER); - if (EQ (left, Qunbound)) + if (BASE_EQ (left, Qunbound)) coords[0] = CW_USEDEFAULT; else coords[0] = XFIXNUM (left); - if (EQ (top, Qunbound)) + if (BASE_EQ (top, Qunbound)) coords[1] = CW_USEDEFAULT; else coords[1] = XFIXNUM (top); @@ -5560,12 +5661,12 @@ w32_icon (struct frame *f, Lisp_Object parms) RES_TYPE_NUMBER); icon_y = gui_display_get_arg (dpyinfo, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER); - if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound)) + if (!BASE_EQ (icon_x, Qunbound) && !BASE_EQ (icon_y, Qunbound)) { CHECK_FIXNUM (icon_x); CHECK_FIXNUM (icon_y); } - else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound)) + else if (!BASE_EQ (icon_x, Qunbound) || !BASE_EQ (icon_y, Qunbound)) error ("Both left and top icon corners of icon must be specified"); block_input (); @@ -5660,7 +5761,7 @@ w32_default_font_parameter (struct frame *f, Lisp_Object parms) parms, Qfont, NULL, NULL, RES_TYPE_STRING); Lisp_Object font; - if (EQ (font_param, Qunbound)) + if (BASE_EQ (font_param, Qunbound)) font_param = Qnil; font = !NILP (font_param) ? font_param : gui_display_get_arg (dpyinfo, parms, Qfont, "font", "Font", @@ -5705,7 +5806,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; @@ -5725,10 +5826,10 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, display = gui_display_get_arg (dpyinfo, parameters, Qterminal, 0, 0, RES_TYPE_NUMBER); - if (EQ (display, Qunbound)) + if (BASE_EQ (display, Qunbound)) display = gui_display_get_arg (dpyinfo, parameters, Qdisplay, 0, 0, RES_TYPE_STRING); - if (EQ (display, Qunbound)) + if (BASE_EQ (display, Qunbound)) display = Qnil; dpyinfo = check_x_display_info (display); kb = dpyinfo->terminal->kboard; @@ -5739,7 +5840,7 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, name = gui_display_get_arg (dpyinfo, parameters, Qname, "name", "Name", RES_TYPE_STRING); if (!STRINGP (name) - && ! EQ (name, Qunbound) + && ! BASE_EQ (name, Qunbound) && ! NILP (name)) error ("Invalid frame name--not a string or nil"); @@ -5749,7 +5850,7 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, /* See if parent window is specified. */ parent = gui_display_get_arg (dpyinfo, parameters, Qparent_id, NULL, NULL, RES_TYPE_NUMBER); - if (EQ (parent, Qunbound)) + if (BASE_EQ (parent, Qunbound)) parent = Qnil; else if (!NILP (parent)) CHECK_FIXNUM (parent); @@ -5792,14 +5893,14 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, tem = gui_display_get_arg (dpyinfo, parameters, Qundecorated, NULL, NULL, RES_TYPE_BOOLEAN); - FRAME_UNDECORATED (f) = !NILP (tem) && !EQ (tem, Qunbound); + FRAME_UNDECORATED (f) = !NILP (tem) && !BASE_EQ (tem, Qunbound); store_frame_param (f, Qundecorated, FRAME_UNDECORATED (f) ? Qt : Qnil); tem = gui_display_get_arg (dpyinfo, parameters, Qskip_taskbar, NULL, NULL, RES_TYPE_BOOLEAN); - FRAME_SKIP_TASKBAR (f) = !NILP (tem) && !EQ (tem, Qunbound); + FRAME_SKIP_TASKBAR (f) = !NILP (tem) && !BASE_EQ (tem, Qunbound); store_frame_param (f, Qskip_taskbar, - (NILP (tem) || EQ (tem, Qunbound)) ? Qnil : Qt); + (NILP (tem) || BASE_EQ (tem, Qunbound)) ? Qnil : Qt); /* By default, make scrollbars the system standard width and height. */ FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL); @@ -5855,7 +5956,7 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, /* Set the name; the functions to which we pass f expect the name to be set. */ - if (EQ (name, Qunbound) || NILP (name)) + if (BASE_EQ (name, Qunbound) || NILP (name)) { fset_name (f, build_string (dpyinfo->w32_id_name)); f->explicit_name = false; @@ -5895,7 +5996,7 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, value = gui_display_get_arg (dpyinfo, parameters, Qinternal_border_width, "internalBorder", "internalBorder", RES_TYPE_NUMBER); - if (! EQ (value, Qunbound)) + if (! BASE_EQ (value, Qunbound)) parameters = Fcons (Fcons (Qinternal_border_width, value), parameters); } @@ -5912,7 +6013,7 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, value = gui_display_get_arg (dpyinfo, parameters, Qchild_frame_border_width, "childFrameBorder", "childFrameBorder", RES_TYPE_NUMBER); - if (!EQ (value, Qunbound)) + if (!BASE_EQ (value, Qunbound)) parameters = Fcons (Fcons (Qchild_frame_border_width, value), parameters); } @@ -5952,6 +6053,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 @@ -6012,6 +6115,10 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, ? make_fixnum (0) : make_fixnum (1), NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parameters, Qinhibit_double_buffering, Qnil, + "inhibitDoubleBuffering", "InhibitDoubleBuffering", + RES_TYPE_BOOLEAN); + gui_default_parameter (f, parameters, Qbuffer_predicate, Qnil, "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL); gui_default_parameter (f, parameters, Qtitle, Qnil, @@ -6089,6 +6196,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. */ @@ -6102,7 +6212,7 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, w32_iconify_frame (f); else { - if (EQ (visibility, Qunbound)) + if (BASE_EQ (visibility, Qunbound)) visibility = Qt; if (!NILP (visibility)) @@ -6875,7 +6985,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; @@ -6894,7 +7004,7 @@ w32_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms) name = gui_display_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING); if (!STRINGP (name) - && !EQ (name, Qunbound) + && !BASE_EQ (name, Qunbound) && !NILP (name)) error ("Invalid frame name--not a string or nil"); Vx_resource_name = name; @@ -6928,7 +7038,7 @@ w32_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms) /* Set the name; the functions to which we pass f expect the name to be set. */ - if (EQ (name, Qunbound) || NILP (name)) + if (BASE_EQ (name, Qunbound) || NILP (name)) { fset_name (f, build_string (dpyinfo->w32_id_name)); f->explicit_name = false; @@ -6967,7 +7077,7 @@ w32_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms) value = gui_display_get_arg (dpyinfo, parms, Qinternal_border_width, "internalBorder", "internalBorder", RES_TYPE_NUMBER); - if (! EQ (value, Qunbound)) + if (! BASE_EQ (value, Qunbound)) parms = Fcons (Fcons (Qinternal_border_width, value), parms); } @@ -7023,6 +7133,11 @@ 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); + gui_default_parameter (f, parms, Qinhibit_double_buffering, Qnil, + "inhibitDoubleBuffering", "InhibitDoubleBuffering", + RES_TYPE_BOOLEAN); /* Add `tooltip' frame parameter's default value. */ if (NILP (Fframe_parameter (frame, Qtooltip))) @@ -7200,10 +7315,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 +7358,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*"); @@ -7258,9 +7371,8 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, decode_window_system_frame (frame); if (NILP (timeout)) - timeout = make_fixnum (5); - else - CHECK_FIXNAT (timeout); + timeout = Vx_show_tooltip_timeout; + CHECK_FIXNAT (timeout); if (NILP (dx)) dx = make_fixnum (5); @@ -7444,7 +7556,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 +7571,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); @@ -7647,6 +7760,15 @@ w32_dialog_in_progress (Lisp_Object in_progress) { Lisp_Object frames, frame; + /* Indicate to w32_wnd_proc that the selection dialog is about to be + open (or was closed, if IN_PROGRESS is nil). */ + if (!w32_disable_double_buffering) + { + enter_crit (); + w32_selection_dialog_open = !NILP (in_progress); + leave_crit (); + } + /* Don't let frames in `above' z-group obscure dialog windows. */ FOR_EACH_FRAME (frames, frame) { @@ -7878,7 +8000,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); @@ -10083,21 +10205,21 @@ usage: (w32-notification-notify &rest PARAMS) */) arg_plist = Flist (nargs, args); /* Icon. */ - lres = Fplist_get (arg_plist, QCicon); + lres = plist_get (arg_plist, QCicon); if (STRINGP (lres)) icon = SSDATA (ENCODE_FILE (Fexpand_file_name (lres, Qnil))); else icon = (char *)""; /* Tip. */ - lres = Fplist_get (arg_plist, QCtip); + lres = plist_get (arg_plist, QCtip); if (STRINGP (lres)) tip = SSDATA (code_convert_string_norecord (lres, Qutf_8, 1)); else tip = (char *)"Emacs notification"; /* Severity. */ - lres = Fplist_get (arg_plist, QClevel); + lres = plist_get (arg_plist, QClevel); if (NILP (lres)) severity = Ni_None; else if (EQ (lres, Qinfo)) @@ -10110,14 +10232,14 @@ usage: (w32-notification-notify &rest PARAMS) */) severity = Ni_Info; /* Title. */ - lres = Fplist_get (arg_plist, QCtitle); + lres = plist_get (arg_plist, QCtitle); if (STRINGP (lres)) title = SSDATA (code_convert_string_norecord (lres, Qutf_8, 1)); else title = (char *)""; /* Notification body text. */ - lres = Fplist_get (arg_plist, QCbody); + lres = plist_get (arg_plist, QCbody); if (STRINGP (lres)) msg = SSDATA (code_convert_string_norecord (lres, Qutf_8, 1)); else @@ -10257,6 +10379,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 @@ -10306,7 +10482,7 @@ frame_parm_handler w32_frame_parm_handlers[] = gui_set_alpha, 0, /* x_set_sticky */ 0, /* x_set_tool_bar_position */ - 0, /* x_set_inhibit_double_buffering */ + w32_set_inhibit_double_buffering, w32_set_undecorated, w32_set_parent_frame, w32_set_skip_taskbar, @@ -10315,6 +10491,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 @@ -10606,21 +10783,6 @@ bass-down, bass-boost, bass-up, treble-down, treble-up */); doc: /* SKIP: real doc in xfns.c. */); Vx_pixel_size_width_font_regexp = Qnil; - DEFVAR_LISP ("w32-bdf-filename-alist", - Vw32_bdf_filename_alist, - doc: /* List of bdf fonts and their corresponding filenames. */); - Vw32_bdf_filename_alist = Qnil; - - DEFVAR_BOOL ("w32-strict-fontnames", - w32_strict_fontnames, - doc: /* Non-nil means only use fonts that are exact matches for those requested. -Default is nil, which allows old fontnames that are not XLFD compliant, -and allows third-party CJK display to work by specifying false charset -fields to trick Emacs into translating to Big5, SJIS etc. -Setting this to t will prevent wrong fonts being selected when -fontsets are automatically created. */); - w32_strict_fontnames = 0; - DEFVAR_BOOL ("w32-strict-painting", w32_strict_painting, doc: /* Non-nil means use strict rules for repainting frames. @@ -10710,7 +10872,6 @@ keys when IME input is received. */); /* W32 specific functions */ defsubr (&Sw32_define_rgb_color); - defsubr (&Sw32_default_color_map); defsubr (&Sw32_display_monitor_attributes_list); defsubr (&Sw32_send_sys_command); defsubr (&Sw32_shell_execute); @@ -11028,6 +11189,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 @@ -11049,6 +11241,12 @@ see `w32-ansi-code-page'. */); w32_multibyte_code_page = _getmbcp (); #endif + DEFVAR_BOOL ("w32-disable-double-buffering", w32_disable_double_buffering, + doc: /* Completely disable double buffering. +This variable is used for debugging, and takes precedence over any +value of the `inhibit-double-buffering' frame parameter. */); + w32_disable_double_buffering = false; + if (os_subtype == OS_SUBTYPE_NT) w32_unicode_gui = 1; else diff --git a/src/w32font.c b/src/w32font.c index 60f83a3ef6e..611a0c89658 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -1540,6 +1540,19 @@ add_font_entity_to_list (ENUMLOGFONTEX *logical_font, || physical_font->ntmFontSig.fsUsb[1] || physical_font->ntmFontSig.fsUsb[0] & 0x3fffffff; + /* Kludgey fix for Arial Unicode MS font that claims support for + scripts it doesn't actually cover. */ + if (strncmp (logical_font->elfLogFont.lfFaceName, + "Arial Unicode MS", 16) == 0) + { + /* Reset bits 4 (Phonetic), 12 (Vai), 14 (Nko), 27 (Balinese). */ + physical_font->ntmFontSig.fsUsb[0] &= 0xf7ffafef; + /* Reset bits 53 (Phags-pa) and 58 (Phoenician). */ + physical_font->ntmFontSig.fsUsb[1] &= 0xfbdfffff; + /* Set bit 70 (Tibetan). */ + physical_font->ntmFontSig.fsUsb[2] |= 0x00000040; + } + /* Skip non matching fonts. */ /* For uniscribe backend, consider only truetype or opentype fonts @@ -1974,10 +1987,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 +2002,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 +2015,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 +2398,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 +2673,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 +2840,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"); @@ -2834,18 +2847,18 @@ syms_of_w32font (void) DEFSYM (Qhanunoo, "hanunoo"); DEFSYM (Qkharoshthi, "kharoshthi"); DEFSYM (Qlimbu, "limbu"); - DEFSYM (Qlinear_b, "linear_b"); + DEFSYM (Qlinear_b, "linear-b"); DEFSYM (Qaegean_number, "aegean-number"); - DEFSYM (Qold_italic, "old_italic"); - DEFSYM (Qold_persian, "old_persian"); + DEFSYM (Qold_italic, "old-italic"); + DEFSYM (Qold_persian, "old-persian"); DEFSYM (Qosmanya, "osmanya"); DEFSYM (Qphags_pa, "phags-pa"); DEFSYM (Qphoenician, "phoenician"); DEFSYM (Qshavian, "shavian"); - DEFSYM (Qsyloti_nagri, "syloti_nagri"); + DEFSYM (Qsyloti_nagri, "syloti-nagri"); DEFSYM (Qtagalog, "tagalog"); DEFSYM (Qtagbanwa, "tagbanwa"); - DEFSYM (Qtai_le, "tai_le"); + DEFSYM (Qtai_le, "tai-le"); DEFSYM (Qtifinagh, "tifinagh"); DEFSYM (Qugaritic, "ugaritic"); DEFSYM (Qlycian, "lycian"); diff --git a/src/w32image.c b/src/w32image.c index f3374dcfd30..da748b8dab4 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. @@ -381,7 +382,7 @@ w32_select_active_frame (GpBitmap *pBitmap, int frame, int *nframes, static ARGB w32_image_bg_color (struct frame *f, struct image *img) { - Lisp_Object specified_bg = Fplist_get (XCDR (img->spec), QCbackground); + Lisp_Object specified_bg = plist_get (XCDR (img->spec), QCbackground); Emacs_Color color; /* If the user specified a color, try to use it; if not, use the @@ -434,7 +435,7 @@ w32_load_image (struct frame *f, struct image *img, if (status == Ok) { /* In multiframe pictures, select the first frame. */ - Lisp_Object lisp_index = Fplist_get (XCDR (img->spec), QCindex); + Lisp_Object lisp_index = plist_get (XCDR (img->spec), QCindex); int index = FIXNATP (lisp_index) ? XFIXNAT (lisp_index) : 0; int nframes; double delay; 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..b10239d5cc6 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 @@ -556,10 +556,8 @@ w32_menu_show (struct frame *f, int x, int y, int menuflags, HMENU menu; POINT pos; widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0; - widget_value **submenu_stack - = (widget_value **) alloca (menu_items_used * sizeof (widget_value *)); - Lisp_Object *subprefix_stack - = (Lisp_Object *) alloca (menu_items_used * word_size); + widget_value **submenu_stack; + Lisp_Object *subprefix_stack; int submenu_depth = 0; bool first_pane; @@ -574,6 +572,11 @@ w32_menu_show (struct frame *f, int x, int y, int menuflags, return Qnil; } + USE_SAFE_ALLOCA; + + submenu_stack = SAFE_ALLOCA (menu_items_used * sizeof (widget_value *)); + subprefix_stack = SAFE_ALLOCA (menu_items_used * word_size); + block_input (); /* Create a tree of widget_value objects @@ -587,7 +590,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 +782,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; @@ -816,6 +819,7 @@ w32_menu_show (struct frame *f, int x, int y, int menuflags, entry = Fcons (subprefix_stack[j], entry); } unblock_input (); + SAFE_FREE (); return entry; } i += MENU_ITEMS_ITEM_LENGTH; @@ -830,6 +834,7 @@ w32_menu_show (struct frame *f, int x, int y, int menuflags, } unblock_input (); + SAFE_FREE (); return Qnil; } diff --git a/src/w32notify.c b/src/w32notify.c index ccefecb6596..72e634f77c7 100644 --- a/src/w32notify.c +++ b/src/w32notify.c @@ -519,16 +519,16 @@ watched for some reason, this function signals a `file-error' error. FILTER is a list of conditions for reporting an event. It can include the following symbols: - 'file-name' -- report file creation, deletion, or renaming - 'directory-name' -- report directory creation, deletion, or renaming - 'attributes' -- report changes in attributes - 'size' -- report changes in file-size - 'last-write-time' -- report changes in last-write time - 'last-access-time' -- report changes in last-access time - 'creation-time' -- report changes in creation time - 'security-desc' -- report changes in security descriptor - -If FILE is a directory, and FILTER includes 'subtree', then all the + `file-name' -- report file creation, deletion, or renaming + `directory-name' -- report directory creation, deletion, or renaming + `attributes' -- report changes in attributes + `size' -- report changes in file-size + `last-write-time' -- report changes in last-write time + `last-access-time' -- report changes in last-access time + `creation-time' -- report changes in creation time + `security-desc' -- report changes in security descriptor + +If FILE is a directory, and FILTER includes `subtree', then all the subdirectories will also be watched and changes in them reported. When any event happens that satisfies the conditions specified by @@ -541,11 +541,11 @@ DESCRIPTOR is the same object as the one returned by this function. ACTION is the description of the event. It could be any one of the following: - 'added' -- FILE was added - 'removed' -- FILE was deleted - 'modified' -- FILE's contents or its attributes were modified - 'renamed-from' -- a file was renamed whose old name was FILE - 'renamed-to' -- a file was renamed and its new name is FILE + `added' -- FILE was added + `removed' -- FILE was deleted + `modified' -- FILE's contents or its attributes were modified + `renamed-from' -- a file was renamed whose old name was FILE + `renamed-to' -- a file was renamed and its new name is FILE FILE is the name of the file whose event is being reported. diff --git a/src/w32proc.c b/src/w32proc.c index 3a6504c9258..7acfba64d70 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -63,6 +63,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "w32term.h" #include "coding.h" +void w32_raise (int); + #define RVA_TO_PTR(var,section,filedata) \ ((void *)((section)->PointerToRawData \ + ((DWORD_PTR)(var) - (section)->VirtualAddress) \ @@ -311,6 +313,21 @@ sigismember (const sigset_t *set, int signo) return (*set & (1U << signo)) != 0; } +/* A fuller emulation of 'raise', which supports signals that MS + runtime doesn't know about. */ +void +w32_raise (int signo) +{ + if (!(signo == SIGCHLD || signo == SIGALRM || signo == SIGPROF)) + raise (signo); + + /* Call the handler directly for the signals that we handle + ourselves. */ + signal_handler handler = sig_handlers[signo]; + if (!(handler == SIG_DFL || handler == SIG_IGN || handler == SIG_ERR)) + handler (signo); +} + pid_t getpgrp (void) { @@ -1206,6 +1223,7 @@ static DWORD WINAPI reader_thread (void *arg) { child_process *cp; + int fd; /* Our identity */ cp = (child_process *)arg; @@ -1220,12 +1238,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 +1257,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 +1285,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/w32select.c b/src/w32select.c index eae1a0bac02..37206118127 100644 --- a/src/w32select.c +++ b/src/w32select.c @@ -631,7 +631,7 @@ validate_coding_system (Lisp_Object coding_system) eol_type = Fcoding_system_eol_type (coding_system); /* Already a DOS coding system? */ - if (EQ (eol_type, make_fixnum (1))) + if (BASE_EQ (eol_type, make_fixnum (1))) return coding_system; /* Get EOL_TYPE vector of the base of CODING_SYSTEM. */ diff --git a/src/w32term.c b/src/w32term.c index ae99d9948e6..d0577efccc1 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,75 @@ XGetGCValues (void *ignore, XGCValues *gc, #endif static void +w32_show_back_buffer (struct frame *f) +{ + struct w32_output *output; + HDC raw_dc; + + output = FRAME_OUTPUT_DATA (f); + + if (!output->want_paint_buffer || w32_disable_double_buffering) + return; + + enter_crit (); + + if (output->paint_buffer) + { + raw_dc = GetDC (output->window_desc); + + if (!raw_dc) + emacs_abort (); + + BitBlt (raw_dc, 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f), + output->paint_dc, 0, 0, SRCCOPY); + ReleaseDC (output->window_desc, raw_dc); + + output->paint_buffer_dirty = 0; + } + + leave_crit (); +} + +void +w32_release_paint_buffer (struct frame *f) +{ + /* Delete the back buffer so it gets created + again the next time we ask for the DC. */ + + enter_crit (); + if (FRAME_OUTPUT_DATA (f)->paint_buffer) + { + deselect_palette (f, FRAME_OUTPUT_DATA (f)->paint_buffer_handle); + + SelectObject (FRAME_OUTPUT_DATA (f)->paint_dc, + FRAME_OUTPUT_DATA (f)->paint_dc_object); + ReleaseDC (FRAME_OUTPUT_DATA (f)->window_desc, + FRAME_OUTPUT_DATA (f)->paint_buffer_handle); + DeleteDC (FRAME_OUTPUT_DATA (f)->paint_dc); + DeleteObject (FRAME_OUTPUT_DATA (f)->paint_buffer); + + FRAME_OUTPUT_DATA (f)->paint_buffer = NULL; + FRAME_OUTPUT_DATA (f)->paint_dc = NULL; + FRAME_OUTPUT_DATA (f)->paint_buffer_handle = NULL; + } + leave_crit (); +} + +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) @@ -687,10 +760,32 @@ w32_update_end (struct frame *f) static void w32_frame_up_to_date (struct frame *f) { - if (FRAME_W32_P (f)) - FRAME_MOUSE_UPDATE (f); + FRAME_MOUSE_UPDATE (f); + + if (!buffer_flipping_blocked_p () + && FRAME_OUTPUT_DATA (f)->paint_buffer_dirty) + w32_show_back_buffer (f); } +static void +w32_buffer_flipping_unblocked_hook (struct frame *f) +{ + if (FRAME_OUTPUT_DATA (f)->paint_buffer_dirty) + w32_show_back_buffer (f); +} + +/* Flip buffers on F if drawing has happened. This function is not + called to flush the display connection of a frame (which doesn't + exist on MS Windows), but also called in some situations in + minibuf.c to make the contents of the back buffer visible. */ +void +w32_flip_buffers_if_dirty (struct frame *f) +{ + if (FRAME_OUTPUT_DATA (f)->paint_buffer + && FRAME_OUTPUT_DATA (f)->paint_buffer_dirty + && !f->garbaged && !buffer_flipping_blocked_p ()) + w32_show_back_buffer (f); +} /* Draw truncation mark bitmaps, continuation mark bitmaps, overlay arrow bitmaps, or clear the fringes if no bitmaps are required @@ -967,22 +1062,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 +2631,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 +2655,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,12 +2682,13 @@ 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) || BASE_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)); + = !(NILP (val) || BASE_EQ (val, Qunbound)); /* Get the underline thickness. Default is 1 pixel. */ if (font && font->underline_thickness > 0) @@ -2609,7 +2697,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 +2717,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 explicitly 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 +2790,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; @@ -2859,8 +2950,9 @@ w32_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; + HDC hdc; HWND hwnd = FRAME_W32_WINDOW (f); - HRGN expect_dirty; + HRGN expect_dirty = NULL; /* Get frame-relative bounding box of the text display area of W, without mode lines. Include in this box the left and right @@ -2879,7 +2971,9 @@ w32_scroll_run (struct window *w, struct run *run) height = bottom_y - from_y; else height = run->height; - expect_dirty = CreateRectRgn (x, y + height, x + width, bottom_y); + + if (w32_disable_double_buffering) + expect_dirty = CreateRectRgn (x, y + height, x + width, bottom_y); } else { @@ -2889,44 +2983,55 @@ w32_scroll_run (struct window *w, struct run *run) height = bottom_y - to_y; else height = run->height; - expect_dirty = CreateRectRgn (x, y, x + width, to_y); + + if (w32_disable_double_buffering) + expect_dirty = CreateRectRgn (x, y, x + width, to_y); } block_input (); /* Cursor off. Will be switched on again in gui_update_window_end. */ gui_clear_cursor (w); - - { - RECT from; - RECT to; - HRGN dirty = CreateRectRgn (0, 0, 0, 0); - HRGN combined = CreateRectRgn (0, 0, 0, 0); - - from.left = to.left = x; - from.right = to.right = x + width; - from.top = from_y; - from.bottom = from_y + height; - to.top = y; - to.bottom = bottom_y; - - ScrollWindowEx (hwnd, 0, to_y - from_y, &from, &to, dirty, - NULL, SW_INVALIDATE); - - /* Combine this with what we expect to be dirty. This covers the - case where not all of the region we expect is actually dirty. */ - CombineRgn (combined, dirty, expect_dirty, RGN_OR); - - /* If the dirty region is not what we expected, redraw the entire frame. */ - if (!EqualRgn (combined, expect_dirty)) - SET_FRAME_GARBAGED (f); - - DeleteObject (dirty); - DeleteObject (combined); - } + if (!w32_disable_double_buffering) + { + hdc = get_frame_dc (f); + BitBlt (hdc, x, to_y, width, height, hdc, x, from_y, SRCCOPY); + release_frame_dc (f, hdc); + } + else + { + RECT from; + RECT to; + HRGN dirty = CreateRectRgn (0, 0, 0, 0); + HRGN combined = CreateRectRgn (0, 0, 0, 0); + + from.left = to.left = x; + from.right = to.right = x + width; + from.top = from_y; + from.bottom = from_y + height; + to.top = y; + to.bottom = bottom_y; + + ScrollWindowEx (hwnd, 0, to_y - from_y, &from, &to, dirty, + NULL, SW_INVALIDATE); + + /* Combine this with what we expect to be dirty. This covers the + case where not all of the region we expect is actually dirty. */ + CombineRgn (combined, dirty, expect_dirty, RGN_OR); + + /* If the dirty region is not what we expected, redraw the entire frame. */ + if (!EqualRgn (combined, expect_dirty)) + SET_FRAME_GARBAGED (f); + + DeleteObject (dirty); + DeleteObject (combined); + } unblock_input (); - DeleteObject (expect_dirty); + + if (w32_disable_double_buffering + && expect_dirty) + DeleteObject (expect_dirty); } @@ -3232,32 +3337,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; } @@ -4734,6 +4901,14 @@ w32_scroll_bar_clear (struct frame *f) { Lisp_Object bar; + /* Return if double buffering is enabled, since clearing a frame + actually clears just the back buffer, so avoid clearing all of + the scroll bars, since that causes the scroll bars to + flicker. */ + if (!w32_disable_double_buffering + && FRAME_OUTPUT_DATA (f)->want_paint_buffer) + return; + /* We can have scroll bars even if this is 0, if we just turned off scroll bar mode. But in that case we should not clear them. */ @@ -4849,10 +5024,17 @@ w32_read_socket (struct terminal *terminal, struct input_event inev; int do_help = 0; + /* WM_WINDOWPOSCHANGED makes the buffer dirty, but there's no + reason to flush the back buffer after receiving such an + event, and that also causes flicker. */ + bool ignore_dirty_back_buffer = false; + /* DebPrint (("w32_read_socket: %s time:%u\n", */ /* w32_name_of_message (msg.msg.message), */ /* msg.msg.time)); */ + f = NULL; + EVENT_INIT (inev); inev.kind = NO_EVENT; inev.arg = Qnil; @@ -4894,24 +5076,32 @@ w32_read_socket (struct terminal *terminal, } else { - /* Erase background again for safety. But don't do - that if the frame's 'garbaged' flag is set, since - in that case expose_frame will do nothing, and if - the various redisplay flags happen to be unset, - we are left with a blank frame. */ - if (!FRAME_GARBAGED_P (f) || FRAME_PARENT_FRAME (f)) + if (w32_disable_double_buffering + || !FRAME_OUTPUT_DATA (f)->paint_buffer) { - HDC hdc = get_frame_dc (f); - - w32_clear_rect (f, hdc, &msg.rect); - release_frame_dc (f, hdc); + /* Erase background again for safety. But don't do + that if the frame's 'garbaged' flag is set, since + in that case expose_frame will do nothing, and if + the various redisplay flags happen to be unset, + we are left with a blank frame. */ + + if (!FRAME_GARBAGED_P (f) || FRAME_PARENT_FRAME (f)) + { + HDC hdc = get_frame_dc (f); + + w32_clear_rect (f, hdc, &msg.rect); + release_frame_dc (f, hdc); + } + + expose_frame (f, + msg.rect.left, + msg.rect.top, + msg.rect.right - msg.rect.left, + msg.rect.bottom - msg.rect.top); + w32_clear_under_internal_border (f); } - expose_frame (f, - msg.rect.left, - msg.rect.top, - msg.rect.right - msg.rect.left, - msg.rect.bottom - msg.rect.top); - w32_clear_under_internal_border (f); + else + w32_show_back_buffer (f); } } break; @@ -4934,6 +5124,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); @@ -5237,7 +5435,18 @@ w32_read_socket (struct terminal *terminal, window = window_from_coordinates (f, x, y, 0, 1, 1); - if (EQ (window, f->tool_bar_window)) + if (EQ (window, f->tool_bar_window) + /* Make sure the tool bar was previously + pressed, otherwise an event that started + outside of the tool bar will not be handled + correctly when the mouse button is + released. For example, start dragging to + select some buffer text, drag the mouse to + the tool bar, and release the mouse button + -- this should not consider the release + event as a tool-bar click. */ + && (inev.modifiers & down_modifier + || f->last_tool_bar_item != -1)) { w32_handle_tool_bar_click (f, &inev); tool_bar_p = 1; @@ -5354,6 +5563,7 @@ w32_read_socket (struct terminal *terminal, case WM_WINDOWPOSCHANGED: f = w32_window_to_frame (dpyinfo, msg.msg.hwnd); + ignore_dirty_back_buffer = true; if (f) { @@ -5576,6 +5786,8 @@ w32_read_socket (struct terminal *terminal, if (width != FRAME_PIXEL_WIDTH (f) || height != FRAME_PIXEL_HEIGHT (f)) { + w32_release_paint_buffer (f); + change_frame_size (f, width, height, false, true, false); SET_FRAME_GARBAGED (f); @@ -5700,6 +5912,29 @@ w32_read_socket (struct terminal *terminal, (short) HIWORD (msg.msg.lParam))); } + /* According to the MS documentation, this message is sent + to each window whenever a monitor is added, removed, or + has its resolution change. Detect duplicate events when + there are multiple frames by ensuring only one event is + put in the keyboard buffer at any given time. */ + { + union buffered_input_event *ev; + + ev = (kbd_store_ptr == kbd_buffer + ? kbd_buffer + KBD_BUFFER_SIZE - 1 + : kbd_store_ptr - 1); + + if (kbd_store_ptr != kbd_fetch_ptr + && ev->ie.kind == MONITORS_CHANGED_EVENT + && XTERMINAL (ev->ie.arg) == dpyinfo->terminal) + /* Don't store a MONITORS_CHANGED_EVENT if there is + already an undelivered event on the queue. */ + break; + + inev.kind = MONITORS_CHANGED_EVENT; + XSETTERMINAL (inev.arg, dpyinfo->terminal); + } + check_visibility = 1; break; @@ -5757,6 +5992,15 @@ w32_read_socket (struct terminal *terminal, } count++; } + + /* Event processing might have drawn to F outside redisplay. If + that is the case, flush any changes that have been made to + the front buffer. */ + + if (f && !w32_disable_double_buffering + && FRAME_OUTPUT_DATA (f)->paint_buffer_dirty + && !f->garbaged && !ignore_dirty_back_buffer) + w32_show_back_buffer (f); } /* If the focus was just given to an autoraising frame, @@ -6971,6 +7215,9 @@ w32_free_frame_resources (struct frame *f) face. */ free_frame_faces (f); + /* Now release the back buffer if any exists. */ + w32_release_paint_buffer (f); + if (FRAME_W32_WINDOW (f)) my_destroy_window (f, FRAME_W32_WINDOW (f)); @@ -7267,6 +7514,7 @@ w32_create_terminal (struct w32_display_info *dpyinfo) terminal->update_end_hook = w32_update_end; terminal->read_socket_hook = w32_read_socket; terminal->frame_up_to_date_hook = w32_frame_up_to_date; + terminal->buffer_flipping_unblocked_hook = w32_buffer_flipping_unblocked_hook; terminal->defined_color_hook = w32_defined_color; terminal->query_frame_background_color = w32_query_frame_background_color; terminal->query_colors = w32_query_colors; @@ -7422,6 +7670,7 @@ w32_delete_display (struct w32_display_info *dpyinfo) if (dpyinfo->palette) DeleteObject (dpyinfo->palette); } + w32_reset_fringes (); } @@ -7551,6 +7800,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 +7910,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/w32term.h b/src/w32term.h index 6c48323651f..88b7ec22bd1 100644 --- a/src/w32term.h +++ b/src/w32term.h @@ -412,6 +412,27 @@ struct w32_output geometry when 'fullscreen' is reset to nil. */ WINDOWPLACEMENT normal_placement; int prev_fsmode; + + /* The back buffer if there is an ongoing double-buffered drawing + operation. */ + HBITMAP paint_buffer; + + /* The handle of the back buffer and a DC that ought to be released + alongside the back buffer. */ + HDC paint_dc, paint_buffer_handle; + + /* The object previously selected into `paint_dc'. */ + HGDIOBJ paint_dc_object; + + /* The width and height of `paint_buffer'. */ + int paint_buffer_width, paint_buffer_height; + + /* Whether or not some painting was done to this window that has not + yet been drawn. */ + unsigned paint_buffer_dirty : 1; + + /* Whether or not this frame should be double buffered. */ + unsigned want_paint_buffer : 1; }; extern struct w32_output w32term_display; @@ -876,6 +897,8 @@ typedef char guichar_t; extern Lisp_Object w32_popup_dialog (struct frame *, Lisp_Object, Lisp_Object); extern void w32_arrow_cursor (void); +extern void w32_release_paint_buffer (struct frame *); +extern void w32_flip_buffers_if_dirty (struct frame *); extern void syms_of_w32term (void); extern void syms_of_w32menu (void); diff --git a/src/w32xfns.c b/src/w32xfns.c index d5974b906e8..22d39ae0037 100644 --- a/src/w32xfns.c +++ b/src/w32xfns.c @@ -136,13 +136,13 @@ select_palette (struct frame *f, HDC hdc) f->output_data.w32->old_palette = NULL; if (RealizePalette (hdc) != GDI_ERROR) - { - Lisp_Object frame, framelist; - FOR_EACH_FRAME (framelist, frame) { - SET_FRAME_GARBAGED (XFRAME (frame)); + Lisp_Object frame, framelist; + FOR_EACH_FRAME (framelist, frame) + { + SET_FRAME_GARBAGED (XFRAME (frame)); + } } - } } void @@ -157,19 +157,70 @@ deselect_palette (struct frame *f, HDC hdc) HDC get_frame_dc (struct frame *f) { - HDC hdc; + HDC hdc, paint_dc; + HBITMAP back_buffer; + HGDIOBJ obj; + struct w32_output *output; if (f->output_method != output_w32) emacs_abort (); enter_crit (); + output = FRAME_OUTPUT_DATA (f); + + if (output->paint_dc) + { + if (output->paint_buffer_width != FRAME_PIXEL_WIDTH (f) + || output->paint_buffer_height != FRAME_PIXEL_HEIGHT (f) + || w32_disable_double_buffering) + w32_release_paint_buffer (f); + else + { + output->paint_buffer_dirty = 1; + return output->paint_dc; + } + } - hdc = GetDC (f->output_data.w32->window_desc); + hdc = GetDC (output->window_desc); /* If this gets called during startup before the frame is valid, there is a chance of corrupting random data or crashing. */ if (hdc) - select_palette (f, hdc); + { + select_palette (f, hdc); + + if (!w32_disable_double_buffering + && FRAME_OUTPUT_DATA (f)->want_paint_buffer) + { + back_buffer + = CreateCompatibleBitmap (hdc, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)); + + if (back_buffer) + { + paint_dc = CreateCompatibleDC (hdc); + + if (!paint_dc) + DeleteObject (back_buffer); + else + { + obj = SelectObject (paint_dc, back_buffer); + + output->paint_dc_object = obj; + output->paint_dc = paint_dc; + output->paint_buffer_handle = hdc; + output->paint_buffer = back_buffer; + output->paint_buffer_width = FRAME_PIXEL_WIDTH (f); + output->paint_buffer_height = FRAME_PIXEL_HEIGHT (f); + output->paint_buffer_dirty = 1; + + SET_FRAME_GARBAGED (f); + + return paint_dc; + } + } + } + } return hdc; } @@ -179,8 +230,15 @@ release_frame_dc (struct frame *f, HDC hdc) { int ret; - deselect_palette (f, hdc); - ret = ReleaseDC (f->output_data.w32->window_desc, hdc); + /* Avoid releasing the double-buffered DC here, since it'll be + released upon the next buffer flip instead. */ + if (hdc != FRAME_OUTPUT_DATA (f)->paint_dc) + { + deselect_palette (f, hdc); + ret = ReleaseDC (f->output_data.w32->window_desc, hdc); + } + else + ret = 0; leave_crit (); diff --git a/src/widget.c b/src/widget.c index c13ec504981..b125b4caeed 100644 --- a/src/widget.c +++ b/src/widget.c @@ -42,11 +42,13 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <X11/ShellP.h> #include "../lwlib/lwlib.h" -static void EmacsFrameInitialize (Widget request, Widget new, ArgList dum1, Cardinal *dum2); -static void EmacsFrameDestroy (Widget widget); -static void EmacsFrameRealize (Widget widget, XtValueMask *mask, XSetWindowAttributes *attrs); -static void EmacsFrameResize (Widget widget); -static XtGeometryResult EmacsFrameQueryGeometry (Widget widget, XtWidgetGeometry *request, XtWidgetGeometry *result); +static void EmacsFrameInitialize (Widget, Widget, ArgList, Cardinal *); +static void EmacsFrameDestroy (Widget); +static void EmacsFrameRealize (Widget, XtValueMask *, XSetWindowAttributes *); +static void EmacsFrameResize (Widget); +static void EmacsFrameExpose (Widget, XEvent *, Region); +static XtGeometryResult EmacsFrameQueryGeometry (Widget, XtWidgetGeometry *, + XtWidgetGeometry *); #define offset(field) offsetof (EmacsFrameRec, emacs_frame.field) @@ -118,12 +120,12 @@ static EmacsFrameClassRec emacsFrameClassRec = { /* resource_count */ XtNumber (resources), /* xrm_class */ NULLQUARK, /* compress_motion */ TRUE, - /* compress_exposure */ TRUE, + /* compress_exposure */ XtExposeNoCompress, /* compress_enterleave */ TRUE, /* visible_interest */ FALSE, /* destroy */ EmacsFrameDestroy, /* resize */ EmacsFrameResize, - /* expose */ XtInheritExpose, + /* expose */ EmacsFrameExpose, /* Emacs never does XtSetvalues on this widget, so we have no code for it. */ @@ -156,33 +158,41 @@ static void get_default_char_pixel_size (EmacsFrame ew, int *pixel_width, int *pixel_height) { struct frame *f = ew->emacs_frame.frame; + *pixel_width = FRAME_COLUMN_WIDTH (f); *pixel_height = FRAME_LINE_HEIGHT (f); } static void -pixel_to_char_size (EmacsFrame ew, Dimension pixel_width, Dimension pixel_height, int *char_width, int *char_height) +pixel_to_char_size (EmacsFrame ew, Dimension pixel_width, + Dimension pixel_height, int *char_width, int *char_height) { struct frame *f = ew->emacs_frame.frame; + *char_width = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, (int) pixel_width); *char_height = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, (int) pixel_height); } static void -char_to_pixel_size (EmacsFrame ew, int char_width, int char_height, Dimension *pixel_width, Dimension *pixel_height) +char_to_pixel_size (EmacsFrame ew, int char_width, int char_height, + Dimension *pixel_width, Dimension *pixel_height) { struct frame *f = ew->emacs_frame.frame; + *pixel_width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, char_width); *pixel_height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, char_height); } static void -round_size_to_char (EmacsFrame ew, Dimension in_width, Dimension in_height, Dimension *out_width, Dimension *out_height) +round_size_to_char (EmacsFrame ew, Dimension in_width, Dimension in_height, + Dimension *out_width, Dimension *out_height) { int char_width; int char_height; - pixel_to_char_size (ew, in_width, in_height, &char_width, &char_height); - char_to_pixel_size (ew, char_width, char_height, out_width, out_height); + pixel_to_char_size (ew, in_width, in_height, + &char_width, &char_height); + char_to_pixel_size (ew, char_width, char_height, + out_width, out_height); } static Widget @@ -260,9 +270,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 +281,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 +308,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 @@ -339,7 +344,8 @@ update_from_various_frame_slots (EmacsFrame ew) } static void -EmacsFrameInitialize (Widget request, Widget new, ArgList dum1, Cardinal *dum2) +EmacsFrameInitialize (Widget request, Widget new, + ArgList dum1, Cardinal *dum2) { EmacsFrame ew = (EmacsFrame) new; @@ -364,7 +370,8 @@ resize_cb (Widget widget, static void -EmacsFrameRealize (Widget widget, XtValueMask *mask, XSetWindowAttributes *attrs) +EmacsFrameRealize (Widget widget, XtValueMask *mask, + XSetWindowAttributes *attrs) { EmacsFrame ew = (EmacsFrame) widget; struct frame *f = ew->emacs_frame.frame; @@ -386,7 +393,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 @@ -408,9 +416,11 @@ EmacsFrameResize (Widget widget) ew->core.width, ew->core.height, f->new_width, f->new_height); - change_frame_size (f, ew->core.width, ew->core.height, false, true, false); + 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); @@ -465,6 +475,17 @@ EmacsFrameSetCharSize (Widget widget, int columns, int rows) rows * FRAME_LINE_HEIGHT (f)); } +static void +EmacsFrameExpose (Widget widget, XEvent *event, Region region) +{ + EmacsFrame ew = (EmacsFrame) widget; + struct frame *f = ew->emacs_frame.frame; + + expose_frame (f, event->xexpose.x, event->xexpose.y, + event->xexpose.width, event->xexpose.height); + flush_frame (f); +} + void widget_store_internal_border (Widget widget) 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 0cf6373e0b0..10373f8a2bf 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; @@ -1012,11 +1014,22 @@ WINDOW must be a valid window and defaults to the selected one. */) return make_fixnum (decode_valid_window (window)->top_line); } +static enum window_body_unit +window_body_unit_from_symbol (Lisp_Object unit) +{ + return + EQ (unit, Qremap) + ? WINDOW_BODY_IN_REMAPPED_CHARS + : (NILP (unit) + ? WINDOW_BODY_IN_CANONICAL_CHARS + : WINDOW_BODY_IN_PIXELS); +} + /* Return the number of lines/pixels of W's body. Don't count any mode or header line or horizontal divider of W. Rounds down to nearest integer when not working pixelwise. */ static int -window_body_height (struct window *w, bool pixelwise) +window_body_height (struct window *w, enum window_body_unit pixelwise) { int height = (w->pixel_height - WINDOW_TAB_LINE_HEIGHT (w) @@ -1027,11 +1040,27 @@ window_body_height (struct window *w, bool pixelwise) - WINDOW_MODE_LINE_HEIGHT (w) - WINDOW_BOTTOM_DIVIDER_WIDTH (w)); + int denom = 1; + if (pixelwise == WINDOW_BODY_IN_REMAPPED_CHARS) + { + if (!NILP (Vface_remapping_alist)) + { + struct frame *f = XFRAME (WINDOW_FRAME (w)); + int face_id = lookup_named_face (NULL, f, Qdefault, true); + struct face *face = FACE_FROM_ID_OR_NULL (f, face_id); + if (face && face->font && face->font->height) + denom = face->font->height; + } + /* For performance, use canonical chars if no face remapping. */ + else + pixelwise = WINDOW_BODY_IN_CANONICAL_CHARS; + } + + if (pixelwise == WINDOW_BODY_IN_CANONICAL_CHARS) + denom = FRAME_LINE_HEIGHT (WINDOW_XFRAME (w)); + /* Don't return a negative value. */ - return max (pixelwise - ? height - : height / FRAME_LINE_HEIGHT (WINDOW_XFRAME (w)), - 0); + return max (height / denom, 0); } /* Return the number of columns/pixels of W's body. Don't count columns @@ -1040,7 +1069,7 @@ window_body_height (struct window *w, bool pixelwise) fringes either. Round down to nearest integer when not working pixelwise. */ int -window_body_width (struct window *w, bool pixelwise) +window_body_width (struct window *w, enum window_body_unit pixelwise) { struct frame *f = XFRAME (WINDOW_FRAME (w)); @@ -1057,48 +1086,76 @@ window_body_width (struct window *w, bool pixelwise) ? WINDOW_FRINGES_WIDTH (w) : 0)); + int denom = 1; + if (pixelwise == WINDOW_BODY_IN_REMAPPED_CHARS) + { + if (!NILP (Vface_remapping_alist)) + { + int face_id = lookup_named_face (NULL, f, Qdefault, true); + struct face *face = FACE_FROM_ID_OR_NULL (f, face_id); + if (face && face->font) + { + if (face->font->average_width) + denom = face->font->average_width; + else if (face->font->space_width) + denom = face->font->space_width; + } + } + /* For performance, use canonical chars if no face remapping. */ + else + pixelwise = WINDOW_BODY_IN_CANONICAL_CHARS; + } + + if (pixelwise == WINDOW_BODY_IN_CANONICAL_CHARS) + denom = FRAME_COLUMN_WIDTH (WINDOW_XFRAME (w)); + /* Don't return a negative value. */ - return max (pixelwise - ? width - : width / FRAME_COLUMN_WIDTH (WINDOW_XFRAME (w)), - 0); + return max (width / denom, 0); } DEFUN ("window-body-width", Fwindow_body_width, Swindow_body_width, 0, 2, 0, doc: /* Return the width of WINDOW's text area. -WINDOW must be a live window and defaults to the selected one. Optional -argument PIXELWISE non-nil means return the width in pixels. The return -value does not include any vertical dividers, fringes or marginal areas, -or scroll bars. +WINDOW must be a live window and defaults to the selected one. The +return value does not include any vertical dividers, fringes or +marginal areas, or scroll bars. -If PIXELWISE is nil, return the largest integer smaller than WINDOW's -pixel width divided by the character width of WINDOW's frame. This -means that if a column at the right of the text area is only partially -visible, that column is not counted. +The optional argument PIXELWISE defines the units to use for the +width. If nil, return the largest integer smaller than WINDOW's pixel +width in units of the character width of WINDOW's frame. If PIXELWISE +is `remap' and the default face is remapped (see +`face-remapping-alist'), use the remapped face to determine the +character width. For any other non-nil value, return the width in +pixels. Note that the returned value includes the column reserved for the -continuation glyph. */) +continuation glyph. + +Also see `window-max-chars-per-line'. */) (Lisp_Object window, Lisp_Object pixelwise) { - return make_fixnum (window_body_width (decode_live_window (window), - !NILP (pixelwise))); + return (make_fixnum + (window_body_width (decode_live_window (window), + window_body_unit_from_symbol (pixelwise)))); } DEFUN ("window-body-height", Fwindow_body_height, Swindow_body_height, 0, 2, 0, doc: /* Return the height of WINDOW's text area. -WINDOW must be a live window and defaults to the selected one. Optional -argument PIXELWISE non-nil means return the height of WINDOW's text area -in pixels. The return value does not include the mode line or header -line or any horizontal divider. - -If PIXELWISE is nil, return the largest integer smaller than WINDOW's -pixel height divided by the character height of WINDOW's frame. This -means that if a line at the bottom of the text area is only partially -visible, that line is not counted. */) +WINDOW must be a live window and defaults to the selected one. The +return value does not include the mode line or header line or any +horizontal divider. + +The optional argument PIXELWISE defines the units to use for the +height. If nil, return the largest integer smaller than WINDOW's +pixel height in units of the character height of WINDOW's frame. If +PIXELWISE is `remap' and the default face is remapped (see +`face-remapping-alist'), use the remapped face to determine the +character height. For any other non-nil value, return the height in +pixels. */) (Lisp_Object window, Lisp_Object pixelwise) { - return make_fixnum (window_body_height (decode_live_window (window), - !NILP (pixelwise))); + return (make_fixnum + (window_body_height (decode_live_window (window), + window_body_unit_from_symbol (pixelwise)))); } DEFUN ("window-old-body-pixel-width", @@ -1690,6 +1747,14 @@ column 0. */) 0, false, false); } +ptrdiff_t +window_point (struct window *w) +{ + return (w == XWINDOW (selected_window) + ? BUF_PT (XBUFFER (w->contents)) + : XMARKER (w->pointm)->charpos); +} + DEFUN ("window-point", Fwindow_point, Swindow_point, 0, 1, 0, doc: /* Return current value of point in WINDOW. WINDOW must be a live window and defaults to the selected one. @@ -1703,12 +1768,7 @@ correct to return the top-level value of `point', outside of any `save-excursion' forms. But that is hard to define. */) (Lisp_Object window) { - register struct window *w = decode_live_window (window); - - if (w == XWINDOW (selected_window)) - return make_fixnum (BUF_PT (XBUFFER (w->contents))); - else - return Fmarker_position (w->pointm); + return make_fixnum (window_point (decode_live_window (window))); } DEFUN ("window-old-point", Fwindow_old_point, Swindow_old_point, 0, 1, 0, @@ -2117,7 +2177,8 @@ though when run from an idle timer with a delay of zero seconds. */) struct glyph_row *row, *end_row; int max_y = NILP (body) ? WINDOW_PIXEL_HEIGHT (w) : window_text_bottom_y (w); Lisp_Object rows = Qnil; - int window_width = NILP (body) ? w->pixel_width : window_body_width (w, true); + int window_width = NILP (body) + ? w->pixel_width : window_body_width (w, WINDOW_BODY_IN_PIXELS); int tab_line_height = WINDOW_TAB_LINE_HEIGHT (w); int header_line_height = WINDOW_HEADER_LINE_HEIGHT (w); int subtract = NILP (body) ? 0 : (tab_line_height + header_line_height); @@ -2585,7 +2646,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 @@ -2725,7 +2786,7 @@ decode_next_window_args (Lisp_Object *window, Lisp_Object *minibuf, Lisp_Object ? miniwin : Qnil); else if (EQ (*all_frames, Qvisible)) ; - else if (EQ (*all_frames, make_fixnum (0))) + else if (BASE_EQ (*all_frames, make_fixnum (0))) ; else if (FRAMEP (*all_frames)) ; @@ -2743,7 +2804,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); @@ -2897,7 +2958,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; @@ -3022,7 +3083,7 @@ window_loop (enum window_loop type, Lisp_Object obj, bool mini, if (f) frame_arg = Qlambda; - else if (EQ (frames, make_fixnum (0))) + else if (BASE_EQ (frames, make_fixnum (0))) frame_arg = frames; else if (EQ (frames, Qvisible)) frame_arg = frames; @@ -3190,14 +3251,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) @@ -3516,7 +3569,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); @@ -3549,7 +3602,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, @@ -3586,7 +3639,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); @@ -3658,8 +3711,10 @@ window_change_record_windows (Lisp_Object window, int stamp, ptrdiff_t number) wset_old_buffer (w, w->contents); w->old_pixel_width = w->pixel_width; w->old_pixel_height = w->pixel_height; - w->old_body_pixel_width = window_body_width (w, true); - w->old_body_pixel_height = window_body_height (w, true); + w->old_body_pixel_width + = window_body_width (w, WINDOW_BODY_IN_PIXELS); + w->old_body_pixel_height + = window_body_height (w, WINDOW_BODY_IN_PIXELS); } w = NILP (w->next) ? 0 : XWINDOW (w->next); @@ -3826,7 +3881,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); @@ -3904,8 +3959,10 @@ run_window_change_functions (void) && (window_buffer_change || w->pixel_width != w->old_pixel_width || w->pixel_height != w->old_pixel_height - || window_body_width (w, true) != w->old_body_pixel_width - || window_body_height (w, true) != w->old_body_pixel_height)); + || (window_body_width (w, WINDOW_BODY_IN_PIXELS) + != w->old_body_pixel_width) + || (window_body_height (w, WINDOW_BODY_IN_PIXELS) + != w->old_body_pixel_height))); /* The following two are needed when running the default values for this frame below. */ @@ -4023,7 +4080,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); @@ -4243,7 +4300,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); @@ -4769,7 +4826,8 @@ resize_frame_windows (struct frame *f, int size, bool horflag) Lisp_Object mini = f->minibuffer_window; struct window *m = WINDOWP (mini) ? XWINDOW (mini) : NULL; int mini_height = ((FRAME_HAS_MINIBUF_P (f) && !FRAME_MINIBUF_ONLY_P (f)) - ? unit + m->pixel_height - window_body_height (m, true) + ? (unit + m->pixel_height + - window_body_height (m, WINDOW_BODY_IN_PIXELS)) : 0); new_pixel_size = max (horflag ? size : size - mini_height, unit); @@ -5256,7 +5314,7 @@ void grow_mini_window (struct window *w, int delta) { struct frame *f = XFRAME (w->frame); - int old_height = window_body_height (w, true); + int old_height = window_body_height (w, WINDOW_BODY_IN_PIXELS); int min_height = FRAME_LINE_HEIGHT (f); eassert (MINI_WINDOW_P (w)); @@ -5290,7 +5348,8 @@ void shrink_mini_window (struct window *w) { struct frame *f = XFRAME (w->frame); - int delta = window_body_height (w, true) - FRAME_LINE_HEIGHT (f); + int delta = (window_body_height (w, WINDOW_BODY_IN_PIXELS) + - FRAME_LINE_HEIGHT (f)); eassert (MINI_WINDOW_P (w)); @@ -5497,7 +5556,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); @@ -5509,7 +5568,11 @@ window_scroll (Lisp_Object window, EMACS_INT n, bool whole, bool noerror) /* On GUI frames, use the pixel-based version which is much slower than the line-based one but can handle varying line heights. */ if (FRAME_WINDOW_P (XFRAME (XWINDOW (window)->frame))) - window_scroll_pixel_based (window, n, whole, noerror); + { + record_unwind_protect_void (unwind_display_working_on_window); + display_working_on_window_p = true; + window_scroll_pixel_based (window, n, whole, noerror); + } else window_scroll_line_based (window, n, whole, noerror); @@ -5637,7 +5700,8 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) if (w->vscroll < 0 && rtop > 0) { px = max (0, -w->vscroll - min (rtop, -dy)); - Fset_window_vscroll (window, make_fixnum (px), Qt); + Fset_window_vscroll (window, make_fixnum (px), Qt, + Qnil); return; } } @@ -5647,7 +5711,8 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) if (rbot > 0 && (w->vscroll < 0 || vpos == 0)) { px = max (0, -w->vscroll + min (rbot, dy)); - Fset_window_vscroll (window, make_fixnum (px), Qt); + Fset_window_vscroll (window, make_fixnum (px), Qt, + Qnil); return; } @@ -5656,7 +5721,8 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) { ptrdiff_t spos; - Fset_window_vscroll (window, make_fixnum (0), Qt); + Fset_window_vscroll (window, make_fixnum (0), Qt, + Qnil); /* If there are other text lines above the current row, move window start to current row. Else to next row. */ if (rbot > 0) @@ -5675,7 +5741,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) } } /* Cancel previous vscroll. */ - Fset_window_vscroll (window, make_fixnum (0), Qt); + Fset_window_vscroll (window, make_fixnum (0), Qt, Qnil); } itdata = bidi_shelve_cache (); @@ -5872,7 +5938,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) @@ -6222,7 +6289,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); @@ -6318,10 +6385,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)) @@ -6338,34 +6407,6 @@ followed by all visible frames on the current terminal. */) return window; } -DEFUN ("scroll-other-window", Fscroll_other_window, Sscroll_other_window, 0, 1, "P", - doc: /* Scroll next window upward ARG lines; or near full screen if no ARG. -A near full screen is `next-screen-context-lines' less than a full screen. -Negative ARG means scroll downward. If ARG is the atom `-', scroll -downward by nearly full screen. When calling from a program, supply -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. */) - (Lisp_Object arg) -{ - ptrdiff_t count = SPECPDL_INDEX (); - scroll_command (Fother_window_for_scrolling (), arg, 1); - return unbind_to (count, Qnil); -} - -DEFUN ("scroll-other-window-down", Fscroll_other_window_down, - Sscroll_other_window_down, 0, 1, "P", - doc: /* Scroll next window downward ARG lines; or near full screen if no ARG. -For more details, see the documentation for `scroll-other-window'. */) - (Lisp_Object arg) -{ - ptrdiff_t count = SPECPDL_INDEX (); - scroll_command (Fother_window_for_scrolling (), arg, -1); - return unbind_to (count, Qnil); -} DEFUN ("scroll-left", Fscroll_left, Sscroll_left, 0, 2, "^P\np", doc: /* Scroll selected window display ARG columns left. @@ -6379,9 +6420,10 @@ by this function. This happens in an interactive call. */) (register Lisp_Object arg, Lisp_Object set_minimum) { struct window *w = XWINDOW (selected_window); - EMACS_INT requested_arg = (NILP (arg) - ? window_body_width (w, 0) - 2 - : XFIXNUM (Fprefix_numeric_value (arg))); + EMACS_INT requested_arg = + (NILP (arg) + ? window_body_width (w, WINDOW_BODY_IN_CANONICAL_CHARS) - 2 + : XFIXNUM (Fprefix_numeric_value (arg))); Lisp_Object result = set_window_hscroll (w, w->hscroll + requested_arg); if (!NILP (set_minimum)) @@ -6404,9 +6446,10 @@ by this function. This happens in an interactive call. */) (register Lisp_Object arg, Lisp_Object set_minimum) { struct window *w = XWINDOW (selected_window); - EMACS_INT requested_arg = (NILP (arg) - ? window_body_width (w, 0) - 2 - : XFIXNUM (Fprefix_numeric_value (arg))); + EMACS_INT requested_arg = + (NILP (arg) + ? window_body_width (w, WINDOW_BODY_IN_CANONICAL_CHARS) - 2 + : XFIXNUM (Fprefix_numeric_value (arg))); Lisp_Object result = set_window_hscroll (w, w->hscroll - requested_arg); if (!NILP (set_minimum)) @@ -6457,9 +6500,14 @@ displayed_window_lines (struct window *w) CLIP_TEXT_POS_FROM_MARKER (start, w->start); itdata = bidi_shelve_cache (); + + specpdl_ref count = SPECPDL_INDEX (); + record_unwind_protect_void (unwind_display_working_on_window); + display_working_on_window_p = true; start_display (&it, w, start); move_it_vertically (&it, height); bottom_y = line_bottom_y (&it); + unbind_to (count, Qnil); bidi_unshelve_cache (itdata, false); /* Add in empty lines at the bottom of the window. */ @@ -6553,6 +6601,10 @@ and redisplay normally--don't erase and redraw the frame. */) data structures might not be set up yet then. */ if (!FRAME_INITIAL_P (XFRAME (w->frame))) { + specpdl_ref count = SPECPDL_INDEX (); + + record_unwind_protect_void (unwind_display_working_on_window); + display_working_on_window_p = true; if (center_p) { struct it it; @@ -6615,6 +6667,7 @@ and redisplay normally--don't erase and redraw the frame. */) if (h <= 0) { bidi_unshelve_cache (itdata, false); + unbind_to (count, Qnil); return Qnil; } @@ -6669,6 +6722,7 @@ and redisplay normally--don't erase and redraw the frame. */) bidi_unshelve_cache (itdata, false); } + unbind_to (count, Qnil); } else { @@ -6862,6 +6916,7 @@ struct saved_window Lisp_Object left_col, top_line, total_cols, total_lines; Lisp_Object normal_cols, normal_lines; Lisp_Object hscroll, min_hscroll, hscroll_whole, suspend_auto_hscroll; + Lisp_Object vscroll; Lisp_Object parent, prev; Lisp_Object start_at_line_beg; Lisp_Object display_table; @@ -7089,6 +7144,7 @@ the return value is nil. Otherwise the value is t. */) w->suspend_auto_hscroll = !NILP (p->suspend_auto_hscroll); w->min_hscroll = XFIXNAT (p->min_hscroll); w->hscroll_whole = XFIXNAT (p->hscroll_whole); + w->vscroll = -XFIXNAT (p->vscroll); wset_display_table (w, p->display_table); w->left_margin_cols = XFIXNUM (p->left_margin_cols); w->right_margin_cols = XFIXNUM (p->right_margin_cols); @@ -7243,7 +7299,7 @@ the return value is nil. Otherwise the value is t. */) do_switch_frame (NILP (dont_set_frame) ? data->selected_frame : old_frame - , 0, 0, Qnil); + , 0, Qnil); } FRAME_WINDOW_CHANGE (f) = true; @@ -7423,6 +7479,7 @@ save_window_save (Lisp_Object window, struct Lisp_Vector *vector, ptrdiff_t i) p->suspend_auto_hscroll = w->suspend_auto_hscroll ? Qt : Qnil; XSETFASTINT (p->min_hscroll, w->min_hscroll); XSETFASTINT (p->hscroll_whole, w->hscroll_whole); + XSETFASTINT (p->vscroll, -w->vscroll); p->display_table = w->display_table; p->left_margin_cols = make_fixnum (w->left_margin_cols); p->right_margin_cols = make_fixnum (w->right_margin_cols); @@ -7454,7 +7511,7 @@ save_window_save (Lisp_Object window, struct Lisp_Vector *vector, ptrdiff_t i) hare = XCDR (hare); tortoise = XCDR (tortoise); - if (EQ (hare, tortoise)) + if (BASE_EQ (hare, tortoise)) /* Reset Vwindow_persistent_parameters to Qnil. */ { Vwindow_persistent_parameters = Qnil; @@ -7970,7 +8027,7 @@ optional second arg PIXELS-P means value is measured in pixels. */) DEFUN ("set-window-vscroll", Fset_window_vscroll, Sset_window_vscroll, - 2, 3, 0, + 2, 4, 0, doc: /* Set amount by which WINDOW should be scrolled vertically to VSCROLL. This takes effect when displaying tall lines or images. @@ -7980,8 +8037,12 @@ optional third arg PIXELS-P non-nil means that VSCROLL is in pixels. If PIXELS-P is nil, VSCROLL may have to be rounded so that it corresponds to an integral number of pixels. The return value is the result of this rounding. -If PIXELS-P is non-nil, the return value is VSCROLL. */) - (Lisp_Object window, Lisp_Object vscroll, Lisp_Object pixels_p) +If PIXELS-P is non-nil, the return value is VSCROLL. + +PRESERVE-VSCROLL-P makes setting the start of WINDOW preserve the +vscroll if its start is "frozen" due to a resized mini-window. */) + (Lisp_Object window, Lisp_Object vscroll, Lisp_Object pixels_p, + Lisp_Object preserve_vscroll_p) { struct window *w = decode_live_window (window); struct frame *f = XFRAME (w->frame); @@ -8006,7 +8067,12 @@ If PIXELS-P is non-nil, the return value is VSCROLL. */) /* Prevent redisplay shortcuts. */ XBUFFER (w->contents)->prevent_redisplay_optimizations_p = true; + + /* Mark W for redisplay. (bug#55299) */ + wset_redisplay (w); } + + w->preserve_vscroll_p = !NILP (preserve_vscroll_p); } return Fwindow_vscroll (window, pixels_p); @@ -8135,11 +8201,11 @@ compare_window_configurations (Lisp_Object configuration1, return true; } -DEFUN ("compare-window-configurations", Fcompare_window_configurations, - Scompare_window_configurations, 2, 2, 0, - doc: /* Compare two window configurations as regards the structure of windows. -This function ignores details such as the values of point -and scrolling positions. */) +DEFUN ("window-configuration-equal-p", Fwindow_configuration_equal_p, + Swindow_configuration_equal_p, 2, 2, 0, + doc: /* Say whether two window configurations have the same window layout. +This function ignores details such as the values of point and +scrolling positions. */) (Lisp_Object x, Lisp_Object y) { if (compare_window_configurations (x, y)) @@ -8238,7 +8304,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"); @@ -8279,6 +8344,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; @@ -8338,7 +8411,10 @@ In this case the window is passed as argument. Functions specified by the default value are called for each frame if at least one window on that frame has been added or changed its buffer or its total or body size since the last redisplay. In this case the -frame is passed as argument. */); +frame is passed as argument. + +For instance, to hide the title bar when the frame is maximized, you +can add `frame-hide-title-bar-when-maximized' to this variable. */); Vwindow_size_change_functions = Qnil; DEFVAR_LISP ("window-selection-change-functions", Vwindow_selection_change_functions, @@ -8600,8 +8676,6 @@ displayed after a scrolling operation to be somewhat inaccurate. */); defsubr (&Sscroll_left); defsubr (&Sscroll_right); defsubr (&Sother_window_for_scrolling); - defsubr (&Sscroll_other_window); - defsubr (&Sscroll_other_window_down); defsubr (&Sminibuffer_selected_window); defsubr (&Srecenter); defsubr (&Swindow_text_width); @@ -8619,7 +8693,7 @@ displayed after a scrolling operation to be somewhat inaccurate. */); defsubr (&Swindow_scroll_bars); defsubr (&Swindow_vscroll); defsubr (&Sset_window_vscroll); - defsubr (&Scompare_window_configurations); + defsubr (&Swindow_configuration_equal_p); defsubr (&Swindow_bump_use_time); defsubr (&Swindow_list); defsubr (&Swindow_list_1); diff --git a/src/window.h b/src/window.h index af081fe25e9..298a80a5366 100644 --- a/src/window.h +++ b/src/window.h @@ -445,6 +445,10 @@ struct window window. */ bool_bf suspend_auto_hscroll : 1; + /* True if vscroll should be preserved while forcing the start due + to a frozen window. */ + bool_bf preserve_vscroll_p : 1; + /* Amount by which lines of this window are scrolled in y-direction (smooth scrolling). */ int vscroll; @@ -756,7 +760,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)) @@ -1182,16 +1186,22 @@ extern bool window_wants_mode_line (struct window *); extern bool window_wants_header_line (struct window *); extern bool window_wants_tab_line (struct window *); extern int window_internal_height (struct window *); -extern int window_body_width (struct window *w, bool); +enum window_body_unit + { + WINDOW_BODY_IN_CANONICAL_CHARS, + WINDOW_BODY_IN_PIXELS, + WINDOW_BODY_IN_REMAPPED_CHARS + }; +extern int window_body_width (struct window *w, enum window_body_unit); enum margin_unit { MARGIN_IN_LINES, MARGIN_IN_PIXELS }; 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 *); +extern ptrdiff_t window_point (struct window *w); extern void init_window_once (void); extern void init_window (void); extern void syms_of_window (void); diff --git a/src/xdisp.c b/src/xdisp.c index 9740e6b590e..f205327cc34 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) { @@ -833,7 +832,7 @@ void wset_redisplay (struct window *w) { /* Beware: selected_window can be nil during early stages. */ - if (!EQ (make_lisp_ptr (w, Lisp_Vectorlike), selected_window)) + if (!BASE_EQ (make_lisp_ptr (w, Lisp_Vectorlike), selected_window)) redisplay_other_windows (); w->redisplay = true; } @@ -1031,6 +1030,15 @@ static struct glyph_slice null_glyph_slice = { 0, 0, 0, 0 }; bool redisplaying_p; +/* True while some display-engine code is working on layout of some + window. + + WARNING: Use sparingly, preferably only in top level of commands + and important functions, because using it in nested calls might + reset the flag when the inner call returns, behind the back of + the callers. */ +bool display_working_on_window_p; + /* If a string, XTread_socket generates an event to display that string. (The display is done in read_char.) */ @@ -1179,7 +1187,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 +1290,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 +1696,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 +3007,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 +3151,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 +3201,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) @@ -3217,6 +3231,9 @@ init_iterator (struct it *it, struct window *w, it->cmp_it.id = -1; + if (max_redisplay_ticks > 0) + update_redisplay_ticks (0, w); + /* Extra space between lines (on window systems only). */ if (base_face_id == DEFAULT_FACE_ID && FRAME_WINDOW_P (it->f)) @@ -3979,6 +3996,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 +4013,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 +4323,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 +4518,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 +5175,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 +5377,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 +5445,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 +5563,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 +5640,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 +5679,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 +5837,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; } @@ -5702,7 +5906,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, location = tem; } - if (EQ (location, Qunbound)) + if (BASE_EQ (location, Qunbound)) { location = Qnil; value = spec; @@ -5810,7 +6014,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 +6844,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 +6877,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 +6909,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 +7410,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; } @@ -7972,6 +8187,9 @@ void set_iterator_to_next (struct it *it, bool reseat_p) { + if (max_redisplay_ticks > 0) + update_redisplay_ticks (1, it->w); + switch (it->method) { case GET_FROM_BUFFER: @@ -8990,7 +9208,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 +9925,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 +10880,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 +10920,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 +10961,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; @@ -10773,8 +10972,11 @@ include the height of any of these, if present, in the return value. */) max_y = XFIXNUM (y_limit); 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,54 +10985,94 @@ 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; - int start_x; - 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); - 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; + 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 { - start_x = it.current_x; - bidi_unshelve_cache (it1data, true); + 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_x = it.current_x; + { + /* 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 move_op = MOVE_TO_POS | MOVE_TO_Y; @@ -10871,8 +11113,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 @@ -10893,32 +11143,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); + + y = y + display_mode_line (w, TAB_LINE_FACE_ID, + NILP (window_tab_line_format) + ? BVAR (current_buffer, tab_line_format) + : window_tab_line_format); + } + + if ((EQ (mode_lines, Qheader_line) || EQ (mode_lines, Qt)) + && window_wants_header_line (w)) + { + Lisp_Object window_header_line_format + = window_parameter (w, Qheader_line_format); - 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, 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)) - /* Add height of mode-line as requested. */ - y = y + WINDOW_MODE_LINE_HEIGHT (w); + 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 Fcons (make_fixnum (x - start_x), make_fixnum (y)); + 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)); + + 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. */) @@ -11053,6 +11464,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)); @@ -11123,7 +11538,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); @@ -11578,7 +11993,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 (); @@ -11744,7 +12159,7 @@ setup_echo_area_for_printing (bool multibyte_p) { /* If we can't find an echo area any more, exit. */ if (! FRAME_LIVE_P (XFRAME (selected_frame))) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); ensure_echo_area_buffers (); @@ -11763,7 +12178,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); @@ -11831,7 +12246,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 @@ -12211,7 +12626,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); @@ -12282,18 +12697,23 @@ set_message_1 (void *a1, Lisp_Object string) void clear_message (bool current_p, bool last_displayed_p) { + Lisp_Object preserve = Qnil; + if (current_p) { - echo_area_buffer[0] = Qnil; - message_cleared_p = true; - 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); + preserve = safe_call (1, Vclear_message_function); unbind_to (count, Qnil); } + + if (!EQ (preserve, Qdont_clear_message)) + { + echo_area_buffer[0] = Qnil; + message_cleared_p = true; + } } if (last_displayed_p) @@ -12424,7 +12844,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 (); @@ -12744,7 +13164,7 @@ store_mode_line_noprop (const char *string, int field_width, int precision) Vicon_title_format if FRAME is iconified, otherwise it is frame_title_format. */ -static void +void gui_consider_frame_title (Lisp_Object frame) { struct frame *f = XFRAME (frame); @@ -12760,7 +13180,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) { @@ -12847,6 +13267,20 @@ gui_consider_frame_title (Lisp_Object frame) && (update_mode_lines == 0 \ || update_mode_lines == REDISPLAY_SOME)) +static bool +needs_no_redisplay (struct window *w) +{ + struct buffer *buffer = XBUFFER (w->contents); + struct frame *f = XFRAME (w->frame); + return (REDISPLAY_SOME_P () + && !w->redisplay + && !w->update_mode_line + && !f->face_change + && !f->redisplay + && !buffer->text->redisplay + && window_point (w) == w->last_point); +} + /* Prepare for redisplay by updating menu-bar item lists when appropriate. This can call eval. */ @@ -12868,13 +13302,8 @@ prepare_menu_bars (void) struct window *w = XWINDOW (this); /* Cf. conditions for redisplaying a window at the beginning of redisplay_window. */ - if (w->redisplay - || XFRAME (w->frame)->redisplay - || XBUFFER (w->contents)->text->redisplay - || BUF_PT (XBUFFER (w->contents)) != w->last_point) - { - windows = Fcons (this, windows); - } + if (!needs_no_redisplay (w)) + windows = Fcons (this, windows); } } safe__call1 (true, Vpre_redisplay_function, windows); @@ -12922,7 +13351,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; @@ -13019,7 +13448,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); @@ -13039,9 +13468,6 @@ update_menu_bar (struct frame *f, bool save_match_data, bool hooks_run) /* If it has changed current-menubar from previous value, really recompute the menu-bar from the value. */ - if (! NILP (Vlucid_menu_bar_dirty_flag)) - call0 (Qrecompute_lucid_menubar); - safe_run_hooks (Qmenu_bar_update_hook); hooks_run = true; @@ -13189,7 +13615,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; @@ -13425,6 +13851,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; @@ -13471,11 +13898,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:; @@ -13558,10 +13986,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); @@ -13610,6 +14034,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 @@ -13617,9 +14043,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); @@ -13687,10 +14120,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 @@ -13930,7 +14359,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, @@ -13943,7 +14371,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. */ @@ -14101,7 +14528,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; @@ -14264,7 +14691,7 @@ build_desired_tool_bar_string (struct frame *f) selected. */ if (selected_p) { - plist = Fplist_put (plist, QCrelief, make_fixnum (-relief)); + plist = plist_put (plist, QCrelief, make_fixnum (-relief)); hmargin -= relief; vmargin -= relief; } @@ -14274,10 +14701,10 @@ build_desired_tool_bar_string (struct frame *f) /* If image is selected, display it pressed, i.e. with a negative relief. If it's not selected, display it with a raised relief. */ - plist = Fplist_put (plist, QCrelief, - (selected_p - ? make_fixnum (-relief) - : make_fixnum (relief))); + plist = plist_put (plist, QCrelief, + (selected_p + ? make_fixnum (-relief) + : make_fixnum (relief))); hmargin -= relief; vmargin -= relief; } @@ -14286,18 +14713,18 @@ build_desired_tool_bar_string (struct frame *f) if (hmargin || vmargin) { if (hmargin == vmargin) - plist = Fplist_put (plist, QCmargin, make_fixnum (hmargin)); + plist = plist_put (plist, QCmargin, make_fixnum (hmargin)); else - plist = Fplist_put (plist, QCmargin, - Fcons (make_fixnum (hmargin), - make_fixnum (vmargin))); + plist = plist_put (plist, QCmargin, + Fcons (make_fixnum (hmargin), + make_fixnum (vmargin))); } /* If button is not enabled, and we don't have special images for the disabled state, make the image appear disabled by applying an appropriate algorithm to it. */ if (!enabled_p && idx < 0) - plist = Fplist_put (plist, QCconversion, Qdisabled); + plist = plist_put (plist, QCconversion, Qdisabled); /* Put a `display' text property on the string for the image to display. Put a `menu-item' property on the string that gives @@ -14535,6 +14962,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 @@ -14542,9 +14971,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); @@ -14761,11 +15197,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); @@ -14822,11 +15258,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 @@ -15643,7 +16086,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; @@ -15690,9 +16132,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. */ @@ -15701,7 +16146,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 (); @@ -16063,7 +16508,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; @@ -16291,9 +16737,14 @@ redisplay_internal (void) list_of_error, redisplay_window_error); if (update_miniwindow_p) - internal_condition_case_1 (redisplay_window_1, - FRAME_MINIBUF_WINDOW (sf), list_of_error, - redisplay_window_error); + { + Lisp_Object mini_window = FRAME_MINIBUF_WINDOW (sf); + + displayed_buffer = XBUFFER (XWINDOW (mini_window)->contents); + internal_condition_case_1 (redisplay_window_1, mini_window, + list_of_error, + redisplay_window_error); + } /* Compare desired and current matrices, perform output. */ @@ -16471,6 +16922,11 @@ redisplay_internal (void) if (interrupt_input && interrupts_deferred) request_sigio (); + /* We're done with this redisplay cycle, so reset the tick count in + preparation for the next redisplay cycle. */ + if (max_redisplay_ticks > 0) + update_redisplay_ticks (0, NULL); + unbind_to (count, Qnil); RESUME_POLLING; } @@ -16498,7 +16954,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 (); @@ -16528,6 +16984,13 @@ unwind_redisplay (void) unblock_buffer_flips (); } +/* Function registered with record_unwind_protect before calling + start_display outside of redisplay_internal. */ +void +unwind_display_working_on_window (void) +{ + display_working_on_window_p = false; +} /* Mark the display of leaf window W as accurate or inaccurate. If ACCURATE_P, mark display of W as accurate. @@ -16574,6 +17037,7 @@ mark_window_display_accurate_1 (struct window *w, bool accurate_p) w->window_end_valid = true; w->update_mode_line = false; + w->preserve_vscroll_p = false; } w->redisplay = !accurate_p; @@ -16701,9 +17165,19 @@ redisplay_windows (Lisp_Object window) } static Lisp_Object -redisplay_window_error (Lisp_Object ignore) +redisplay_window_error (Lisp_Object error_data) { displayed_buffer->display_error_modiff = BUF_MODIFF (displayed_buffer); + + /* When in redisplay, the error is captured and not shown. Arrange + for it to be shown later. */ + if (max_redisplay_ticks > 0 + && CONSP (error_data) + && EQ (XCAR (error_data), Qerror) + && STRINGP (XCAR (XCDR (error_data)))) + Vdelayed_warnings_list = Fcons (list2 (XCAR (error_data), + XCAR (XCDR (error_data))), + Vdelayed_warnings_list); return Qnil; } @@ -16722,6 +17196,73 @@ redisplay_window_1 (Lisp_Object window) redisplay_window (window, true); return Qnil; } + + +/*********************************************************************** + Aborting runaway redisplay + ***********************************************************************/ + +/* Update the redisplay-tick count for window W, and signal an error + if the tick count is above some threshold, indicating that + redisplay of the window takes "too long". + + TICKS is the amount of ticks to add to the W's current count; zero + means to initialize the tick count to zero. + + W can be NULL if TICKS is zero: that means unconditionally + re-initialize the current tick count to zero. + + W can also be NULL if the caller doesn't know which window is being + processed by the display code. In that case, if TICKS is non-zero, + we assume it's the last window that shows the current buffer. */ +void +update_redisplay_ticks (int ticks, struct window *w) +{ + /* This keeps track of the window on which redisplay is working. */ + static struct window *cwindow; + static EMACS_INT window_ticks; + + /* We only initialize the count if this is a different window or + NULL. Otherwise, this is a call from init_iterator for the same + window we tracked before, and we should keep the count. */ + if (!ticks && w != cwindow) + { + cwindow = w; + window_ticks = 0; + } + /* Some callers can be run in contexts unrelated to display code, so + don't abort them and don't update the tick count in those cases. */ + if ((!w && !redisplaying_p && !display_working_on_window_p) + /* We never disable redisplay of a mini-window, since that is + absolutely essential for communicating with Emacs. */ + || (w && MINI_WINDOW_P (w))) + return; + + if (ticks > 0) + window_ticks += ticks; + if (max_redisplay_ticks > 0 && window_ticks > max_redisplay_ticks) + { + /* In addition to a buffer, this could be a window (for non-leaf + windows, not expected here) or nil (for pseudo-windows like + the one used for the native tool bar). */ + Lisp_Object contents = w ? w->contents : Qnil; + char *bufname = + NILP (contents) + ? SSDATA (BVAR (current_buffer, name)) + : (BUFFERP (contents) + ? SSDATA (BVAR (XBUFFER (contents), name)) + : (char *) "<unknown>"); + + windows_or_buffers_changed = 177; + /* scrolling_window depends too much on the glyph matrices being + correct, and we cannot guarantee that if we abort the + redisplay of this window. */ + if (w && w->desired_matrix) + w->desired_matrix->no_scrolling_p = true; + error ("Window showing buffer %s takes too long to redisplay", bufname); + } +} + /* Set cursor position of W. PT is assumed to be displayed in ROW. @@ -17372,7 +17913,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))); @@ -17418,7 +17959,7 @@ cursor_row_fully_visible_p (struct window *w, bool force_p, buffer_local_value (Qmake_cursor_line_fully_visible, w->contents); /* If no local binding, use the global value. */ - if (EQ (mclfv_p, Qunbound)) + if (BASE_EQ (mclfv_p, Qunbound)) mclfv_p = Vmake_cursor_line_fully_visible; /* Follow mode sets the variable to a Lisp function in buffers that are under Follow mode. */ @@ -17867,7 +18408,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))) { @@ -18248,6 +18789,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) { @@ -18397,6 +18952,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. @@ -18466,7 +19048,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; @@ -18482,14 +19064,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) *w->desired_matrix->method = 0; #endif - if (!just_this_one_p - && REDISPLAY_SOME_P () - && !w->redisplay - && !w->update_mode_line - && !f->face_change - && !f->redisplay - && !buffer->text->redisplay - && BUF_PT (buffer) == w->last_point) + if (!just_this_one_p && needs_no_redisplay (w)) return; /* Make sure that both W's markers are valid. */ @@ -18560,6 +19135,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; @@ -18701,7 +19277,14 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) int new_vpos = -1; w->force_start = false; - w->vscroll = 0; + + /* The vscroll should be preserved in this case, since + `pixel-scroll-precision-mode' must continue working normally + when a mini-window is resized. (bug#55312) */ + if (!w->preserve_vscroll_p || !window_frozen_p (w)) + w->vscroll = 0; + + w->preserve_vscroll_p = false; w->window_end_valid = false; /* Forget any recorded base line for line number display. */ @@ -18728,6 +19311,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, @@ -18834,7 +19422,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), @@ -18884,6 +19473,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.) */ @@ -18905,10 +19496,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"); @@ -18984,6 +19579,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 @@ -19389,7 +19995,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); @@ -20583,6 +21189,12 @@ try_window_id (struct window *w) w->frame)))) GIVE_UP (24); + /* composition-break-at-point is incompatible with the optimizations + in this function, because we need to recompose characters when + point moves off their positions. */ + if (composition_break_at_point) + GIVE_UP (27); + /* Make sure beg_unchanged and end_unchanged are up to date. Do it only if buffer has really changed. The reason is that the gap is initially at Z for freshly visited files. The code below would @@ -21973,6 +22585,13 @@ compute_line_metrics (struct it *it) } +static void +clear_position (struct it *it) +{ + it->position.charpos = 0; + it->position.bytepos = 0; +} + /* Append one space to the glyph row of iterator IT if doing a window-based redisplay. The space has the same face as IT->face_id. Value is true if a space was added. @@ -22008,7 +22627,7 @@ append_space_for_newline (struct it *it, bool default_face_p) struct face *face; it->what = IT_CHARACTER; - memset (&it->position, 0, sizeof it->position); + clear_position (it); it->object = Qnil; it->len = 1; @@ -22209,7 +22828,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 @@ -22234,7 +22853,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 @@ -22337,7 +22956,7 @@ extend_face_to_end_of_line (struct it *it) const int stretch_width = indicator_column - it->current_x - char_width; - memset (&it->position, 0, sizeof it->position); + clear_position (it); /* Only generate a stretch glyph if there is distance between current_x and the indicator position. */ @@ -22371,7 +22990,7 @@ extend_face_to_end_of_line (struct it *it) if (stretch_width > 0) { - memset (&it->position, 0, sizeof it->position); + clear_position (it); append_stretch_glyph (it, Qnil, stretch_width, it->ascent + it->descent, stretch_ascent); @@ -22421,7 +23040,7 @@ extend_face_to_end_of_line (struct it *it) (((it->ascent + it->descent) * FONT_BASE (font)) / FONT_HEIGHT (font)); saved_pos = it->position; - memset (&it->position, 0, sizeof it->position); + clear_position (it); saved_avoid_cursor = it->avoid_cursor_p; it->avoid_cursor_p = true; saved_face_id = it->face_id; @@ -22459,7 +23078,7 @@ extend_face_to_end_of_line (struct it *it) enum display_element_type saved_what = it->what; it->what = IT_CHARACTER; - memset (&it->position, 0, sizeof it->position); + clear_position (it); it->object = Qnil; it->c = it->char_to_display = ' '; it->len = 1; @@ -22468,7 +23087,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]; @@ -22539,7 +23158,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]; @@ -23107,7 +23726,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); @@ -23133,7 +23752,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) { @@ -23561,7 +24180,7 @@ display_line (struct it *it, int cursor_vpos) row->displays_text_p = true; row->starts_in_middle_of_char_p = it->starts_in_middle_of_char_p; it->starts_in_middle_of_char_p = false; - it->tab_offset = 0; + it->stretch_adjust = 0; it->line_number_produced_p = false; /* Arrange the overlays nicely for our purposes. Usually, we call @@ -24556,31 +25175,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; @@ -24677,10 +25311,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); @@ -25279,6 +25912,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; @@ -25289,6 +25927,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); @@ -25548,7 +26191,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); @@ -25589,7 +26232,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); @@ -25628,18 +26272,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. @@ -25863,8 +26507,8 @@ display_mode_element (struct it *it, int depth, int field_width, int precision, tem = props; while (CONSP (tem)) { - oprops = Fplist_put (oprops, XCAR (tem), - XCAR (XCDR (tem))); + oprops = plist_put (oprops, XCAR (tem), + XCAR (XCDR (tem))); tem = XCDR (XCDR (tem)); } props = oprops; @@ -26315,13 +26959,13 @@ store_mode_line_string (const char *string, Lisp_Object lisp_string, props = mode_line_string_face_prop; else if (!NILP (mode_line_string_face)) { - Lisp_Object face = Fplist_get (props, Qface); + Lisp_Object face = plist_get (props, Qface); props = Fcopy_sequence (props); if (NILP (face)) face = mode_line_string_face; else face = list2 (face, mode_line_string_face); - props = Fplist_put (props, Qface, face); + props = plist_put (props, Qface, face); } Fadd_text_properties (make_fixnum (0), make_fixnum (len), props, lisp_string); @@ -26340,7 +26984,7 @@ store_mode_line_string (const char *string, Lisp_Object lisp_string, Lisp_Object face; if (NILP (props)) props = Ftext_properties_at (make_fixnum (0), lisp_string); - face = Fplist_get (props, Qface); + face = plist_get (props, Qface); if (NILP (face)) face = mode_line_string_face; else @@ -26404,7 +27048,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; @@ -26425,8 +27069,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 @@ -27117,7 +27761,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; @@ -27380,6 +28024,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 = plist_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 @@ -27709,6 +28368,11 @@ static bool calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop, struct font *font, bool width_p, int *align_to) { + /* Don't adjust for line number if we didn't yet produce it for this + screen line. This is for when this function is called from + move_it_in_display_line_to that was called by display_line to get + past the glyphs hscrolled off the left side of the window. */ + int lnum_pixel_width = it->line_number_produced_p ? it->lnum_pixel_width : 0; double pixels; # define OK_PIXELS(val) (*res = (val), true) @@ -27765,7 +28429,7 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop, if (EQ (prop, Qtext)) return OK_PIXELS (width_p ? (window_box_width (it->w, TEXT_AREA) - - it->lnum_pixel_width) + - lnum_pixel_width) : WINDOW_BOX_HEIGHT_NO_MODE_LINE (it->w)); /* ':align_to'. First time we compute the value, window @@ -27777,14 +28441,14 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop, /* 'left': left edge of the text area. */ if (EQ (prop, Qleft)) return OK_ALIGN_TO (window_box_left_offset (it->w, TEXT_AREA) - + it->lnum_pixel_width); + + lnum_pixel_width); /* 'right': right edge of the text area. */ if (EQ (prop, Qright)) return OK_ALIGN_TO (window_box_right_offset (it->w, TEXT_AREA)); /* 'center': the center of the text area. */ if (EQ (prop, Qcenter)) return OK_ALIGN_TO (window_box_left_offset (it->w, TEXT_AREA) - + it->lnum_pixel_width + + lnum_pixel_width + window_box_width (it->w, TEXT_AREA) / 2); /* 'left-fringe': left edge of the left fringe. */ if (EQ (prop, Qleft_fringe)) @@ -27827,7 +28491,7 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop, } prop = buffer_local_value (prop, it->w->contents); - if (EQ (prop, Qunbound)) + if (BASE_EQ (prop, Qunbound)) prop = Qnil; } @@ -27837,7 +28501,7 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop, ? FRAME_COLUMN_WIDTH (it->f) : FRAME_LINE_HEIGHT (it->f)); if (width_p && align_to && *align_to < 0) - return OK_PIXELS (XFLOATINT (prop) * base_unit + it->lnum_pixel_width); + return OK_PIXELS (XFLOATINT (prop) * base_unit + lnum_pixel_width); return OK_PIXELS (XFLOATINT (prop) * base_unit); } @@ -27890,16 +28554,16 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop, } car = buffer_local_value (car, it->w->contents); - if (EQ (car, Qunbound)) + if (BASE_EQ (car, Qunbound)) car = Qnil; } /* '(NUM)': absolute number of pixels. */ if (NUMBERP (car)) -{ + { double fact; int offset = - width_p && align_to && *align_to < 0 ? it->lnum_pixel_width : 0; + width_p && align_to && *align_to < 0 ? lnum_pixel_width : 0; pixels = XFLOATINT (car); if (NILP (cdr)) return OK_PIXELS (pixels + offset); @@ -28208,6 +28872,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; @@ -28244,7 +28924,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 @@ -28300,6 +28993,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++; @@ -28363,6 +29068,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 @@ -28392,6 +29113,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. */ @@ -28406,9 +29139,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. @@ -28431,6 +29176,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; @@ -28487,6 +29244,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)) { @@ -28678,7 +29436,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) @@ -28700,7 +29463,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 + } } @@ -29249,7 +30034,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 @@ -29268,7 +30052,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. */ @@ -29601,6 +30384,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) @@ -29777,7 +30562,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) { @@ -29947,20 +30732,21 @@ produce_stretch_glyph (struct it *it) plist = XCDR (it->object); /* Compute the width of the stretch. */ - if ((prop = Fplist_get (plist, QCwidth), !NILP (prop)) + if ((prop = plist_get (plist, QCwidth), !NILP (prop)) && calc_pixel_width_or_height (&tem, it, prop, font, true, NULL)) { /* Absolute width `:width WIDTH' specified and valid. */ zero_width_ok_p = true; width = (int)tem; } - else if (prop = Fplist_get (plist, QCrelative_width), NUMVAL (prop) > 0) + else if (prop = plist_get (plist, QCrelative_width), NUMVAL (prop) > 0) { /* Relative width `:relative-width FACTOR' specified and valid. 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))); @@ -29990,17 +30776,43 @@ produce_stretch_glyph (struct it *it) PRODUCE_GLYPHS (&it2); width = NUMVAL (prop) * it2.pixel_width; } - else if ((prop = Fplist_get (plist, QCalign_to), !NILP (prop)) + else if ((prop = plist_get (plist, QCalign_to), !NILP (prop)) && calc_pixel_width_or_height (&tem, it, prop, font, true, &align_to)) { + int x = it->current_x + it->continuation_lines_width; + int x0 = x; + /* Adjust for line numbers, if needed. */ + if (!NILP (Vdisplay_line_numbers) && it->line_number_produced_p) + { + x -= it->lnum_pixel_width; + /* Restore the original width, if required. */ + if (x + it->stretch_adjust >= it->first_visible_x) + x += it->stretch_adjust; + } + if (it->glyph_row == NULL || !it->glyph_row->mode_line_p) align_to = (align_to < 0 ? 0 : align_to - window_box_left_offset (it->w, TEXT_AREA)); else if (align_to < 0) align_to = window_box_left_offset (it->w, TEXT_AREA); - width = max (0, (int)tem + align_to - it->current_x); + width = max (0, (int)tem + align_to - x); + + int next_x = x + width; + if (!NILP (Vdisplay_line_numbers) && it->line_number_produced_p) + { + /* If the line is hscrolled, and the stretch starts before + the first visible pixel, simulate negative row->x. */ + if (x < it->first_visible_x) + { + next_x -= it->first_visible_x - x; + it->stretch_adjust = it->first_visible_x - x; + } + else + next_x -= it->stretch_adjust; + } + width = next_x - x0; zero_width_ok_p = true; } else @@ -30016,13 +30828,13 @@ produce_stretch_glyph (struct it *it) { int default_height = normal_char_height (font, ' '); - if ((prop = Fplist_get (plist, QCheight), !NILP (prop)) + if ((prop = plist_get (plist, QCheight), !NILP (prop)) && calc_pixel_width_or_height (&tem, it, prop, font, false, NULL)) { height = (int)tem; zero_height_ok_p = true; } - else if (prop = Fplist_get (plist, QCrelative_height), + else if (prop = plist_get (plist, QCrelative_height), NUMVAL (prop) > 0) height = default_height * NUMVAL (prop); else @@ -30034,7 +30846,7 @@ produce_stretch_glyph (struct it *it) /* Compute percentage of height used for ascent. If `:ascent ASCENT' is present and valid, use that. Otherwise, derive the ascent from the font in use. */ - if (prop = Fplist_get (plist, QCascent), + if (prop = plist_get (plist, QCascent), NUMVAL (prop) > 0 && NUMVAL (prop) <= 100) ascent = height * NUMVAL (prop) / 100.0; else if (!NILP (prop) @@ -30062,7 +30874,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)) @@ -30789,8 +31602,8 @@ gui_produce_glyphs (struct it *it) { x -= it->lnum_pixel_width; /* Restore the original TAB width, if required. */ - if (x + it->tab_offset >= it->first_visible_x) - x += it->tab_offset; + if (x + it->stretch_adjust >= it->first_visible_x) + x += it->stretch_adjust; } int next_tab_x = ((1 + x + tab_width - 1) / tab_width) * tab_width; @@ -30808,10 +31621,10 @@ gui_produce_glyphs (struct it *it) if (x < it->first_visible_x) { next_tab_x -= it->first_visible_x - x; - it->tab_offset = it->first_visible_x - x; + it->stretch_adjust = it->first_visible_x - x; } else - next_tab_x -= it->tab_offset; + next_tab_x -= it->stretch_adjust; } it->pixel_width = next_tab_x - x0; @@ -30877,6 +31690,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) { @@ -31357,14 +32175,16 @@ gui_insert_glyphs (struct window *w, struct glyph_row *updated_row, void gui_clear_end_of_line (struct window *w, struct glyph_row *updated_row, - enum glyph_row_area updated_area, int to_x) + enum glyph_row_area updated_area, int to_x) { struct frame *f; int max_x, min_y, max_y; int from_x, from_y, to_y; + struct face *face; eassert (updated_row); f = XFRAME (w->frame); + face = FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID); if (updated_row->full_width_p) max_x = (WINDOW_PIXEL_WIDTH (w) @@ -31416,6 +32236,9 @@ gui_clear_end_of_line (struct window *w, struct glyph_row *updated_row, block_input (); FRAME_RIF (f)->clear_frame_area (f, from_x, from_y, to_x - from_x, to_y - from_y); + + if (face && !updated_row->stipple_p) + updated_row->stipple_p = face->stipple; unblock_input (); } } @@ -31916,6 +32739,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) { @@ -31966,7 +32803,7 @@ display_and_set_cursor (struct window *w, bool on, { struct frame *f = XFRAME (w->frame); int new_cursor_type; - int new_cursor_width; + int new_cursor_width UNINIT; bool active_cursor; struct glyph_row *glyph_row; struct glyph *glyph; @@ -32187,6 +33024,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); @@ -32260,6 +33100,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 @@ -32269,6 +33118,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 @@ -32280,7 +33130,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 */ } @@ -33236,7 +34090,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)) @@ -33338,7 +34193,7 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, if (IMAGEP (object)) { Lisp_Object image_map, hotspot; - if ((image_map = Fplist_get (XCDR (object), QCmap), + if ((image_map = plist_get (XCDR (object), QCmap), !NILP (image_map)) && (hotspot = find_hot_spot (image_map, dx, dy), CONSP (hotspot)) @@ -33353,10 +34208,10 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, if (CONSP (hotspot) && (plist = XCAR (hotspot), CONSP (plist))) { - pointer = Fplist_get (plist, Qpointer); + pointer = plist_get (plist, Qpointer); if (NILP (pointer)) pointer = Qhand; - help = Fplist_get (plist, Qhelp_echo); + help = plist_get (plist, Qhelp_echo); if (!NILP (help)) { help_echo_string = help; @@ -33367,7 +34222,7 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, } } if (NILP (pointer)) - pointer = Fplist_get (XCDR (object), QCpointer); + pointer = plist_get (XCDR (object), QCpointer); } #endif /* HAVE_WINDOW_SYSTEM */ @@ -33621,11 +34476,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; @@ -33848,7 +34708,7 @@ note_mouse_highlight (struct frame *f, int x, int y) if (img != NULL && IMAGEP (img->spec)) { Lisp_Object image_map, hotspot; - if ((image_map = Fplist_get (XCDR (img->spec), QCmap), + if ((image_map = plist_get (XCDR (img->spec), QCmap), !NILP (image_map)) && (hotspot = find_hot_spot (image_map, glyph->slice.img.x + dx, @@ -33866,10 +34726,10 @@ note_mouse_highlight (struct frame *f, int x, int y) if (CONSP (hotspot) && (plist = XCAR (hotspot), CONSP (plist))) { - pointer = Fplist_get (plist, Qpointer); + pointer = plist_get (plist, Qpointer); if (NILP (pointer)) pointer = Qhand; - help_echo_string = Fplist_get (plist, Qhelp_echo); + help_echo_string = plist_get (plist, Qhelp_echo); if (!NILP (help_echo_string)) { help_echo_window = window; @@ -33879,7 +34739,7 @@ note_mouse_highlight (struct frame *f, int x, int y) } } if (NILP (pointer)) - pointer = Fplist_get (XCDR (img->spec), QCpointer); + pointer = plist_get (XCDR (img->spec), QCpointer); } } #endif /* HAVE_WINDOW_SYSTEM */ @@ -34953,9 +35813,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"); @@ -35051,6 +35913,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"); @@ -35058,7 +35921,7 @@ be let-bound around code that needs to disable messages temporarily. */); DEFSYM (Qinhibit_free_realized_faces, "inhibit-free-realized-faces"); - list_of_error = list1 (list2 (Qerror, Qvoid_variable)); + list_of_error = list1 (Qerror); staticpro (&list_of_error); /* Values of those variables at last redisplay are stored as @@ -35081,8 +35944,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); @@ -35423,6 +36291,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. @@ -35520,7 +36394,7 @@ they return to their normal size when the minibuffer is closed, or the echo area becomes empty. This variable does not affect resizing of the minibuffer window of -minibuffer-only frames. These are handled by 'resize-mini-frames' +minibuffer-only frames. These are handled by `resize-mini-frames' only. */); /* Contrary to the doc string, we initialize this to nil, so that loading loadup.el won't try to resize windows before loading @@ -35744,7 +36618,7 @@ see biditest.el in the test suite. */); doc: /* Non-nil means inhibit the Bidirectional Parentheses Algorithm. Disabling the BPA makes redisplay faster, but might produce incorrect display reordering of bidirectional text with embedded parentheses and -other bracket characters whose 'paired-bracket' Unicode property is +other bracket characters whose `paired-bracket' Unicode property is non-nil, see `get-char-code-property'. */); bidi_inhibit_bpa = false; @@ -35855,20 +36729,30 @@ message displayed by this function), and `command-error-function' (which controls how error messages are displayed). */); Vset_message_function = Qnil; + DEFSYM (Qdont_clear_message, "dont-clear-message"); DEFVAR_LISP ("clear-message-function", Vclear_message_function, doc: /* If non-nil, function to clear echo-area messages. Usually this function is called when the next input event arrives. -The function is called without arguments. It is expected to clear the -message displayed by its counterpart function specified by -`set-message-function'. */); +It is expected to clear the message displayed by its counterpart +function specified by `set-message-function'. + +The function is called without arguments. + +If this function returns a value that isn't `dont-clear-message', the +message is cleared from the echo area as usual. If this function +returns `dont-clear-message', this means that the message was already +handled, and the original message text will not be cleared from the +echo area. */); 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, @@ -35894,10 +36778,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", @@ -35920,6 +36805,28 @@ 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; + + DEFVAR_INT ("max-redisplay-ticks", max_redisplay_ticks, + doc: /* Maximum number of redisplay ticks before aborting redisplay of a window. + +This allows to abort the display of a window if the amount of low-level +redisplay operations exceeds the value of this variable. When display of +a window is aborted due to this reason, the buffer shown in that window +will not have its windows redisplayed until the buffer is modified or until +you type \\[recenter-top-bottom] with one of its windows selected. +You can also decide to kill the buffer and visit it in some +other way, like under `so-long-mode' or literally. + +The default value is zero, which disables this feature. +The recommended non-zero value is between 100000 and 1000000, +depending on your patience and the speed of your system. */); + max_redisplay_ticks = 0; } @@ -36072,4 +36979,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 14555b4f18a..bbc1d352c6e 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" @@ -287,6 +295,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #define IGNORE_DEFFACE_P(ATTR) EQ ((ATTR), QCignore_defface) +/* True if face attribute ATTR is `reset'. */ + +#define RESET_P(ATTR) EQ ((ATTR), Qreset) + /* Size of hash table of realized faces in face caches (should be a prime number). */ @@ -467,7 +479,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 +504,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 +567,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 +587,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 +892,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 +1453,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 @@ -1592,7 +1583,15 @@ the face font sort order, see `face-font-selection-order'. */) make_fixnum (point), FONT_WEIGHT_SYMBOLIC (font), FONT_SLANT_SYMBOLIC (font), - NILP (spacing) || EQ (spacing, Qp) ? Qnil : Qt, + (NILP (spacing) + || EQ (spacing, Qp) + /* If the font was specified in a way + different from XLFD (e.g., on MS-Windows), + we will have a number there, not 'p'. */ + || BASE_EQ (spacing, + make_fixnum + (FONT_SPACING_PROPORTIONAL))) + ? Qnil : Qt, Ffont_xlfd_name (font, Qnil), AREF (font, FONT_REGISTRY_INDEX)); result = Fcons (v, result); @@ -1762,57 +1761,72 @@ check_lface_attrs (Lisp_Object attrs[LFACE_VECTOR_SIZE]) { eassert (UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX]) || IGNORE_DEFFACE_P (attrs[LFACE_FAMILY_INDEX]) + || RESET_P (attrs[LFACE_FAMILY_INDEX]) || STRINGP (attrs[LFACE_FAMILY_INDEX])); eassert (UNSPECIFIEDP (attrs[LFACE_FOUNDRY_INDEX]) || IGNORE_DEFFACE_P (attrs[LFACE_FOUNDRY_INDEX]) + || RESET_P (attrs[LFACE_FOUNDRY_INDEX]) || STRINGP (attrs[LFACE_FOUNDRY_INDEX])); eassert (UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX]) || IGNORE_DEFFACE_P (attrs[LFACE_SWIDTH_INDEX]) + || RESET_P (attrs[LFACE_SWIDTH_INDEX]) || SYMBOLP (attrs[LFACE_SWIDTH_INDEX])); eassert (UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX]) || IGNORE_DEFFACE_P (attrs[LFACE_HEIGHT_INDEX]) + || RESET_P (attrs[LFACE_HEIGHT_INDEX]) || NUMBERP (attrs[LFACE_HEIGHT_INDEX]) || FUNCTIONP (attrs[LFACE_HEIGHT_INDEX])); eassert (UNSPECIFIEDP (attrs[LFACE_WEIGHT_INDEX]) || IGNORE_DEFFACE_P (attrs[LFACE_WEIGHT_INDEX]) + || RESET_P (attrs[LFACE_WEIGHT_INDEX]) || SYMBOLP (attrs[LFACE_WEIGHT_INDEX])); eassert (UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX]) || IGNORE_DEFFACE_P (attrs[LFACE_SLANT_INDEX]) + || RESET_P (attrs[LFACE_SLANT_INDEX]) || SYMBOLP (attrs[LFACE_SLANT_INDEX])); eassert (UNSPECIFIEDP (attrs[LFACE_UNDERLINE_INDEX]) || IGNORE_DEFFACE_P (attrs[LFACE_UNDERLINE_INDEX]) + || RESET_P (attrs[LFACE_UNDERLINE_INDEX]) || SYMBOLP (attrs[LFACE_UNDERLINE_INDEX]) || STRINGP (attrs[LFACE_UNDERLINE_INDEX]) || CONSP (attrs[LFACE_UNDERLINE_INDEX])); eassert (UNSPECIFIEDP (attrs[LFACE_EXTEND_INDEX]) || IGNORE_DEFFACE_P (attrs[LFACE_EXTEND_INDEX]) + || RESET_P (attrs[LFACE_EXTEND_INDEX]) || SYMBOLP (attrs[LFACE_EXTEND_INDEX]) || STRINGP (attrs[LFACE_EXTEND_INDEX])); eassert (UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX]) || IGNORE_DEFFACE_P (attrs[LFACE_OVERLINE_INDEX]) + || RESET_P (attrs[LFACE_OVERLINE_INDEX]) || SYMBOLP (attrs[LFACE_OVERLINE_INDEX]) || STRINGP (attrs[LFACE_OVERLINE_INDEX])); eassert (UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX]) || IGNORE_DEFFACE_P (attrs[LFACE_STRIKE_THROUGH_INDEX]) + || RESET_P (attrs[LFACE_STRIKE_THROUGH_INDEX]) || SYMBOLP (attrs[LFACE_STRIKE_THROUGH_INDEX]) || STRINGP (attrs[LFACE_STRIKE_THROUGH_INDEX])); eassert (UNSPECIFIEDP (attrs[LFACE_BOX_INDEX]) || IGNORE_DEFFACE_P (attrs[LFACE_BOX_INDEX]) + || RESET_P (attrs[LFACE_BOX_INDEX]) || SYMBOLP (attrs[LFACE_BOX_INDEX]) || STRINGP (attrs[LFACE_BOX_INDEX]) || FIXNUMP (attrs[LFACE_BOX_INDEX]) || CONSP (attrs[LFACE_BOX_INDEX])); eassert (UNSPECIFIEDP (attrs[LFACE_INVERSE_INDEX]) || IGNORE_DEFFACE_P (attrs[LFACE_INVERSE_INDEX]) + || RESET_P (attrs[LFACE_INVERSE_INDEX]) || SYMBOLP (attrs[LFACE_INVERSE_INDEX])); eassert (UNSPECIFIEDP (attrs[LFACE_FOREGROUND_INDEX]) || IGNORE_DEFFACE_P (attrs[LFACE_FOREGROUND_INDEX]) + || RESET_P (attrs[LFACE_FOREGROUND_INDEX]) || STRINGP (attrs[LFACE_FOREGROUND_INDEX])); eassert (UNSPECIFIEDP (attrs[LFACE_DISTANT_FOREGROUND_INDEX]) || IGNORE_DEFFACE_P (attrs[LFACE_DISTANT_FOREGROUND_INDEX]) + || RESET_P (attrs[LFACE_DISTANT_FOREGROUND_INDEX]) || STRINGP (attrs[LFACE_DISTANT_FOREGROUND_INDEX])); eassert (UNSPECIFIEDP (attrs[LFACE_BACKGROUND_INDEX]) || IGNORE_DEFFACE_P (attrs[LFACE_BACKGROUND_INDEX]) + || RESET_P (attrs[LFACE_BACKGROUND_INDEX]) || STRINGP (attrs[LFACE_BACKGROUND_INDEX])); eassert (UNSPECIFIEDP (attrs[LFACE_INHERIT_INDEX]) || IGNORE_DEFFACE_P (attrs[LFACE_INHERIT_INDEX]) @@ -1822,13 +1836,16 @@ check_lface_attrs (Lisp_Object attrs[LFACE_VECTOR_SIZE]) #ifdef HAVE_WINDOW_SYSTEM eassert (UNSPECIFIEDP (attrs[LFACE_STIPPLE_INDEX]) || IGNORE_DEFFACE_P (attrs[LFACE_STIPPLE_INDEX]) + || RESET_P (attrs[LFACE_STIPPLE_INDEX]) || SYMBOLP (attrs[LFACE_STIPPLE_INDEX]) || !NILP (Fbitmap_spec_p (attrs[LFACE_STIPPLE_INDEX]))); eassert (UNSPECIFIEDP (attrs[LFACE_FONT_INDEX]) || IGNORE_DEFFACE_P (attrs[LFACE_FONT_INDEX]) + || RESET_P (attrs[LFACE_FONT_INDEX]) || FONTP (attrs[LFACE_FONT_INDEX])); eassert (UNSPECIFIEDP (attrs[LFACE_FONTSET_INDEX]) || STRINGP (attrs[LFACE_FONTSET_INDEX]) + || RESET_P (attrs[LFACE_FONTSET_INDEX]) || NILP (attrs[LFACE_FONTSET_INDEX])); #endif } @@ -1948,7 +1965,7 @@ resolve_face_name (Lisp_Object face_name, bool signal_p) break; tortoise = Fget (tortoise, Qface_alias); - if (EQ (hare, tortoise)) + if (BASE_EQ (hare, tortoise)) { if (signal_p) circular_list (orig_face); @@ -2088,7 +2105,7 @@ lface_fully_specified_p (Lisp_Object attrs[LFACE_VECTOR_SIZE]) #ifdef HAVE_WINDOW_SYSTEM /* Set font-related attributes of Lisp face LFACE from FONT-OBJECT. - If FORCE_P, set only unspecified attributes of LFACE. The + If FORCE_P is zero, set only unspecified attributes of LFACE. The exception is `font' attribute. It is set to FONT_OBJECT regardless of FORCE_P. */ @@ -2344,6 +2361,14 @@ merge_named_face (struct window *w, Lisp_Object from[LFACE_VECTOR_SIZE], val; bool ok = get_lface_attributes (w, f, face_name, from, false, named_merge_points); + if (ok && !EQ (face_name, Qdefault)) + { + struct face *deflt = FACE_FROM_ID (f, DEFAULT_FACE_ID); + int i; + for (i = 1; i < LFACE_VECTOR_SIZE; i++) + if (EQ (from[i], Qreset)) + from[i] = deflt->lface[i]; + } if (ok && (attr_filter == 0 /* No filter. */ || (!NILP (from[attr_filter]) /* Filter, but specified. */ @@ -3092,7 +3117,9 @@ FRAME 0 means change the face on all frames, and change the default if (EQ (attr, QCfamily)) { - if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) + if (!UNSPECIFIEDP (value) + && !IGNORE_DEFFACE_P (value) + && !RESET_P (value)) { CHECK_STRING (value); if (SCHARS (value) == 0) @@ -3104,7 +3131,9 @@ FRAME 0 means change the face on all frames, and change the default } else if (EQ (attr, QCfoundry)) { - if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) + if (!UNSPECIFIEDP (value) + && !IGNORE_DEFFACE_P (value) + && !RESET_P (value)) { CHECK_STRING (value); if (SCHARS (value) == 0) @@ -3116,7 +3145,9 @@ FRAME 0 means change the face on all frames, and change the default } else if (EQ (attr, QCheight)) { - if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) + if (!UNSPECIFIEDP (value) + && !IGNORE_DEFFACE_P (value) + && !RESET_P (value)) { if (EQ (face, Qdefault)) { @@ -3144,7 +3175,9 @@ FRAME 0 means change the face on all frames, and change the default } else if (EQ (attr, QCweight)) { - if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) + if (!UNSPECIFIEDP (value) + && !IGNORE_DEFFACE_P (value) + && !RESET_P (value)) { CHECK_SYMBOL (value); if (FONT_WEIGHT_NAME_NUMERIC (value) < 0) @@ -3156,7 +3189,9 @@ FRAME 0 means change the face on all frames, and change the default } else if (EQ (attr, QCslant)) { - if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) + if (!UNSPECIFIEDP (value) + && !IGNORE_DEFFACE_P (value) + && !RESET_P (value)) { CHECK_SYMBOL (value); if (FONT_SLANT_NAME_NUMERIC (value) < 0) @@ -3170,7 +3205,7 @@ FRAME 0 means change the face on all frames, and change the default { bool valid_p = false; - if (UNSPECIFIEDP (value) || IGNORE_DEFFACE_P (value)) + if (UNSPECIFIEDP (value) || IGNORE_DEFFACE_P (value) || RESET_P (value)) valid_p = true; else if (NILP (value) || EQ (value, Qt)) valid_p = true; @@ -3189,14 +3224,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; @@ -3227,7 +3263,9 @@ FRAME 0 means change the face on all frames, and change the default } else if (EQ (attr, QCoverline)) { - if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) + if (!UNSPECIFIEDP (value) + && !IGNORE_DEFFACE_P (value) + && !RESET_P (value)) if ((SYMBOLP (value) && !EQ (value, Qt) && !NILP (value)) @@ -3241,7 +3279,9 @@ FRAME 0 means change the face on all frames, and change the default } else if (EQ (attr, QCstrike_through)) { - if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) + if (!UNSPECIFIEDP (value) + && !IGNORE_DEFFACE_P (value) + && !RESET_P (value)) if ((SYMBOLP (value) && !EQ (value, Qt) && !NILP (value)) @@ -3262,7 +3302,7 @@ FRAME 0 means change the face on all frames, and change the default if (EQ (value, Qt)) value = make_fixnum (1); - if (UNSPECIFIEDP (value) || IGNORE_DEFFACE_P (value)) + if (UNSPECIFIEDP (value) || IGNORE_DEFFACE_P (value) || RESET_P (value)) valid_p = true; else if (NILP (value)) valid_p = true; @@ -3324,7 +3364,9 @@ FRAME 0 means change the face on all frames, and change the default else if (EQ (attr, QCinverse_video) || EQ (attr, QCreverse_video)) { - if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) + if (!UNSPECIFIEDP (value) + && !IGNORE_DEFFACE_P (value) + && !RESET_P (value)) { CHECK_SYMBOL (value); if (!EQ (value, Qt) && !NILP (value)) @@ -3335,7 +3377,9 @@ FRAME 0 means change the face on all frames, and change the default } else if (EQ (attr, QCextend)) { - if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) + if (!UNSPECIFIEDP (value) + && !IGNORE_DEFFACE_P (value) + && !RESET_P (value)) { CHECK_SYMBOL (value); if (!EQ (value, Qt) && !NILP (value)) @@ -3349,7 +3393,9 @@ FRAME 0 means change the face on all frames, and change the default /* Compatibility with 20.x. */ if (NILP (value)) value = Qunspecified; - if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) + if (!UNSPECIFIEDP (value) + && !IGNORE_DEFFACE_P (value) + && !RESET_P (value)) { /* Don't check for valid color names here because it depends on the frame (display) whether the color will be valid @@ -3366,7 +3412,9 @@ FRAME 0 means change the face on all frames, and change the default /* Compatibility with 20.x. */ if (NILP (value)) value = Qunspecified; - if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) + if (!UNSPECIFIEDP (value) + && !IGNORE_DEFFACE_P (value) + && !RESET_P (value)) { /* Don't check for valid color names here because it depends on the frame (display) whether the color will be valid @@ -3383,7 +3431,9 @@ FRAME 0 means change the face on all frames, and change the default /* Compatibility with 20.x. */ if (NILP (value)) value = Qunspecified; - if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) + if (!UNSPECIFIEDP (value) + && !IGNORE_DEFFACE_P (value) + && !RESET_P (value)) { /* Don't check for valid color names here because it depends on the frame (display) whether the color will be valid @@ -3398,7 +3448,9 @@ FRAME 0 means change the face on all frames, and change the default else if (EQ (attr, QCstipple)) { #if defined (HAVE_WINDOW_SYSTEM) - if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value) + if (!UNSPECIFIEDP (value) + && !IGNORE_DEFFACE_P (value) + && !RESET_P (value) && !NILP (value) && NILP (Fbitmap_spec_p (value))) signal_error ("Invalid stipple attribute", value); @@ -3408,7 +3460,9 @@ FRAME 0 means change the face on all frames, and change the default } else if (EQ (attr, QCwidth)) { - if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) + if (!UNSPECIFIEDP (value) + && !IGNORE_DEFFACE_P (value) + && !RESET_P (value)) { CHECK_SYMBOL (value); if (FONT_WIDTH_NAME_NUMERIC (value) < 0) @@ -3423,7 +3477,9 @@ FRAME 0 means change the face on all frames, and change the default #ifdef HAVE_WINDOW_SYSTEM if (EQ (frame, Qt) || FRAME_WINDOW_P (f)) { - if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) + if (!UNSPECIFIEDP (value) + && !IGNORE_DEFFACE_P (value) + && !RESET_P (value)) { struct frame *f1; @@ -3480,12 +3536,15 @@ FRAME 0 means change the face on all frames, and change the default #ifdef HAVE_WINDOW_SYSTEM if (EQ (frame, Qt) || FRAME_WINDOW_P (f)) { - Lisp_Object tmp; + Lisp_Object tmp = value; old_value = LFACE_FONTSET (lface); - tmp = Fquery_fontset (value, Qnil); - if (NILP (tmp)) - signal_error ("Invalid fontset name", value); + if (!RESET_P (value)) + { + tmp = Fquery_fontset (value, Qnil); + if (NILP (tmp)) + signal_error ("Invalid fontset name", value); + } ASET (lface, LFACE_FONTSET_INDEX, value = tmp); } #endif /* HAVE_WINDOW_SYSTEM */ @@ -3507,14 +3566,20 @@ FRAME 0 means change the face on all frames, and change the default else if (EQ (attr, QCbold)) { old_value = LFACE_WEIGHT (lface); - ASET (lface, LFACE_WEIGHT_INDEX, NILP (value) ? Qnormal : Qbold); + if (RESET_P (value)) + ASET (lface, LFACE_WEIGHT_INDEX, value); + else + ASET (lface, LFACE_WEIGHT_INDEX, NILP (value) ? Qnormal : Qbold); prop_index = FONT_WEIGHT_INDEX; } else if (EQ (attr, QCitalic)) { attr = QCslant; old_value = LFACE_SLANT (lface); - ASET (lface, LFACE_SLANT_INDEX, NILP (value) ? Qnormal : Qitalic); + if (RESET_P (value)) + ASET (lface, LFACE_SLANT_INDEX, value); + else + ASET (lface, LFACE_SLANT_INDEX, NILP (value) ? Qnormal : Qitalic); prop_index = FONT_SLANT_INDEX; } else @@ -4124,6 +4189,7 @@ Default face attributes override any local face attributes. */) /* Ensure that the face vector is fully specified by merging the previously-cached vector. */ memcpy (attrs, oldface->lface, sizeof attrs); + merge_face_vectors (NULL, f, lvec, attrs, 0); vcopy (local_lface, 0, attrs, LFACE_VECTOR_SIZE); newface = realize_face (c, lvec, DEFAULT_FACE_ID); @@ -4452,17 +4518,26 @@ free_realized_face (struct frame *f, struct face *face) void prepare_face_for_display (struct frame *f, struct face *face) { + Emacs_GC egc; + unsigned long mask; + eassert (FRAME_WINDOW_P (f)); if (face->gc == 0) { - Emacs_GC egc; - unsigned long mask = GCForeground | GCBackground | GCGraphicsExposures; + mask = GCForeground | GCBackground | GCGraphicsExposures; egc.foreground = face->foreground; egc.background = face->background; #ifdef HAVE_X_WINDOWS egc.graphics_exposures = False; + + /* While this was historically slower than a line_width of 0, + the difference no longer matters on modern X servers, so set + it to 1 in order for PolyLine requests to behave consistently + everywhere. */ + mask |= GCLineWidth; + egc.line_width = 1; #endif block_input (); @@ -4881,6 +4956,13 @@ lookup_named_face (struct window *w, struct frame *f, return -1; memcpy (attrs, default_face->lface, sizeof attrs); + + /* Make explicit any attributes whose value is 'reset'. */ + int i; + for (i = 1; i < LFACE_VECTOR_SIZE; i++) + if (EQ (symbol_attrs[i], Qreset)) + symbol_attrs[i] = attrs[i]; + merge_face_vectors (w, f, symbol_attrs, attrs, 0); return lookup_face (f, attrs); @@ -4889,7 +4971,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. */ @@ -4905,7 +4987,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; @@ -5051,6 +5133,13 @@ lookup_derived_face (struct window *w, default_face = FACE_FROM_ID (f, face_id); memcpy (attrs, default_face->lface, sizeof attrs); + + /* Make explicit any attributes whose value is 'reset'. */ + int i; + for (i = 1; i < LFACE_VECTOR_SIZE; i++) + if (EQ (symbol_attrs[i], Qreset)) + symbol_attrs[i] = attrs[i]; + merge_face_vectors (w, f, symbol_attrs, attrs, 0); return lookup_face (f, attrs); } @@ -5098,49 +5187,60 @@ gui_supports_face_attributes_p (struct frame *f, struct face *def_face) { Lisp_Object *def_attrs = def_face->lface; + Lisp_Object lattrs[LFACE_VECTOR_SIZE]; + + /* Make explicit any attributes whose value is 'reset'. */ + int i; + for (i = 1; i < LFACE_VECTOR_SIZE; i++) + { + if (EQ (attrs[i], Qreset)) + lattrs[i] = def_attrs[i]; + else + lattrs[i] = attrs[i]; + } /* Check that other specified attributes are different from the default face. */ - if ((!UNSPECIFIEDP (attrs[LFACE_UNDERLINE_INDEX]) - && face_attr_equal_p (attrs[LFACE_UNDERLINE_INDEX], + if ((!UNSPECIFIEDP (lattrs[LFACE_UNDERLINE_INDEX]) + && face_attr_equal_p (lattrs[LFACE_UNDERLINE_INDEX], def_attrs[LFACE_UNDERLINE_INDEX])) - || (!UNSPECIFIEDP (attrs[LFACE_INVERSE_INDEX]) - && face_attr_equal_p (attrs[LFACE_INVERSE_INDEX], + || (!UNSPECIFIEDP (lattrs[LFACE_INVERSE_INDEX]) + && face_attr_equal_p (lattrs[LFACE_INVERSE_INDEX], def_attrs[LFACE_INVERSE_INDEX])) - || (!UNSPECIFIEDP (attrs[LFACE_EXTEND_INDEX]) - && face_attr_equal_p (attrs[LFACE_EXTEND_INDEX], + || (!UNSPECIFIEDP (lattrs[LFACE_EXTEND_INDEX]) + && face_attr_equal_p (lattrs[LFACE_EXTEND_INDEX], def_attrs[LFACE_EXTEND_INDEX])) - || (!UNSPECIFIEDP (attrs[LFACE_FOREGROUND_INDEX]) - && face_attr_equal_p (attrs[LFACE_FOREGROUND_INDEX], + || (!UNSPECIFIEDP (lattrs[LFACE_FOREGROUND_INDEX]) + && face_attr_equal_p (lattrs[LFACE_FOREGROUND_INDEX], def_attrs[LFACE_FOREGROUND_INDEX])) - || (!UNSPECIFIEDP (attrs[LFACE_DISTANT_FOREGROUND_INDEX]) - && face_attr_equal_p (attrs[LFACE_DISTANT_FOREGROUND_INDEX], + || (!UNSPECIFIEDP (lattrs[LFACE_DISTANT_FOREGROUND_INDEX]) + && face_attr_equal_p (lattrs[LFACE_DISTANT_FOREGROUND_INDEX], def_attrs[LFACE_DISTANT_FOREGROUND_INDEX])) - || (!UNSPECIFIEDP (attrs[LFACE_BACKGROUND_INDEX]) - && face_attr_equal_p (attrs[LFACE_BACKGROUND_INDEX], + || (!UNSPECIFIEDP (lattrs[LFACE_BACKGROUND_INDEX]) + && face_attr_equal_p (lattrs[LFACE_BACKGROUND_INDEX], def_attrs[LFACE_BACKGROUND_INDEX])) - || (!UNSPECIFIEDP (attrs[LFACE_STIPPLE_INDEX]) - && face_attr_equal_p (attrs[LFACE_STIPPLE_INDEX], + || (!UNSPECIFIEDP (lattrs[LFACE_STIPPLE_INDEX]) + && face_attr_equal_p (lattrs[LFACE_STIPPLE_INDEX], def_attrs[LFACE_STIPPLE_INDEX])) - || (!UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX]) - && face_attr_equal_p (attrs[LFACE_OVERLINE_INDEX], + || (!UNSPECIFIEDP (lattrs[LFACE_OVERLINE_INDEX]) + && face_attr_equal_p (lattrs[LFACE_OVERLINE_INDEX], def_attrs[LFACE_OVERLINE_INDEX])) - || (!UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX]) - && face_attr_equal_p (attrs[LFACE_STRIKE_THROUGH_INDEX], + || (!UNSPECIFIEDP (lattrs[LFACE_STRIKE_THROUGH_INDEX]) + && face_attr_equal_p (lattrs[LFACE_STRIKE_THROUGH_INDEX], def_attrs[LFACE_STRIKE_THROUGH_INDEX])) - || (!UNSPECIFIEDP (attrs[LFACE_BOX_INDEX]) - && face_attr_equal_p (attrs[LFACE_BOX_INDEX], + || (!UNSPECIFIEDP (lattrs[LFACE_BOX_INDEX]) + && face_attr_equal_p (lattrs[LFACE_BOX_INDEX], def_attrs[LFACE_BOX_INDEX]))) return false; /* Check font-related attributes, as those are the most commonly "unsupported" on a window-system (because of missing fonts). */ - if (!UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX]) - || !UNSPECIFIEDP (attrs[LFACE_FOUNDRY_INDEX]) - || !UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX]) - || !UNSPECIFIEDP (attrs[LFACE_WEIGHT_INDEX]) - || !UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX]) - || !UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])) + if (!UNSPECIFIEDP (lattrs[LFACE_FAMILY_INDEX]) + || !UNSPECIFIEDP (lattrs[LFACE_FOUNDRY_INDEX]) + || !UNSPECIFIEDP (lattrs[LFACE_HEIGHT_INDEX]) + || !UNSPECIFIEDP (lattrs[LFACE_WEIGHT_INDEX]) + || !UNSPECIFIEDP (lattrs[LFACE_SLANT_INDEX]) + || !UNSPECIFIEDP (lattrs[LFACE_SWIDTH_INDEX])) { int face_id; struct face *face; @@ -5172,8 +5272,9 @@ gui_supports_face_attributes_p (struct frame *f, return true; s1 = SYMBOL_NAME (face->font->props[i]); s2 = SYMBOL_NAME (def_face->font->props[i]); - if (! EQ (Fcompare_strings (s1, make_fixnum (0), Qnil, - s2, make_fixnum (0), Qnil, Qt), Qt)) + if (! BASE_EQ (Fcompare_strings (s1, make_fixnum (0), Qnil, + s2, make_fixnum (0), Qnil, Qt), + Qt)) return true; } return false; @@ -5379,6 +5480,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 @@ -5612,7 +5717,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); @@ -5801,8 +5906,16 @@ realize_named_face (struct frame *f, Lisp_Object symbol, int id) lface = Finternal_make_lisp_face (symbol, frame); } - /* Merge SYMBOL's face with the default face. */ + get_lface_attributes_no_remap (f, symbol, symbol_attrs, true); + + /* Handle the 'reset' pseudo-value of any attribute by replacing it + with the corresponding value of the default face. */ + int i; + for (i = 1; i < LFACE_VECTOR_SIZE; i++) + if (EQ (symbol_attrs[i], Qreset)) + symbol_attrs[i] = attrs[i]; + /* Merge SYMBOL's face with the default face. */ merge_face_vectors (NULL, f, symbol_attrs, attrs, 0); /* Realize the face. */ @@ -5899,7 +6012,8 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE] #ifdef HAVE_WINDOW_SYSTEM struct face *default_face; struct frame *f; - Lisp_Object stipple, underline, overline, strike_through, box; + Lisp_Object stipple, underline, overline, strike_through, box, temp_spec; + Lisp_Object temp_extra, antialias; eassert (FRAME_WINDOW_P (cache->f)); @@ -5941,8 +6055,28 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE] emacs_abort (); } if (! FONT_OBJECT_P (attrs[LFACE_FONT_INDEX])) - attrs[LFACE_FONT_INDEX] - = font_load_for_lface (f, attrs, Ffont_spec (0, NULL)); + { + /* We want attrs to allow overriding most elements in the + spec (IOW, to start out as an empty font spec), but + preserve the antialiasing attribute. (bug#17973, + bug#37473). */ + temp_spec = Ffont_spec (0, NULL); + temp_extra = AREF (attrs[LFACE_FONT_INDEX], + FONT_EXTRA_INDEX); + /* If `:antialias' wasn't specified, keep it unspecified + instead of changing it to nil. */ + + if (CONSP (temp_extra)) + antialias = Fassq (QCantialias, temp_extra); + else + antialias = Qnil; + + if (FONTP (attrs[LFACE_FONT_INDEX]) && !NILP (antialias)) + Ffont_put (temp_spec, QCantialias, Fcdr (antialias)); + + attrs[LFACE_FONT_INDEX] + = font_load_for_lface (f, attrs, temp_spec); + } if (FONT_OBJECT_P (attrs[LFACE_FONT_INDEX])) { face->font = XFONT_OBJECT (attrs[LFACE_FONT_INDEX]); @@ -5997,6 +6131,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; @@ -6034,6 +6170,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)) @@ -6045,7 +6182,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; } } } @@ -6060,6 +6199,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)) { @@ -6069,12 +6210,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)) { @@ -6083,6 +6228,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. */ @@ -6119,6 +6266,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); + } } } @@ -6416,20 +6570,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) @@ -6621,7 +6771,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) @@ -6701,7 +6853,21 @@ merge_faces (struct window *w, Lisp_Object face_name, int face_id, if (!face) return base_face_id; - merge_face_vectors (w, f, face->lface, attrs, 0); + if (face_id != DEFAULT_FACE_ID) + { + struct face *deflt = FACE_FROM_ID (f, DEFAULT_FACE_ID); + Lisp_Object lface_attrs[LFACE_VECTOR_SIZE]; + int i; + + memcpy (lface_attrs, face->lface, LFACE_VECTOR_SIZE); + /* Make explicit any attributes whose value is 'reset'. */ + for (i = 1; i < LFACE_VECTOR_SIZE; i++) + if (EQ (lface_attrs[i], Qreset)) + lface_attrs[i] = deflt->lface[i]; + merge_face_vectors (w, f, lface_attrs, attrs, 0); + } + else + merge_face_vectors (w, f, face->lface, attrs, 0); } /* Look up a realized face with the given face attributes, @@ -6845,7 +7011,6 @@ DEFUN ("show-face-resources", Fshow_face_resources, Sshow_face_resources, Initialization ***********************************************************************/ -#ifdef HAVE_PDUMPER /* All the faces defined during loadup are recorded in face-new-frame-defaults. We need to set next_lface_id to the next face ID number, so that any new faces defined in this session will @@ -6855,26 +7020,35 @@ DEFUN ("show-face-resources", Fshow_face_resources, Sshow_face_resources, void init_xfaces (void) { - int nfaces = XFIXNAT (Fhash_table_count (Vface_new_frame_defaults)); - if (nfaces > 0) - { - /* Allocate the lface_id_to_name[] array. */ - lface_id_to_name_size = next_lface_id = nfaces; - lface_id_to_name = xnmalloc (next_lface_id, sizeof *lface_id_to_name); +#ifdef HAVE_PDUMPER + int nfaces; - /* Store the faces. */ - struct Lisp_Hash_Table* table = XHASH_TABLE (Vface_new_frame_defaults); - for (ptrdiff_t idx = 0; idx < nfaces; ++idx) + if (dumped_with_pdumper_p ()) + { + nfaces = XFIXNAT (Fhash_table_count (Vface_new_frame_defaults)); + if (nfaces > 0) { - Lisp_Object lface = HASH_KEY (table, idx); - Lisp_Object face_id = CAR (HASH_VALUE (table, idx)); - if (FIXNATP (face_id)) { - int id = XFIXNAT (face_id); - eassert (id >= 0); - lface_id_to_name[id] = lface; - } + /* Allocate the lface_id_to_name[] array. */ + lface_id_to_name_size = next_lface_id = nfaces; + lface_id_to_name = xnmalloc (next_lface_id, sizeof *lface_id_to_name); + + /* Store the faces. */ + struct Lisp_Hash_Table* table = XHASH_TABLE (Vface_new_frame_defaults); + for (ptrdiff_t idx = 0; idx < nfaces; ++idx) + { + Lisp_Object lface = HASH_KEY (table, idx); + Lisp_Object face_id = CAR (HASH_VALUE (table, idx)); + if (FIXNATP (face_id)) + { + int id = XFIXNAT (face_id); + eassert (id >= 0); + lface_id_to_name[id] = lface; + } + } } } +#endif + face_attr_sym[0] = Qface; face_attr_sym[LFACE_FOUNDRY_INDEX] = QCfoundry; face_attr_sym[LFACE_SWIDTH_INDEX] = QCwidth; @@ -6895,7 +7069,6 @@ init_xfaces (void) face_attr_sym[LFACE_DISTANT_FOREGROUND_INDEX] = QCdistant_foreground; face_attr_sym[LFACE_EXTEND_INDEX] = QCextend; } -#endif void syms_of_xfaces (void) @@ -6940,21 +7113,30 @@ 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"); + DEFSYM (Qreset, "reset"); /* The symbols `foreground-color' and `background-color' which can be used as part of a `face' property. This is for compatibility with @@ -6988,6 +7170,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..331f22763ee 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,78 @@ 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) +{ + unsigned long opaque_region[] = {0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)}; +#ifdef HAVE_GTK3 + GObjectClass *object_class; + GtkWidgetClass *class; +#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); +#else + else + { + if (FRAME_TOOLTIP_P (f)) + 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); + else + { + object_class = G_OBJECT_GET_CLASS (FRAME_GTK_OUTER_WIDGET (f)); + class = GTK_WIDGET_CLASS (object_class); + + if (class->style_updated) + class->style_updated (FRAME_GTK_OUTER_WIDGET (f)); + } + } +#endif +} + +static void x_set_tool_bar_position (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) @@ -740,22 +823,36 @@ x_set_tool_bar_position (struct frame *f, wrong_choice (choice, new_value); } +#ifdef HAVE_XDBE static void x_set_inhibit_double_buffering (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) { - block_input (); + bool want_double_buffering, was_double_buffered; + if (FRAME_X_WINDOW (f) && !EQ (new_value, old_value)) { - bool want_double_buffering = NILP (new_value); - bool was_double_buffered = FRAME_X_DOUBLE_BUFFERED_P (f); - /* font_drop_xrender_surfaces in xftfont does something only if - we're double-buffered, so call font_drop_xrender_surfaces before - and after any potential change. One of the calls will end up - being a no-op. */ + want_double_buffering = NILP (new_value); + was_double_buffered = FRAME_X_DOUBLE_BUFFERED_P (f); + + block_input (); if (want_double_buffering != was_double_buffered) - font_drop_xrender_surfaces (f); + { + /* Force XftDraw etc to be recreated with the new double + buffered drawable. */ + 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) @@ -765,9 +862,10 @@ x_set_inhibit_double_buffering (struct frame *f, SET_FRAME_GARBAGED (f); font_drop_xrender_surfaces (f); } + unblock_input (); } - unblock_input (); } +#endif /** * x_set_undecorated: @@ -792,7 +890,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 +942,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 +960,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 +968,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 +1002,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, @@ -1152,25 +1261,27 @@ struct mouse_cursor_types { }; /* This array must stay in sync with enum mouse_cursor above! */ -static const struct mouse_cursor_types mouse_cursor_types[] = { - { "text", &Vx_pointer_shape, XC_xterm }, - { "nontext", &Vx_nontext_pointer_shape, XC_left_ptr }, - { "hourglass", &Vx_hourglass_pointer_shape, XC_watch }, - { "modeline", &Vx_mode_pointer_shape, XC_xterm }, - { NULL, &Vx_sensitive_text_pointer_shape, XC_hand2 }, - { NULL, &Vx_window_horizontal_drag_shape, XC_sb_h_double_arrow }, - { NULL, &Vx_window_vertical_drag_shape, XC_sb_v_double_arrow }, - { NULL, &Vx_window_left_edge_shape, XC_left_side }, - { NULL, &Vx_window_top_left_corner_shape, XC_top_left_corner }, - { NULL, &Vx_window_top_edge_shape, XC_top_side }, - { NULL, &Vx_window_top_right_corner_shape, XC_top_right_corner }, - { NULL, &Vx_window_right_edge_shape, XC_right_side }, - { NULL, &Vx_window_bottom_right_corner_shape, XC_bottom_right_corner }, - { NULL, &Vx_window_bottom_edge_shape, XC_bottom_side }, - { NULL, &Vx_window_bottom_left_corner_shape, XC_bottom_left_corner }, -}; - -struct mouse_cursor_data { +static const struct mouse_cursor_types mouse_cursor_types[] = + { + { "text", &Vx_pointer_shape, XC_xterm }, + { "nontext", &Vx_nontext_pointer_shape, XC_left_ptr }, + { "hourglass", &Vx_hourglass_pointer_shape, XC_watch }, + { "modeline", &Vx_mode_pointer_shape, XC_xterm }, + { NULL, &Vx_sensitive_text_pointer_shape, XC_hand2 }, + { NULL, &Vx_window_horizontal_drag_shape, XC_sb_h_double_arrow }, + { NULL, &Vx_window_vertical_drag_shape, XC_sb_v_double_arrow }, + { NULL, &Vx_window_left_edge_shape, XC_left_side }, + { NULL, &Vx_window_top_left_corner_shape, XC_top_left_corner }, + { NULL, &Vx_window_top_edge_shape, XC_top_side }, + { NULL, &Vx_window_top_right_corner_shape, XC_top_right_corner }, + { NULL, &Vx_window_right_edge_shape, XC_right_side }, + { NULL, &Vx_window_bottom_right_corner_shape, XC_bottom_right_corner }, + { NULL, &Vx_window_bottom_edge_shape, XC_bottom_side }, + { NULL, &Vx_window_bottom_left_corner_shape, XC_bottom_left_corner }, + }; + +struct mouse_cursor_data +{ /* Last index for which XCreateFontCursor has been called, and thus the last index for which x_request_serial[] is valid. */ int last_cursor_create_request; @@ -1251,8 +1362,10 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { cursor_data.x_request_serial[i] = XNextRequest (dpy); cursor_data.last_cursor_create_request = i; - cursor_data.cursor[i] = XCreateFontCursor (dpy, - cursor_data.cursor_num[i]); + + cursor_data.cursor[i] + = x_create_font_cursor (FRAME_DISPLAY_INFO (f), + cursor_data.cursor_num[i]); } /* Now sync up and process all received errors from cursor @@ -1404,11 +1517,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 +1562,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)); @@ -1456,7 +1584,7 @@ x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (STRINGP (arg)) { - if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt)) + if (STRINGP (oldval) && BASE_EQ (Fstring_equal (oldval, arg), Qt)) return; } else if (!STRINGP (oldval) && NILP (oldval) == NILP (arg)) @@ -1488,7 +1616,7 @@ x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (STRINGP (arg)) { - if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt)) + if (STRINGP (oldval) && BASE_EQ (Fstring_equal (oldval, arg), Qt)) return; } else if (!NILP (arg) || NILP (oldval)) @@ -1842,6 +1970,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 +1995,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 +2029,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 +2068,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 @@ -2196,6 +2376,63 @@ x_set_scroll_bar_default_height (struct frame *f) #endif } +static void +x_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + double alpha = 1.0; + double newval[2]; + int i; + Lisp_Object item; + bool alpha_identical_p; + + alpha_identical_p = true; + + for (i = 0; i < 2; i++) + { + newval[i] = 1.0; + if (CONSP (arg)) + { + item = CAR (arg); + arg = CDR (arg); + + alpha_identical_p = false; + } + else + item = arg; + + if (NILP (item)) + alpha = - 1.0; + else if (FLOATP (item)) + { + alpha = XFLOAT_DATA (item); + if (! (0 <= alpha && alpha <= 1.0)) + args_out_of_range (make_float (0.0), make_float (1.0)); + } + else if (FIXNUMP (item)) + { + EMACS_INT ialpha = XFIXNUM (item); + if (! (0 <= ialpha && ialpha <= 100)) + args_out_of_range (make_fixnum (0), make_fixnum (100)); + alpha = ialpha / 100.0; + } + else + wrong_type_argument (Qnumberp, item); + newval[i] = alpha; + } + + for (i = 0; i < 2; i++) + f->alpha[i] = newval[i]; + + FRAME_X_OUTPUT (f)->alpha_identical_p = alpha_identical_p; + + if (FRAME_TERMINAL (f)->set_frame_alpha_hook) + { + block_input (); + FRAME_TERMINAL (f)->set_frame_alpha_hook (f); + unblock_input (); + } +} + /* Record in frame F the specified or default value according to ALIST of the parameter named PROP (a Lisp symbol). If no value is @@ -2213,7 +2450,7 @@ x_default_scroll_bar_color_parameter (struct frame *f, tem = gui_display_get_arg (dpyinfo, alist, prop, xprop, xclass, RES_TYPE_STRING); - if (EQ (tem, Qunbound)) + if (BASE_EQ (tem, Qunbound)) { #ifdef USE_TOOLKIT_SCROLL_BARS @@ -2320,14 +2557,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 +2918,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 +2974,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 +3024,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 +3110,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 +3198,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); + + 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); -/* Set X fontset for XIC of frame F, using base font name - BASE_FONTNAME. Called when a new Emacs fontset is chosen. */ + 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) @@ -2844,13 +3612,27 @@ xic_set_xfontset (struct frame *f, const char *base_fontname) void x_mark_frame_dirty (struct frame *f) { - if (FRAME_X_DOUBLE_BUFFERED_P (f) && !FRAME_X_NEED_BUFFER_FLIP (f)) +#ifdef HAVE_XDBE + if (FRAME_X_DOUBLE_BUFFERED_P (f) + && !FRAME_X_NEED_BUFFER_FLIP (f)) FRAME_X_NEED_BUFFER_FLIP (f) = true; +#endif } 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 +3647,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 +3663,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)) @@ -2904,13 +3697,109 @@ tear_down_x_back_buffer (struct frame *f) void initial_set_up_x_back_buffer (struct frame *f) { - block_input (); eassert (FRAME_X_WINDOW (f)); FRAME_X_RAW_DRAWABLE (f) = FRAME_X_WINDOW (f); - if (NILP (CDR (Fassq (Qinhibit_double_buffering, f->param_alist)))) + + if (NILP (CDR (Fassq (Qinhibit_double_buffering, + f->param_alist)))) set_up_x_back_buffer (f); +} + +#if defined HAVE_XINPUT2 +static void +setup_xi_event_mask (struct frame *f) +{ + XIEventMask mask; + ptrdiff_t l = XIMaskLen (XI_LASTEVENT); + unsigned char *m; +#ifndef HAVE_XINPUT2_1 + /* Set up fallback values, since XIGetSelectedEvents doesn't work + with this version of libXi. */ + XIEventMask *selected; + + selected = xzalloc (sizeof *selected + l); + selected->mask = ((unsigned char *) selected) + sizeof *selected; + selected->mask_len = l; + selected->deviceid = XIAllMasterDevices; +#endif + + 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); + + /* Fortunately `xi_masks' isn't used on GTK 3, where we really have + to get the event mask from the X server. */ +#ifndef HAVE_XINPUT2_1 + memcpy (selected->mask, m, l); +#endif + + 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); + +#ifndef HAVE_XINPUT2_1 + FRAME_X_OUTPUT (f)->xi_masks = selected; + FRAME_X_OUTPUT (f)->num_xi_masks = 1; +#endif + unblock_input (); } +#endif #ifdef USE_X_TOOLKIT @@ -3086,6 +3975,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 +4027,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 +4051,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 +4095,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 +4133,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 +4156,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 +4186,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 +4206,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; @@ -3337,12 +4246,12 @@ x_icon_verify (struct frame *f, Lisp_Object parms) icons in an icon window. */ icon_x = gui_frame_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER); icon_y = gui_frame_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER); - if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound)) + if (!BASE_EQ (icon_x, Qunbound) && !BASE_EQ (icon_y, Qunbound)) { CHECK_FIXNUM (icon_x); CHECK_FIXNUM (icon_y); } - else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound)) + else if (!BASE_EQ (icon_x, Qunbound) || !BASE_EQ (icon_y, Qunbound)) error ("Both left and top icon corners of icon must be specified"); } @@ -3361,8 +4270,8 @@ x_icon (struct frame *f, Lisp_Object parms) = gui_frame_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER); int icon_xval, icon_yval; - bool xgiven = !EQ (icon_x, Qunbound); - bool ygiven = !EQ (icon_y, Qunbound); + bool xgiven = !BASE_EQ (icon_x, Qunbound); + bool ygiven = !BASE_EQ (icon_y, Qunbound); if (xgiven != ygiven) error ("Both left and top icon corners of icon must be specified"); if (xgiven) @@ -3411,7 +4320,7 @@ x_make_gc (struct frame *f) gc_values.foreground = FRAME_FOREGROUND_PIXEL (f); gc_values.background = FRAME_BACKGROUND_PIXEL (f); - gc_values.line_width = 0; /* Means 1 using fast algorithm. */ + gc_values.line_width = 1; f->output_data.x->normal_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), @@ -3430,11 +4339,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 @@ -3549,7 +4456,7 @@ x_default_font_parameter (struct frame *f, Lisp_Object parms) 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)) + if (BASE_EQ (font_param, Qunbound)) font_param = Qnil; if (NILP (font_param)) @@ -3637,9 +4544,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,11 +4568,14 @@ 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; struct kboard *kb; +#ifdef HAVE_GTK3 + GdkWindow *gwin; +#endif parms = Fcopy_alist (parms); @@ -3677,10 +4585,10 @@ This function is an internal primitive--use `make-frame' instead. */) display = gui_display_get_arg (dpyinfo, parms, Qterminal, 0, 0, RES_TYPE_NUMBER); - if (EQ (display, Qunbound)) + if (BASE_EQ (display, Qunbound)) display = gui_display_get_arg (dpyinfo, parms, Qdisplay, 0, 0, RES_TYPE_STRING); - if (EQ (display, Qunbound)) + if (BASE_EQ (display, Qunbound)) display = Qnil; dpyinfo = check_x_display_info (display); kb = dpyinfo->terminal->kboard; @@ -3691,7 +4599,7 @@ This function is an internal primitive--use `make-frame' instead. */) name = gui_display_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING); if (!STRINGP (name) - && ! EQ (name, Qunbound) + && ! BASE_EQ (name, Qunbound) && ! NILP (name)) error ("Invalid frame name--not a string or nil"); @@ -3701,7 +4609,7 @@ This function is an internal primitive--use `make-frame' instead. */) /* See if parent window is specified. */ parent = gui_display_get_arg (dpyinfo, parms, Qparent_id, NULL, NULL, RES_TYPE_NUMBER); - if (EQ (parent, Qunbound)) + if (BASE_EQ (parent, Qunbound)) parent = Qnil; if (! NILP (parent)) CHECK_FIXNUM (parent); @@ -3730,7 +4638,7 @@ This function is an internal primitive--use `make-frame' instead. */) RES_TYPE_SYMBOL); /* Accept parent-frame iff parent-id was not specified. */ if (!NILP (parent) - || EQ (parent_frame, Qunbound) + || BASE_EQ (parent_frame, Qunbound) || NILP (parent_frame) || !FRAMEP (parent_frame) || !FRAME_LIVE_P (XFRAME (parent_frame)) @@ -3746,7 +4654,7 @@ This function is an internal primitive--use `make-frame' instead. */) NULL, NULL, RES_TYPE_BOOLEAN))) - && !(EQ (tem, Qunbound))) + && !(BASE_EQ (tem, Qunbound))) undecorated = true; FRAME_UNDECORATED (f) = undecorated; @@ -3758,7 +4666,7 @@ This function is an internal primitive--use `make-frame' instead. */) NULL, NULL, RES_TYPE_BOOLEAN))) - && !(EQ (tem, Qunbound))) + && !(BASE_EQ (tem, Qunbound))) override_redirect = true; FRAME_OVERRIDE_REDIRECT (f) = override_redirect; @@ -3839,7 +4747,7 @@ This function is an internal primitive--use `make-frame' instead. */) /* Set the name; the functions to which we pass f expect the name to be set. */ - if (EQ (name, Qunbound) || NILP (name)) + if (BASE_EQ (name, Qunbound) || NILP (name)) { fset_name (f, build_string (dpyinfo->x_id_name)); f->explicit_name = false; @@ -3902,7 +4810,7 @@ This function is an internal primitive--use `make-frame' instead. */) value = gui_display_get_arg (dpyinfo, parms, Qinternal_border_width, "internalBorder", "internalBorder", RES_TYPE_NUMBER); - if (! EQ (value, Qunbound)) + if (! BASE_EQ (value, Qunbound)) parms = Fcons (Fcons (Qinternal_border_width, value), parms); } @@ -3924,7 +4832,7 @@ This function is an internal primitive--use `make-frame' instead. */) value = gui_display_get_arg (dpyinfo, parms, Qchild_frame_border_width, "childFrameBorder", "childFrameBorder", RES_TYPE_NUMBER); - if (! EQ (value, Qunbound)) + if (! BASE_EQ (value, Qunbound)) parms = Fcons (Fcons (Qchild_frame_border_width, value), parms); } @@ -3967,6 +4875,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 +4957,16 @@ This function is an internal primitive--use `make-frame' instead. */) x_icon (f, parms); x_make_gc (f); + /* While this function is present in versions of libXi that only + support 2.0, it does not release the display lock after + finishing, leading to a deadlock. */ +#if defined HAVE_XINPUT2 && defined HAVE_XINPUT2_1 + 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 +4991,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)) { @@ -4079,6 +5006,10 @@ This function is an internal primitive--use `make-frame' instead. */) gtk_container_set_resize_mode (GTK_CONTAINER (FRAME_GTK_OUTER_WIDGET (f)), GTK_RESIZE_IMMEDIATE); #endif +#ifdef HAVE_GTK3 + gwin = gtk_widget_get_window (FRAME_GTK_OUTER_WIDGET (f)); + gdk_x11_window_set_frame_sync_enabled (gwin, FALSE); +#endif unblock_input (); } @@ -4146,7 +5077,7 @@ This function is an internal primitive--use `make-frame' instead. */) } else { - if (EQ (visibility, Qunbound)) + if (BASE_EQ (visibility, Qunbound)) visibility = Qt; if (!NILP (visibility)) @@ -4160,7 +5091,7 @@ This function is an internal primitive--use `make-frame' instead. */) from `x-create-frame-with-faces' (see above comment). */ f->was_invisible = (f->was_invisible - && (!EQ (height, Qunbound) || !EQ (width, Qunbound))); + && (!BASE_EQ (height, Qunbound) || !BASE_EQ (width, Qunbound))); store_frame_param (f, Qvisibility, visibility); } @@ -4181,6 +5112,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 +5224,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 +5251,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 +5327,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 +5390,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 +5407,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 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. @@ -4463,6 +5459,9 @@ for each physical monitor, use `display-monitor-attributes-list'. */) { struct x_display_info *dpyinfo = check_x_display_info (terminal); + if (dpyinfo->screen_mm_height) + return make_fixnum (dpyinfo->screen_mm_height); + return make_fixnum (HeightMMOfScreen (dpyinfo->screen)); } @@ -4480,6 +5479,9 @@ for each physical monitor, use `display-monitor-attributes-list'. */) { struct x_display_info *dpyinfo = check_x_display_info (terminal); + if (dpyinfo->screen_mm_width) + return make_fixnum (dpyinfo->screen_mm_width); + return make_fixnum (WidthMMOfScreen (dpyinfo->screen)); } @@ -4535,7 +5537,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 +5591,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 +5645,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 +5896,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 +6086,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 +6110,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 +6121,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 +6134,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, @@ -5405,17 +6625,61 @@ menu bar or tool bar of FRAME. */) * WINDOW to FRAMES and return FRAMES. */ static Lisp_Object -x_frame_list_z_order (Display* dpy, Window window) +x_frame_list_z_order (struct x_display_info *dpyinfo, Window window) { + Display *dpy; Window root, parent, *children; unsigned int nchildren; - int i; - Lisp_Object frames = Qnil; + unsigned long i; + Lisp_Object frames, val; + Atom type; + Window *toplevels; + int format, rc; + unsigned long nitems, bytes_after; + unsigned char *data; + struct frame *f; + + dpy = dpyinfo->display; + data = NULL; + frames = Qnil; + + if (window == dpyinfo->root_window + && x_wm_supports_1 (dpyinfo, + dpyinfo->Xatom_net_client_list_stacking)) + { + 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 Qnil; + + if (format != 32 || type != XA_WINDOW) + { + XFree (data); + return Qnil; + } + + toplevels = (Window *) data; + + for (i = 0; i < nitems; ++i) + { + f = x_top_window_to_frame (dpyinfo, toplevels[i]); + + if (f) + { + XSETFRAME (val, f); + frames = Fcons (val, frames); + } + } + + XFree (data); + return frames; + } - block_input (); if (XQueryTree (dpy, window, &root, &parent, &children, &nchildren)) { - unblock_input (); for (i = 0; i < nchildren; i++) { Lisp_Object frame, tail; @@ -5433,10 +6697,9 @@ x_frame_list_z_order (Display* dpy, Window window) } } - if (children) XFree ((char *)children); + if (children) + XFree (children); } - else - unblock_input (); return frames; } @@ -5457,7 +6720,6 @@ Frames are listed from topmost (first) to bottommost (last). */) (Lisp_Object terminal) { struct x_display_info *dpyinfo = check_x_display_info (terminal); - Display *dpy = dpyinfo->display; Window window; if (FRAMEP (terminal) && FRAME_LIVE_P (XFRAME (terminal))) @@ -5465,7 +6727,7 @@ Frames are listed from topmost (first) to bottommost (last). */) else window = dpyinfo->root_window; - return x_frame_list_z_order (dpy, window); + return x_frame_list_z_order (dpyinfo, window); } /** @@ -5545,7 +6807,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 +6821,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 +6831,205 @@ 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, 6, 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 it should 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. + +The source is also expected to cooperate with the target to perform +the action chosen by the target. For example, callers should delete +the buffer text that was dragged if `XdndActionMove' is returned. + +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. + +If FOLLOW-TOOLTIP is non-nil, any tooltip currently being displayed +will be moved to follow the mouse pointer while the drag is in +progress. Note that this does not work with system tooltips (tooltips +created when `use-system-tooltips' is non-nil). + +This function will sometimes return immediately if no mouse buttons +are currently held down. It should only be called when it is known +that mouse buttons are being held down, such as immediately after a +`down-mouse-1' (or similar) event. */) + (Lisp_Object targets, Lisp_Object action, Lisp_Object frame, + Lisp_Object return_frame, Lisp_Object allow_current_frame, + Lisp_Object follow_tooltip) +{ + struct frame *f = decode_window_system_frame (frame); + int ntargets = 0, nnames = 0; + char *target_names[2048]; + Atom *target_atoms; + Lisp_Object lval, original, targets_arg, tem, t1, t2; + Atom xaction; + Atom action_list[2048]; + char *name_list[2048]; + + USE_SAFE_ALLOCA; + + CHECK_LIST (targets); + original = targets; + targets_arg = targets; + + FOR_EACH_TAIL (targets) + { + CHECK_STRING (XCAR (targets)); + + if (ntargets < 2048) + { + SAFE_ALLOCA_STRING (target_names[ntargets], + XCAR (targets)); + 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 (SYMBOLP (action)) + /* This is to accommodate non-standard DND protocols such as XDS + that are explictly implemented by Emacs, and is not documented + for that reason. */ + xaction = symbol_to_x_atom (FRAME_DISPLAY_INFO (f), action); + else if (CONSP (action)) + { + xaction = FRAME_DISPLAY_INFO (f)->Xatom_XdndActionAsk; + original = action; + + CHECK_LIST (action); + FOR_EACH_TAIL (action) + { + 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); + + SAFE_ALLOCA_STRING (name_list[nnames], + ENCODE_SYSTEM (t2)); + + nnames++; + } + else + error ("Too many actions"); + } + CHECK_LIST_END (action, original); + } + else + signal_error ("Invalid drag-and-drop action", action); + + target_atoms = SAFE_ALLOCA (ntargets * sizeof *target_atoms); + + /* Catch errors since interning lots of targets can potentially + generate a BadAlloc error. */ + x_catch_errors (FRAME_X_DISPLAY (f)); + XInternAtoms (FRAME_X_DISPLAY (f), target_names, + ntargets, False, target_atoms); + x_check_errors (FRAME_X_DISPLAY (f), + "Failed to intern target atoms: %s"); + x_uncatch_errors_after_check (); + + 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), target_atoms, + ntargets, targets_arg, !NILP (follow_tooltip)); + + SAFE_FREE (); + return lval; +} + /************************************************************************ X Displays ************************************************************************/ @@ -5606,8 +7060,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 +7128,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 +7321,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 (); } @@ -5845,30 +7343,56 @@ converted to an atom and the value of the atom is used. If an element is a cons, it is converted to a 32 bit number where the car is the 16 top bits and the cdr is the lower 16 bits. -FRAME nil or omitted means use the selected frame. -If TYPE is given and non-nil, it is the name of the type of VALUE. - If TYPE is not given or nil, the type is STRING. -FORMAT gives the size in bits of each element if VALUE is a list. - It must be one of 8, 16 or 32. - If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8. -If OUTER-P is non-nil, the property is changed for the outer X window of - FRAME. Default is to change on the edit X window. -If WINDOW-ID is non-nil, change the property of that window instead - of FRAME's X window; the number 0 denotes the root window. This argument - is separate from FRAME because window IDs are not unique across X - displays or screens on the same display, so FRAME provides context - for the window ID. */) +FRAME nil or omitted means use the selected frame. If TYPE is given +and non-nil, it is the name of the type of VALUE. If TYPE is not +given or nil, the type is STRING. + +FORMAT gives the size in bits of each element if VALUE is a list. It +must be one of 8, 16 or 32. + +If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to +8. If OUTER-P is non-nil, the property is changed for the outer X +window of FRAME. Default is to change on the edit X window. + +If WINDOW-ID is non-nil, change the property of that window instead of +FRAME's X window; the number 0 denotes the root window. This argument +is separate from FRAME because window IDs are not unique across X +displays or screens on the same display, so FRAME provides context for +the window ID. + +If VALUE is a string and FORMAT is 32, then the format of VALUE is +system-specific. VALUE must contain unsigned integer data in native +endian-ness in multiples of the size of the C type 'long': the low 32 +bits of each such number are used as the value of each element of the +property. + +Wait for the request to complete and signal any error, unless +`x-fast-protocol-requests' is non-nil, in which case errors will be +silently ignored. */) (Lisp_Object prop, Lisp_Object value, Lisp_Object frame, Lisp_Object type, Lisp_Object format, Lisp_Object outer_p, Lisp_Object window_id) { - struct frame *f = decode_window_system_frame (frame); + struct frame *f; Atom prop_atom; Atom target_type = XA_STRING; int element_format = 8; unsigned char *data; int nelements; Window target_window; + struct x_display_info *dpyinfo; +#ifdef USE_XCB + bool intern_prop; + bool intern_target; + 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 + + f = decode_window_system_frame (frame); + dpyinfo = FRAME_DISPLAY_INFO (f); CHECK_STRING (prop); @@ -5921,7 +7445,7 @@ If WINDOW-ID is non-nil, change the property of that window instead { CONS_TO_INTEGER (window_id, Window, target_window); if (! target_window) - target_window = FRAME_DISPLAY_INFO (f)->root_window; + target_window = dpyinfo->root_window; } else { @@ -5932,23 +7456,97 @@ If WINDOW-ID is non-nil, change the property of that window instead } block_input (); - prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (prop), False); +#ifndef USE_XCB + prop_atom = x_intern_cached_atom (dpyinfo, SSDATA (prop), + false); if (! NILP (type)) { CHECK_STRING (type); - target_type = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (type), False); + target_type = x_intern_cached_atom (dpyinfo, SSDATA (type), + false); } +#else + rc = true; + intern_target = true; + intern_prop = true; - XChangeProperty (FRAME_X_DISPLAY (f), target_window, - prop_atom, target_type, element_format, PropModeReplace, - data, nelements); + prop_atom = x_intern_cached_atom (dpyinfo, SSDATA (prop), + true); - if (CONSP (value)) xfree (data); + if (prop_atom != None) + intern_prop = false; + else + prop_atom_cookie + = xcb_intern_atom (dpyinfo->xcb_connection, + 0, SBYTES (prop), SSDATA (prop)); - /* Make sure the property is set when we return. */ - XFlush (FRAME_X_DISPLAY (f)); - unblock_input (); + if (!NILP (type)) + { + CHECK_STRING (type); + target_type = x_intern_cached_atom (dpyinfo, SSDATA (type), + true); + + if (target_type) + intern_target = false; + else + target_type_cookie + = xcb_intern_atom (dpyinfo->xcb_connection, + 0, SBYTES (type), SSDATA (type)); + } + + if (intern_prop) + { + reply = xcb_intern_atom_reply (dpyinfo->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) && intern_target) + { + reply = xcb_intern_atom_reply (dpyinfo->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 + + x_catch_errors_for_lisp (dpyinfo); + + XChangeProperty (dpyinfo->display, target_window, + prop_atom, target_type, element_format, + PropModeReplace, data, nelements); + + if (CONSP (value)) + xfree (data); + + x_check_errors_for_lisp (dpyinfo, + "Couldn't change window property: %s"); + x_uncatch_errors_for_lisp (dpyinfo); + + unblock_input (); return value; } @@ -5963,7 +7561,11 @@ If WINDOW-ID is non-nil, remove property from that window instead across X displays or screens on the same display, so FRAME provides context for the window ID. -Value is PROP. */) +Value is PROP. + +Wait for the request to complete and signal any error, unless +`x-fast-protocol-requests' is non-nil, in which case errors will be +silently ignored. */) (Lisp_Object prop, Lisp_Object frame, Lisp_Object window_id) { struct frame *f = decode_window_system_frame (frame); @@ -5980,13 +7582,16 @@ Value is PROP. */) } block_input (); - prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (prop), False); + prop_atom = x_intern_cached_atom (FRAME_DISPLAY_INFO (f), + SSDATA (prop), false); + + x_catch_errors_for_lisp (FRAME_DISPLAY_INFO (f)); XDeleteProperty (FRAME_X_DISPLAY (f), target_window, prop_atom); + x_check_errors_for_lisp (FRAME_DISPLAY_INFO (f), + "Couldn't delete window property: %s"); + x_uncatch_errors_for_lisp (FRAME_DISPLAY_INFO (f)); - /* Make sure the property is removed when we return. */ - XFlush (FRAME_X_DISPLAY (f)); unblock_input (); - return prop; } @@ -6106,15 +7711,19 @@ if PROP has no value of TYPE (always a string in the MS Windows case). */) } block_input (); + x_catch_errors (FRAME_X_DISPLAY (f)); + if (STRINGP (type)) { if (strcmp ("AnyPropertyType", SSDATA (type)) == 0) target_type = AnyPropertyType; else - target_type = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (type), False); + target_type = x_intern_cached_atom (FRAME_DISPLAY_INFO (f), + SSDATA (type), false); } - prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (prop), False); + prop_atom = x_intern_cached_atom (FRAME_DISPLAY_INFO (f), + SSDATA (prop), false); prop_value = x_window_property_intern (f, target_window, prop_atom, @@ -6136,6 +7745,9 @@ if PROP has no value of TYPE (always a string in the MS Windows case). */) &found); } + x_check_errors (FRAME_X_DISPLAY (f), + "Can't retrieve window property: %s"); + x_uncatch_errors_after_check (); unblock_input (); return prop_value; @@ -6181,7 +7793,9 @@ Otherwise, the return value is a vector with the following fields: block_input (); - prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (prop), False); + x_catch_errors (FRAME_X_DISPLAY (f)); + prop_atom = x_intern_cached_atom (FRAME_DISPLAY_INFO (f), + SSDATA (prop), false); rc = XGetWindowProperty (FRAME_X_DISPLAY (f), target_window, prop_atom, 0, 0, False, AnyPropertyType, &actual_type, &actual_format, &actual_size, @@ -6211,6 +7825,10 @@ Otherwise, the return value is a vector with the following fields: make_fixnum (bytes_remaining / (actual_format >> 3))); } + x_check_errors (FRAME_X_DISPLAY (f), + "Can't retrieve window property: %s"); + x_uncatch_errors_after_check (); + unblock_input (); return prop_attr; } @@ -6223,12 +7841,15 @@ static void compute_tip_xy (struct frame *, Lisp_Object, Lisp_Object, Lisp_Object, int, int, int *, int *); /* The frame of the currently visible tooltip, or nil if none. */ -static Lisp_Object tip_frame; +Lisp_Object tip_frame; /* The window-system window corresponding to the frame of the currently visible tooltip. */ Window tip_window; +/* The X and Y deltas of the last call to `x-show-tip'. */ +Lisp_Object tip_dx, tip_dy; + /* A timer that hides or deletes the currently visible tooltip when it fires. */ static Lisp_Object tip_timer; @@ -6272,7 +7893,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) @@ -6284,7 +7905,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) name = gui_display_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING); if (!STRINGP (name) - && !EQ (name, Qunbound) + && !BASE_EQ (name, Qunbound) && !NILP (name)) error ("Invalid frame name--not a string or nil"); @@ -6351,7 +7972,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) /* Set the name; the functions to which we pass f expect the name to be set. */ - if (EQ (name, Qunbound) || NILP (name)) + if (BASE_EQ (name, Qunbound) || NILP (name)) { fset_name (f, build_string (dpyinfo->x_id_name)); f->explicit_name = false; @@ -6407,7 +8028,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) value = gui_display_get_arg (dpyinfo, parms, Qinternal_border_width, "internalBorder", "internalBorder", RES_TYPE_NUMBER); - if (! EQ (value, Qunbound)) + if (! BASE_EQ (value, Qunbound)) parms = Fcons (Fcons (Qinternal_border_width, value), parms); } @@ -6434,26 +8055,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 +8073,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 +8088,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 +8097,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 +8169,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 +8188,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"); @@ -6580,9 +8255,9 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) 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) +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 win_x, win_y; @@ -6608,7 +8283,7 @@ compute_tip_xy (struct frame *f, &root, &child, root_x, root_y, &win_x, &win_y, &pmask); unblock_input (); - XSETFRAME(frame, f); + XSETFRAME (frame, f); attributes = Fx_display_monitor_attributes_list (frame); /* Try to determine the monitor where the mouse pointer is and @@ -6623,11 +8298,13 @@ compute_tip_xy (struct frame *f, 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; } @@ -6637,7 +8314,7 @@ compute_tip_xy (struct frame *f, /* It was not possible to determine the monitor's geometry, so we assign some sane defaults here: */ - if ( max_y < 0 ) + if (max_y < 0) { min_x = 0; min_y = 0; @@ -6702,13 +8379,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 +8396,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 +8417,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 +8427,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 +8457,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); @@ -6802,29 +8477,6 @@ x_hide_tip (bool delete) else x_make_frame_invisible (XFRAME (tip_frame)); -#ifdef USE_LUCID - /* Bloodcurdling hack alert: The Lucid menu bar widget's - redisplay procedure is not called when a tip frame over - menu items is unmapped. Redisplay the menu manually... */ - { - Widget w; - struct frame *f = SELECTED_FRAME (); - - if (FRAME_X_P (f) && FRAME_LIVE_P (f)) - { - w = f->output_data.x->menubar_widget; - - if (!DoesSaveUnders (FRAME_DISPLAY_INFO (f)->screen) - && w != NULL) - { - block_input (); - xlwmenu_redisplay (w); - unblock_input (); - } - } - } -#endif /* USE_LUCID */ - was_open = Qt; } else @@ -6851,7 +8503,8 @@ 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. +means use the default timeout from the `x-show-tooltip-timeout' +variable. If the list of frame parameters PARMS contains a `left' parameter, display the tooltip at that x-position. If the list of frame parameters @@ -6879,9 +8532,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); @@ -6895,9 +8550,8 @@ Text larger than the specified size is clipped. */) f = decode_window_system_frame (frame); if (NILP (timeout)) - timeout = make_fixnum (5); - else - CHECK_FIXNAT (timeout); + timeout = Vx_show_tooltip_timeout; + CHECK_FIXNAT (timeout); if (NILP (dx)) dx = make_fixnum (5); @@ -6909,8 +8563,11 @@ Text larger than the specified size is clipped. */) else CHECK_FIXNUM (dy); + tip_dx = dx; + tip_dy = dy; + #ifdef USE_GTK - if (x_gtk_use_system_tooltips) + if (use_system_tooltips) { bool ok; @@ -6934,7 +8591,7 @@ Text larger than the specified size is clipped. */) if (!NILP (tip_frame) && FRAME_LIVE_P (XFRAME (tip_frame))) { if (FRAME_VISIBLE_P (XFRAME (tip_frame)) - && EQ (frame, tip_last_frame) + && BASE_EQ (frame, tip_last_frame) && !NILP (Fequal_including_properties (tip_last_string, string)) && !NILP (Fequal (tip_last_parms, parms))) { @@ -6955,7 +8612,7 @@ Text larger than the specified size is clipped. */) goto start_timer; } - else if (tooltip_reuse_hidden_frame && EQ (frame, tip_last_frame)) + else if (tooltip_reuse_hidden_frame && BASE_EQ (frame, tip_last_frame)) { bool delete = false; Lisp_Object tail, elt, parm, last; @@ -7080,7 +8737,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 +8752,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 +8763,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 @@ -7144,7 +8851,12 @@ DEFUN ("x-double-buffered-p", Fx_double_buffered_p, Sx_double_buffered_p, (Lisp_Object frame) { struct frame *f = decode_live_frame (frame); + +#ifdef HAVE_XDBE return FRAME_X_DOUBLE_BUFFERED_P (f) ? Qt : Qnil; +#else + return Qnil; +#endif } @@ -7220,7 +8932,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); @@ -7233,6 +8945,9 @@ DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, /* Prevent redisplay. */ specbind (Qinhibit_redisplay, Qt); + /* Defer selection requests. */ + DEFER_SELECTIONS; + block_input (); /* Create the dialog with PROMPT as title, using DIR as initial @@ -7316,20 +9031,70 @@ DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, result = 0; while (result == 0) { - XEvent event; + XEvent event, copy; 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); - /* Pop down on C-g. */ - if (keysym == XK_g && (event.xkey.state & ControlMask) != 0) - XtUnmanageChild (dialog); - } + if (XtAppPending (Xt_app_con)) + { + XtAppNextEvent (Xt_app_con, &event); + + 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 (&event, FRAME_X_DISPLAY (f)); + (void) x_dispatch_event (©, FRAME_X_DISPLAY (f)); + } } /* Get the result. */ @@ -7374,7 +9139,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 +9152,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 +9213,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 +9277,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 +9465,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 +9483,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 +9515,69 @@ 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-display-set-last-user-time", Fx_display_last_user_time, + Sx_display_set_last_user_time, 1, 2, 0, + doc: /* Set the last user time of TERMINAL to TIME-OBJECT. +TIME-OBJECT is the X server time, in milliseconds, of the last user +interaction. This is the timestamp that `x-get-selection-internal' +will use by default to fetch selection data. +The optional second argument TERMINAL specifies which display to act +on. TERMINAL should be a terminal object, a frame or a display name +(a string). If TERMINAL is omitted or nil, that stands for the +selected frame's display. */) + (Lisp_Object time_object, Lisp_Object terminal) +{ + struct x_display_info *dpyinfo; + Time time; + + dpyinfo = check_x_display_info (terminal); + CONS_TO_INTEGER (time_object, Time, time); + + x_set_last_user_time_from_lisp (dpyinfo, time); + return Qnil; +} + +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 @@ -7813,10 +9624,14 @@ frame_parm_handler x_frame_parm_handlers[] = x_set_wait_for_wm, gui_set_fullscreen, gui_set_font_backend, - gui_set_alpha, + x_set_alpha, x_set_sticky, x_set_tool_bar_position, +#ifdef HAVE_XDBE x_set_inhibit_double_buffering, +#else + NULL, +#endif x_set_undecorated, x_set_parent_frame, x_set_skip_taskbar, @@ -7825,8 +9640,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 +9723,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 +9886,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 @@ -8021,11 +9894,11 @@ default and usually works with most desktops. Some desktop environments however, may refuse to resize a child frame when Emacs is built with GTK3. For those environments, the two settings below are provided. -If this equals the symbol 'hide', Emacs temporarily hides the child +If this equals the symbol `hide', Emacs temporarily hides the child frame during resizing. This approach seems to work reliably, may however induce some flicker when the frame is made visible again. -If this equals the symbol 'resize-mode', Emacs uses GTK's resize mode to +If this equals the symbol `resize-mode', Emacs uses GTK's resize mode to always trigger an immediate resize of the child frame. This method is deprecated by GTK and may not work in future versions of that toolkit. It also may freeze Emacs when used with other desktop environments. It @@ -8038,6 +9911,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 +9974,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 +10002,8 @@ eliminated in future versions of Emacs. */); defsubr (&Sx_show_tip); defsubr (&Sx_hide_tip); defsubr (&Sx_double_buffered_p); + defsubr (&Sx_begin_drag); + defsubr (&Sx_display_set_last_user_time); tip_timer = Qnil; staticpro (&tip_timer); tip_frame = Qnil; @@ -8132,6 +10014,10 @@ eliminated in future versions of Emacs. */); staticpro (&tip_last_string); tip_last_parms = Qnil; staticpro (&tip_last_parms); + tip_dx = Qnil; + staticpro (&tip_dx); + tip_dy = Qnil; + staticpro (&tip_dy); defsubr (&Sx_uses_old_gtk_dialog); #if defined (USE_MOTIF) || defined (USE_GTK) @@ -8142,6 +10028,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..74237e8aa88 100644 --- a/src/xfont.c +++ b/src/xfont.c @@ -295,7 +295,7 @@ xfont_list_pattern (Display *display, const char *pattern, { Lisp_Object list = Qnil; Lisp_Object chars = Qnil; - struct charset *encoding, *repertory = NULL; + struct charset *encoding = NULL, *repertory = NULL; int i, limit, num_fonts; char **names; /* Large enough to decode the longest XLFD (255 bytes). */ @@ -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..6043ef9f94f 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; } @@ -549,18 +643,23 @@ xftfont_end_for_frame (struct frame *f) return 0; } -/* When using X double buffering, the XftDraw structure we build - seems to be useless once a frame is resized, so recreate it on +/* When using X double buffering, the XRender surfaces we create seem + to become useless once the window acting as the front buffer is + resized for an unknown reason (X server bug?), so recreate it on ConfigureNotify and in some other cases. */ +#ifdef HAVE_XDBE static void xftfont_drop_xrender_surfaces (struct frame *f) { - block_input (); if (FRAME_X_DOUBLE_BUFFERED_P (f)) - xftfont_end_for_frame (f); - unblock_input (); + { + block_input (); + xftfont_end_for_frame (f); + unblock_input (); + } } +#endif static bool xftfont_cached_font_ok (struct frame *f, Lisp_Object font_object, @@ -647,35 +746,37 @@ static void syms_of_xftfont_for_pdumper (void); struct font_driver const xftfont_driver = { /* We can't draw a text without device dependent functions. */ - .type = LISPSYM_INITIALLY (Qxft), - .get_cache = xfont_get_cache, - .list = xftfont_list, - .match = xftfont_match, - .list_family = ftfont_list_family, - .open_font = xftfont_open, - .close_font = xftfont_close, - .prepare_face = xftfont_prepare_face, - .done_face = xftfont_done_face, - .has_char = xftfont_has_char, - .encode_char = xftfont_encode_char, - .text_extents = xftfont_text_extents, - .draw = xftfont_draw, - .get_bitmap = ftfont_get_bitmap, - .anchor_point = ftfont_anchor_point, + .type = LISPSYM_INITIALLY (Qxft), + .get_cache = xfont_get_cache, + .list = xftfont_list, + .match = xftfont_match, + .list_family = ftfont_list_family, + .open_font = xftfont_open, + .close_font = xftfont_close, + .prepare_face = xftfont_prepare_face, + .done_face = xftfont_done_face, + .has_char = xftfont_has_char, + .encode_char = xftfont_encode_char, + .text_extents = xftfont_text_extents, + .draw = xftfont_draw, + .get_bitmap = ftfont_get_bitmap, + .anchor_point = ftfont_anchor_point, #ifdef HAVE_LIBOTF - .otf_capability = ftfont_otf_capability, + .otf_capability = ftfont_otf_capability, #endif - .end_for_frame = xftfont_end_for_frame, + .end_for_frame = xftfont_end_for_frame, #if defined HAVE_M17N_FLT && defined HAVE_LIBOTF - .shape = xftfont_shape, + .shape = xftfont_shape, #endif #if defined HAVE_OTF_GET_VARIATION_GLYPHS || defined HAVE_FT_FACE_GETCHARVARIANTINDEX - .get_variation_glyphs = ftfont_variation_glyphs, + .get_variation_glyphs = ftfont_variation_glyphs, +#endif + .filter_properties = ftfont_filter_properties, + .cached_font_ok = xftfont_cached_font_ok, + .combining_capability = ftfont_combining_capability, +#ifdef HAVE_XDBE + .drop_xrender_surfaces = xftfont_drop_xrender_surfaces, #endif - .filter_properties = ftfont_filter_properties, - .cached_font_ok = xftfont_cached_font_ok, - .combining_capability = ftfont_combining_capability, - .drop_xrender_surfaces = xftfont_drop_xrender_surfaces, }; #ifdef HAVE_HARFBUZZ struct font_driver xfthbfont_driver; @@ -696,6 +797,15 @@ syms_of_xftfont (void) This is needed with some fonts to correct vertical overlap of glyphs. */); xft_font_ascent_descent_override = 0; + DEFVAR_LISP ("xft-color-font-whitelist", Vxft_color_font_whitelist, + doc: /* List of "color" font families that don't actually have color glyphs. +Some fonts (such as Source Code Pro) are reported as color fonts, but +do not actually have glyphs with colors that can cause Xft crashes. + +The font families in this list will not be ignored when +`xft-ignore-color-fonts' is non-nil. */); + Vxft_color_font_whitelist = list1 (build_pure_c_string ("Source Code Pro")); + pdumper_do_now_and_after_load (syms_of_xftfont_for_pdumper); } diff --git a/src/xgselect.c b/src/xgselect.c index 8afd3f238f0..6e09a15fa84 100644 --- a/src/xgselect.c +++ b/src/xgselect.c @@ -28,11 +28,16 @@ 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) +/* The depth of xg_select suppression. */ +static int xg_select_suppress_count; + +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 +48,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) @@ -66,6 +72,23 @@ static void acquire_select_lock (GMainContext *context) #endif } +/* Call this to not use xg_select when using it would be a bad idea, + i.e. during drag-and-drop. */ +void +suppress_xg_select (void) +{ + ++xg_select_suppress_count; +} + +void +release_xg_select (void) +{ + if (!xg_select_suppress_count) + emacs_abort (); + + --xg_select_suppress_count; +} + /* `xg_select' is a `pselect' replacement. Why do we need a separate function? 1. Timeouts. Glib and Gtk rely on timer events. If we did pselect with a greater timeout then the one scheduled by Glib, we would @@ -93,10 +116,23 @@ 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 + + if (xg_select_suppress_count) + return pselect (fds_lim, rfds, wfds, efds, timeout, sigmask); 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 +179,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 +253,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/xgselect.h b/src/xgselect.h index 15482cbf922..156d4bde59f 100644 --- a/src/xgselect.h +++ b/src/xgselect.h @@ -25,9 +25,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ struct timespec; -extern int xg_select (int max_fds, - fd_set *rfds, fd_set *wfds, fd_set *efds, - struct timespec *timeout, sigset_t *sigmask); +extern int xg_select (int, fd_set *, fd_set *, fd_set *, + struct timespec *, sigset_t *); +extern void suppress_xg_select (void); +extern void release_xg_select (void); extern void release_select_lock (void); diff --git a/src/xmenu.c b/src/xmenu.c index 10d6b0f4d72..e5e24b87d16 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 @@ -189,6 +198,10 @@ x_menu_wait_for_event (void *data) struct x_display_info *dpyinfo; int n = 0; + /* ISTM that if timer_check is okay, this should be too, since + both can run random Lisp. */ + x_handle_pending_selection_requests (); + FD_ZERO (&read_fds); for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next) { @@ -213,6 +226,62 @@ 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 = xi_convert_event_state (xev); + copy.xbutton.button = xev->detail; + copy.xbutton.same_screen = True; + + 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 +301,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 +339,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 +350,100 @@ 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 + && XGetEventData (dpyinfo->display, &event.xcookie)) + cookie_claimed_p = true; + + if (event.xcookie.data) + { + switch (event.xgeneric.evtype) + { + case XI_ButtonRelease: + { + 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 = xi_convert_event_state (xev); + 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 + + break; + } + case XI_KeyPress: + { + KeySym keysym; + + 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 = xi_convert_event_state (xev); + 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; + } + } + } + } - x_dispatch_event (&event, event.xany.display); + if (cookie_claimed_p) + XFreeEventData (dpyinfo->display, &event.xcookie); +#endif + + x_dispatch_event (©, copy.xany.display); } } @@ -285,6 +453,9 @@ DEFUN ("x-menu-bar-open-internal", Fx_menu_bar_open_internal, Sx_menu_bar_open_i { XEvent ev; struct frame *f = decode_window_system_frame (frame); +#if defined USE_X_TOOLKIT && defined HAVE_XINPUT2 + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); +#endif Widget menubar; block_input (); @@ -297,12 +468,44 @@ DEFUN ("x-menu-bar-open-internal", Fx_menu_bar_open_internal, Sx_menu_bar_open_i Window child; bool error_p = false; +#if defined USE_X_TOOLKIT && defined HAVE_XINPUT2 + /* 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) + { + /* The keyboard grab matters too, in this specific + case. */ +#ifndef USE_LUCID + if (dpyinfo->devices[i].grab) +#endif + { + XIUngrabDevice (dpyinfo->display, + dpyinfo->devices[i].device_id, + CurrentTime); + dpyinfo->devices[i].grab = 0; + } + } + } +#endif + x_catch_errors (FRAME_X_DISPLAY (f)); memset (&ev, 0, sizeof ev); ev.xbutton.display = FRAME_X_DISPLAY (f); ev.xbutton.window = XtWindow (menubar); ev.xbutton.root = FRAME_DISPLAY_INFO (f)->root_window; +#ifndef HAVE_XINPUT2 ev.xbutton.time = XtLastTimestampProcessed (FRAME_X_DISPLAY (f)); +#else + ev.xbutton.time = ((dpyinfo->supports_xi2 + && xi_frame_selected_for (f, XI_KeyPress)) + ? dpyinfo->last_user_time + : XtLastTimestampProcessed (dpyinfo->display)); +#endif ev.xbutton.button = Button1; ev.xbutton.x = ev.xbutton.y = FRAME_MENUBAR_HEIGHT (f) / 2; ev.xbutton.same_screen = True; @@ -440,7 +643,28 @@ x_activate_menubar (struct frame *f) XPutBackEvent (f->output_data.x->display_info->display, f->output_data.x->saved_menu_event); #else - XtDispatchEvent (f->output_data.x->saved_menu_event); +#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 + /* The cascade button might have been deleted, so don't activate the + popup if it no widget was found to dispatch to. */ + popup_activated_flag + = XtDispatchEvent (f->output_data.x->saved_menu_event); #endif unblock_input (); @@ -721,7 +945,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); @@ -752,8 +976,6 @@ set_frame_menubar (struct frame *f, bool deep_p) /* 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))); @@ -1261,7 +1483,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 +1543,26 @@ 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 + + DEFER_SELECTIONS; + /* Display the menu. */ gtk_widget_show_all (menu); @@ -1363,6 +1605,84 @@ popup_selection_callback (Widget widget, LWLIB_ID id, XtPointer client_data) menu_item_selection = client_data; } + +#ifdef HAVE_XINPUT2 +static void +prepare_for_entry_into_toolkit_menu (struct frame *f) +{ + XIEventMask mask; + ptrdiff_t l = XIMaskLen (XI_LASTEVENT); + unsigned char *m; + Lisp_Object tail, frame; + struct x_display_info *dpyinfo; + + dpyinfo = FRAME_DISPLAY_INFO (f); + + if (!dpyinfo->supports_xi2) + return; + + mask.mask = m = alloca (l); + memset (m, 0, l); + mask.mask_len = l; + + mask.deviceid = XIAllMasterDevices; + + XISetMask (m, XI_Motion); + XISetMask (m, XI_Enter); + XISetMask (m, XI_Leave); + + FOR_EACH_FRAME (tail, frame) + { + f = XFRAME (frame); + + if (FRAME_X_P (f) + && FRAME_DISPLAY_INFO (f) == dpyinfo + && !FRAME_TOOLTIP_P (f)) + XISelectEvents (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + &mask, 1); + } +} + +static void +leave_toolkit_menu (void *data) +{ + XIEventMask mask; + ptrdiff_t l = XIMaskLen (XI_LASTEVENT); + unsigned char *m; + Lisp_Object tail, frame; + struct x_display_info *dpyinfo; + struct frame *f; + + dpyinfo = FRAME_DISPLAY_INFO ((struct frame *) data); + + if (!dpyinfo->supports_xi2) + return; + + 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); + + FOR_EACH_FRAME (tail, frame) + { + f = XFRAME (frame); + + if (FRAME_X_P (f) + && FRAME_DISPLAY_INFO (f) == dpyinfo + && !FRAME_TOOLTIP_P (f)) + XISelectEvents (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + &mask, 1); + } +} +#endif + /* ID is the LWLIB ID of the dialog box. */ static void @@ -1374,6 +1694,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 +1726,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,15 +1783,81 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, XtSetArg (av[ac], (char *) XtNgeometry, 0); ac++; XtSetValues (menu, av, ac); +#ifdef HAVE_XINPUT2 + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + + /* 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) + { + dpyinfo->devices[i].grab = 0; + + XIUngrabDevice (dpyinfo->display, + dpyinfo->devices[i].device_id, + CurrentTime); + } + } + } + +#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 +#endif + +#ifdef HAVE_XINPUT2 + prepare_for_entry_into_toolkit_menu (f); + +#ifdef USE_LUCID + if (dpyinfo->supports_xi2) + x_mouse_leave (dpyinfo); +#endif +#endif /* Display the menu. */ lw_popup_menu (menu, &dummy); + +#ifdef HAVE_XINPUT2 + if (dpyinfo->supports_xi2) + XUngrabServer (dpyinfo->display); +#endif + popup_activated_flag = 1; + x_activate_timeout_atimer (); { - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); + + DEFER_SELECTIONS; record_unwind_protect_int (pop_down_menu, (int) menu_id); +#ifdef HAVE_XINPUT2 + record_unwind_protect_ptr (leave_toolkit_menu, f); +#endif /* Process events that apply to the menu. */ popup_get_selection (0, FRAME_DISPLAY_INFO (f), menu_id, true); @@ -1473,13 +1880,19 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, { 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); + widget_value **submenu_stack; + Lisp_Object *subprefix_stack; int submenu_depth = 0; + specpdl_ref specpdl_count; + + USE_SAFE_ALLOCA; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + submenu_stack = SAFE_ALLOCA (menu_items_used + * sizeof *submenu_stack); + subprefix_stack = SAFE_ALLOCA (menu_items_used + * sizeof *subprefix_stack); + + specpdl_count = SPECPDL_INDEX (); eassert (FRAME_X_P (f)); @@ -1488,6 +1901,7 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, if (menu_items_used <= MENU_ITEMS_PANE_LENGTH) { *error_name = "Empty menu"; + SAFE_FREE (); return Qnil; } @@ -1720,6 +2134,8 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, entry = Fcons (subprefix_stack[j], entry); } unblock_input (); + + SAFE_FREE (); return entry; } i += MENU_ITEMS_ITEM_LENGTH; @@ -1734,6 +2150,8 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, } unblock_input (); + + SAFE_FREE (); return Qnil; } @@ -1766,7 +2184,9 @@ 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 (); + + DEFER_SELECTIONS; record_unwind_protect_ptr (pop_down_menu, menu); /* Display the menu. */ @@ -1821,7 +2241,9 @@ 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 (); + + DEFER_SELECTIONS; /* xdialog_show_unwind is responsible for popping the dialog box down. */ @@ -1853,7 +2275,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 +2427,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 +2548,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)); @@ -2283,18 +2705,18 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, y = max (y, 1); XMenuLocate (FRAME_X_DISPLAY (f), menu, 0, 0, x, y, &ulx, &uly, &width, &height); - if (ulx+width > dispwidth) + if (ulx + width > dispwidth) { x -= (ulx + width) - dispwidth; ulx = dispwidth - width; } - if (uly+height > dispheight) + if (uly + height > dispheight) { y -= (uly + height) - dispheight; uly = dispheight - height; } #ifndef HAVE_X_WINDOWS - if (FRAME_HAS_MINIBUF_P (f) && uly+height > dispheight - 1) + if (FRAME_HAS_MINIBUF_P (f) && uly + height > dispheight - 1) { /* Move the menu away of the echo area, to avoid overwriting the menu with help echo messages or vice versa. */ @@ -2318,8 +2740,8 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, /* If position was not given by a mouse click, adjust so upper left corner of the menu as a whole ends up at given coordinates. This is what x-popup-menu says in its documentation. */ - x += width/2; - y += 1.5*height/(maxlines+2); + x += width / 2; + y += 1.5 * height/ (maxlines + 2); } XMenuSetAEQ (menu, true); @@ -2327,7 +2749,13 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, pane = selidx = 0; #ifndef MSDOS + DEFER_SELECTIONS; + 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 +2764,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/xrdb.c b/src/xrdb.c index 56e07f74a26..faeea04a539 100644 --- a/src/xrdb.c +++ b/src/xrdb.c @@ -383,14 +383,6 @@ x_load_resources (Display *display, const char *xrm_string, XrmDatabase db; char line[256]; -#if defined USE_MOTIF || !(defined USE_CAIRO || defined HAVE_XFT) || !defined USE_LUCID - const char *helv = "-*-helvetica-medium-r-*--*-120-*-*-*-*-iso8859-1"; -#endif - -#ifdef USE_MOTIF - const char *courier = "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1"; -#endif - x_rm_string = XrmStringToQuark (XrmStringType); #ifndef USE_X_TOOLKIT /* pmr@osf.org says this shouldn't be done if USE_X_TOOLKIT. @@ -399,47 +391,7 @@ x_load_resources (Display *display, const char *xrm_string, #endif rdb = XrmGetStringDatabase (""); - /* Add some font defaults. If the font `helv' doesn't exist, widgets - will use some other default font. */ #ifdef USE_MOTIF - - sprintf (line, "%s.pane.background: grey75", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*fontList: %s", myclass, helv); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*menu*background: grey75", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*menubar*background: grey75", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*verticalScrollBar.background: grey75", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*verticalScrollBar.troughColor: grey75", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*horizontalScrollBar.background: grey75", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*horizontalScrollBar.troughColor: grey75", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s.dialog*.background: grey75", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*fsb.Text.background: white", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*fsb.FilterText.background: white", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*fsb*DirList.background: white", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*fsb*ItemsList.background: white", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*fsb*background: grey75", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*fsb.Text.fontList: %s", myclass, courier); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*fsb.FilterText.fontList: %s", myclass, courier); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*fsb*ItemsList.fontList: %s", myclass, courier); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*fsb*DirList.fontList: %s", myclass, courier); - XrmPutLineResource (&rdb, line); - /* Set double click time of list boxes in the file selection dialog from `double-click-time'. */ if (FIXNUMP (Vdouble_click_time) && XFIXNUM (Vdouble_click_time) > 0) @@ -451,15 +403,17 @@ x_load_resources (Display *display, const char *xrm_string, myclass, XFIXNAT (Vdouble_click_time)); XrmPutLineResource (&rdb, line); } - #else /* not USE_MOTIF */ - + /* Add some font defaults. If the font `helv' doesn't exist, + widgets will use some other default font. */ sprintf (line, "Emacs.dialog*.background: grey75"); XrmPutLineResource (&rdb, line); #if !(defined USE_CAIRO || defined HAVE_XFT) || !defined (USE_LUCID) - sprintf (line, "Emacs.dialog*.font: %s", helv); + sprintf (line, "Emacs.dialog*.font: %s", + "-*-helvetica-medium-r-*--*-120-*-*-*-*-iso8859-1"); XrmPutLineResource (&rdb, line); - sprintf (line, "*XlwMenu*font: %s", helv); + sprintf (line, "*XlwMenu*font: %s", + "-*-helvetica-medium-r-*--*-120-*-*-*-*-iso8859-1"); XrmPutLineResource (&rdb, line); #endif sprintf (line, "*XlwMenu*background: grey75"); @@ -468,7 +422,6 @@ x_load_resources (Display *display, const char *xrm_string, XrmPutLineResource (&rdb, line); sprintf (line, "Emacs*horizontalScrollBar.background: grey75"); XrmPutLineResource (&rdb, line); - #endif /* not USE_MOTIF */ user_database = get_user_db (display); @@ -533,11 +486,7 @@ x_get_resource (XrmDatabase rdb, const char *name, const char *class, if (XrmQGetResource (rdb, namelist, classlist, &type, &value) == True && (type == expected_type)) { - if (type == x_rm_string) - ret_value->addr = (char *) value.addr; - else - memcpy (ret_value->addr, value.addr, ret_value->size); - + *ret_value = value; return value.size; } diff --git a/src/xselect.c b/src/xselect.c index cfe028a1696..1750cfb8bd8 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -36,6 +36,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "termhooks.h" #include "keyboard.h" #include "pdumper.h" +#include "atimer.h" #include <X11/Xproto.h> @@ -44,7 +45,7 @@ struct selection_data; static void x_decline_selection_request (struct selection_input_event *); static bool x_convert_selection (Lisp_Object, Lisp_Object, Atom, bool, - struct x_display_info *); + struct x_display_info *, bool); static bool waiting_for_other_props_on_window (Display *, Window); static struct prop_location *expect_property_change (Display *, Window, Atom, int); @@ -52,12 +53,14 @@ 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); static void lisp_data_to_selection_data (struct x_display_info *, Lisp_Object, struct selection_data *); +static void x_send_client_event (Lisp_Object, Lisp_Object, Lisp_Object, + Atom, Lisp_Object, Lisp_Object); /* Printing traces to stderr. */ @@ -98,132 +101,81 @@ 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); } -#define LOCAL_SELECTION(selection_symbol,dpyinfo) \ +#define LOCAL_SELECTION(selection_symbol, dpyinfo) \ assq_no_quit (selection_symbol, dpyinfo->terminal->Vselection_alist) -/* Define a queue to save up SELECTION_REQUEST_EVENT events for later - handling. */ - -struct selection_event_queue - { - struct selection_input_event event; - struct selection_event_queue *next; - }; - -static struct selection_event_queue *selection_queue; - -/* Nonzero means queue up SELECTION_REQUEST_EVENT events. */ - -static int x_queue_selection_requests; - -/* True if the input events are duplicates. */ - -static bool -selection_input_event_equal (struct selection_input_event *a, - struct selection_input_event *b) -{ - return (a->kind == b->kind && a->dpyinfo == b->dpyinfo - && a->requestor == b->requestor && a->selection == b->selection - && a->target == b->target && a->property == b->property - && a->time == b->time); -} - -/* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later. */ - -static void -x_queue_event (struct selection_input_event *event) -{ - struct selection_event_queue *queue_tmp; - - /* Don't queue repeated requests. - This only happens for large requests which uses the incremental protocol. */ - for (queue_tmp = selection_queue; queue_tmp; queue_tmp = queue_tmp->next) - { - if (selection_input_event_equal (event, &queue_tmp->event)) - { - TRACE1 ("DECLINE DUP SELECTION EVENT %p", queue_tmp); - x_decline_selection_request (event); - return; - } - } - - queue_tmp = xmalloc (sizeof *queue_tmp); - TRACE1 ("QUEUE SELECTION EVENT %p", queue_tmp); - queue_tmp->event = *event; - queue_tmp->next = selection_queue; - selection_queue = queue_tmp; -} - -/* Start queuing SELECTION_REQUEST_EVENT events. */ - -static void -x_start_queuing_selection_requests (void) -{ - if (x_queue_selection_requests) - emacs_abort (); - - x_queue_selection_requests++; - TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests); -} - -/* Stop queuing SELECTION_REQUEST_EVENT events. */ - -static void -x_stop_queuing_selection_requests (void) -{ - TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests); - --x_queue_selection_requests; - - /* Take all the queued events and put them back - so that they get processed afresh. */ - - while (selection_queue != NULL) - { - struct selection_event_queue *queue_tmp = selection_queue; - TRACE1 ("RESTORE SELECTION EVENT %p", queue_tmp); - kbd_buffer_unget_event (&queue_tmp->event); - selection_queue = queue_tmp->next; - xfree (queue_tmp); - } -} - /* This converts a Lisp symbol to a server Atom, avoiding a server roundtrip whenever possible. */ -static Atom +Atom symbol_to_x_atom (struct x_display_info *dpyinfo, Lisp_Object sym) { Atom val; - if (NILP (sym)) return 0; - if (EQ (sym, QPRIMARY)) return XA_PRIMARY; - if (EQ (sym, QSECONDARY)) return XA_SECONDARY; - if (EQ (sym, QSTRING)) return XA_STRING; - if (EQ (sym, QINTEGER)) return XA_INTEGER; - if (EQ (sym, QATOM)) return XA_ATOM; - if (EQ (sym, QCLIPBOARD)) return dpyinfo->Xatom_CLIPBOARD; - if (EQ (sym, QTIMESTAMP)) return dpyinfo->Xatom_TIMESTAMP; - if (EQ (sym, QTEXT)) return dpyinfo->Xatom_TEXT; - if (EQ (sym, QCOMPOUND_TEXT)) return dpyinfo->Xatom_COMPOUND_TEXT; - if (EQ (sym, QUTF8_STRING)) return dpyinfo->Xatom_UTF8_STRING; - if (EQ (sym, QDELETE)) return dpyinfo->Xatom_DELETE; - if (EQ (sym, QMULTIPLE)) return dpyinfo->Xatom_MULTIPLE; - if (EQ (sym, QINCR)) return dpyinfo->Xatom_INCR; - if (EQ (sym, Q_EMACS_TMP_)) return dpyinfo->Xatom_EMACS_TMP; - if (EQ (sym, QTARGETS)) return dpyinfo->Xatom_TARGETS; - if (EQ (sym, QNULL)) return dpyinfo->Xatom_NULL; - if (!SYMBOLP (sym)) emacs_abort (); + if (NILP (sym)) + return 0; + if (EQ (sym, QPRIMARY)) + return XA_PRIMARY; + if (EQ (sym, QSECONDARY)) + return XA_SECONDARY; + if (EQ (sym, QSTRING)) + return XA_STRING; + if (EQ (sym, QINTEGER)) + return XA_INTEGER; + if (EQ (sym, QATOM)) + return XA_ATOM; + if (EQ (sym, QCLIPBOARD)) + return dpyinfo->Xatom_CLIPBOARD; + if (EQ (sym, QTIMESTAMP)) + return dpyinfo->Xatom_TIMESTAMP; + if (EQ (sym, QTEXT)) + return dpyinfo->Xatom_TEXT; + if (EQ (sym, QCOMPOUND_TEXT)) + return dpyinfo->Xatom_COMPOUND_TEXT; + if (EQ (sym, QUTF8_STRING)) + return dpyinfo->Xatom_UTF8_STRING; + if (EQ (sym, QDELETE)) + return dpyinfo->Xatom_DELETE; + if (EQ (sym, QMULTIPLE)) + return dpyinfo->Xatom_MULTIPLE; + if (EQ (sym, QINCR)) + return dpyinfo->Xatom_INCR; + if (EQ (sym, Q_EMACS_TMP_)) + return dpyinfo->Xatom_EMACS_TMP; + if (EQ (sym, QTARGETS)) + return dpyinfo->Xatom_TARGETS; + if (EQ (sym, QNULL)) + return dpyinfo->Xatom_NULL; + if (EQ (sym, QXdndSelection)) + return dpyinfo->Xatom_XdndSelection; + if (EQ (sym, QXmTRANSFER_SUCCESS)) + return dpyinfo->Xatom_XmTRANSFER_SUCCESS; + if (EQ (sym, QXmTRANSFER_FAILURE)) + return dpyinfo->Xatom_XmTRANSFER_FAILURE; + if (EQ (sym, QXdndDirectSave0)) + return dpyinfo->Xatom_XdndDirectSave0; + if (EQ (sym, Qtext_plain)) + return dpyinfo->Xatom_text_plain; + if (EQ (sym, QXdndActionDirectSave)) + return dpyinfo->Xatom_XdndActionDirectSave; + + if (!SYMBOLP (sym)) + emacs_abort (); TRACE1 (" XInternAtom %s", SSDATA (SYMBOL_NAME (sym))); block_input (); - val = XInternAtom (dpyinfo->display, SSDATA (SYMBOL_NAME (sym)), False); + val = x_intern_cached_atom (dpyinfo, SSDATA (SYMBOL_NAME (sym)), false); unblock_input (); return val; } @@ -232,7 +184,7 @@ symbol_to_x_atom (struct x_display_info *dpyinfo, Lisp_Object sym) /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips and calls to intern whenever possible. */ -static Lisp_Object +Lisp_Object x_atom_to_symbol (struct x_display_info *dpyinfo, Atom atom) { char *str; @@ -279,36 +231,55 @@ 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; + if (atom == dpyinfo->Xatom_XmTRANSFER_SUCCESS) + return QXmTRANSFER_SUCCESS; + if (atom == dpyinfo->Xatom_XmTRANSFER_FAILURE) + return QXmTRANSFER_FAILURE; + if (atom == dpyinfo->Xatom_XdndDirectSave0) + return QXdndDirectSave0; + if (atom == dpyinfo->Xatom_text_plain) + return Qtext_plain; + if (atom == dpyinfo->Xatom_XdndActionDirectSave) + return QXdndActionDirectSave; - block_input (); - str = XGetAtomName (dpyinfo->display, atom); - unblock_input (); + x_catch_errors (dpyinfo->display); + str = x_get_atom_name (dpyinfo, atom, NULL); + x_uncatch_errors (); + + TRACE0 ("XGetAtomName --> NULL"); + if (!str) + return Qnil; TRACE1 ("XGetAtomName --> %s", str); - if (! str) return Qnil; + val = intern (str); - block_input (); - /* This was allocated by Xlib, so use XFree. */ - XFree (str); - unblock_input (); + xfree (str); return val; } /* Do protocol to assert ourself as a selection owner. FRAME shall be the owner; it must be a valid X frame. + TIMESTAMP should be the timestamp where selection ownership will be + assumed. + DND_DATA is the local value that will be used for selection requests + with `dpyinfo->pending_dnd_time'. 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) + Lisp_Object frame, Lisp_Object dnd_data, Time timestamp) { struct frame *f = XFRAME (frame); Window selecting_window = FRAME_X_WINDOW (f); struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); Display *display = dpyinfo->display; - Time timestamp = dpyinfo->last_user_time; Atom selection_atom = symbol_to_x_atom (dpyinfo, selection_name); + if (!timestamp) + timestamp = dpyinfo->last_user_time; + block_input (); x_catch_errors (display); XSetSelectionOwner (display, selection_atom, selecting_window, timestamp); @@ -321,8 +292,9 @@ x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value, Lisp_Object selection_data; Lisp_Object prev_value; - selection_data = list4 (selection_name, selection_value, - INT_TO_INTEGER (timestamp), frame); + selection_data = list5 (selection_name, selection_value, + INT_TO_INTEGER (timestamp), frame, + dnd_data); prev_value = LOCAL_SELECTION (selection_name, dpyinfo); tset_selection_alist @@ -352,18 +324,33 @@ x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value, This function is used both for remote requests (LOCAL_REQUEST is zero) and for local x-get-selection-internal (LOCAL_REQUEST is nonzero). + If LOCAL_VALUE is non-nil, use it as the local copy. Also allow + quitting in that case, and let DPYINFO be NULL. + + If NEED_ALTERNATE is true, use the drag-and-drop local value + instead. + This calls random Lisp code, and may signal or gc. */ static Lisp_Object x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type, - bool local_request, struct x_display_info *dpyinfo) + bool local_request, struct x_display_info *dpyinfo, + Lisp_Object local_value, bool need_alternate) { - Lisp_Object local_value; + Lisp_Object tem; Lisp_Object handler_fn, value, check; + bool may_quit; + specpdl_ref count; - local_value = LOCAL_SELECTION (selection_symbol, dpyinfo); + may_quit = false; - if (NILP (local_value)) return Qnil; + if (NILP (local_value)) + local_value = LOCAL_SELECTION (selection_symbol, dpyinfo); + else + may_quit = true; + + if (NILP (local_value)) + return Qnil; /* TIMESTAMP is a special case. */ if (EQ (target_type, QTIMESTAMP)) @@ -376,16 +363,38 @@ 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 (); - specbind (Qinhibit_quit, Qt); + count = SPECPDL_INDEX (); + + if (!may_quit) + 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 (!need_alternate) + tem = XCAR (XCDR (local_value)); + else + tem = XCAR (XCDR (XCDR (XCDR (XCDR (local_value))))); + + if (STRINGP (tem)) + { + local_value = Fget_text_property (make_fixnum (0), + target_type, tem); + + if (!NILP (local_value)) + tem = local_value; + } + if (!NILP (handler_fn)) - value = call3 (handler_fn, - selection_symbol, (local_request ? Qnil : target_type), - XCAR (XCDR (local_value))); + value = call3 (handler_fn, selection_symbol, + ((local_request + && NILP (Vx_treat_local_requests_remotely)) + ? Qnil + : target_type), + tem); else value = Qnil; value = unbind_to (count, value); @@ -428,10 +437,19 @@ static void x_decline_selection_request (struct selection_input_event *event) { XEvent reply_base; - XSelectionEvent *reply = &(reply_base.xselection); + XSelectionEvent *reply; + Display *dpy; + struct x_display_info *dpyinfo; + + reply = &(reply_base.xselection); + dpy = SELECTION_EVENT_DISPLAY (event); + dpyinfo = x_display_info_for_display (dpy); + + if (!dpyinfo) + return; reply->type = SelectionNotify; - reply->display = SELECTION_EVENT_DISPLAY (event); + reply->display = dpy; reply->requestor = SELECTION_EVENT_REQUESTOR (event); reply->selection = SELECTION_EVENT_SELECTION (event); reply->time = SELECTION_EVENT_TIME (event); @@ -441,21 +459,15 @@ x_decline_selection_request (struct selection_input_event *event) /* The reason for the error may be that the receiver has died in the meantime. Handle that case. */ block_input (); - x_catch_errors (reply->display); - XSendEvent (reply->display, reply->requestor, False, 0, &reply_base); - XFlush (reply->display); - x_uncatch_errors (); + x_ignore_errors_for_next_request (dpyinfo); + XSendEvent (dpyinfo->display, reply->requestor, + False, 0, &reply_base); + x_stop_ignoring_errors (dpyinfo); + + XFlush (dpyinfo->display); unblock_input (); } -/* This is the selection request currently being processed. - It is set to zero when the request is fully processed. */ -static struct selection_input_event *x_selection_current_request; - -/* Display info in x_selection_request. */ - -static struct x_display_info *selection_request_dpyinfo; - /* Raw selection data, for sending to a requestor window. */ struct selection_data @@ -473,12 +485,59 @@ struct selection_data struct selection_data *next; }; -/* Linked list of the above (in support of MULTIPLE targets). */ +struct x_selection_request +{ + /* The last element in this stack. */ + struct x_selection_request *last; + + /* Its display info. */ + struct x_display_info *dpyinfo; + + /* Its selection input event. */ + struct selection_input_event *request; + + /* Linked list of the above (in support of MULTIPLE targets). */ + struct selection_data *converted_selections; + + /* "Data" to send a requestor for a failed MULTIPLE subtarget. */ + Atom conversion_fail_tag; + + /* Whether or not conversion was successful. */ + bool converted; +}; + +/* Stack of selections currently being processed. + NULL if all requests have been fully processed. */ + +struct x_selection_request *selection_request_stack; + +static void +x_push_current_selection_request (struct selection_input_event *se, + struct x_display_info *dpyinfo) +{ + struct x_selection_request *frame; + + frame = xmalloc (sizeof *frame); + frame->converted = false; + frame->last = selection_request_stack; + frame->request = se; + frame->dpyinfo = dpyinfo; + frame->converted_selections = NULL; + frame->conversion_fail_tag = None; -static struct selection_data *converted_selections; + selection_request_stack = frame; +} -/* "Data" to send a requestor for a failed MULTIPLE subtarget. */ -static Atom conversion_fail_tag; +static void +x_pop_current_selection_request (void) +{ + struct x_selection_request *tem; + + tem = selection_request_stack; + selection_request_stack = selection_request_stack->last; + + xfree (tem); +} /* Used as an unwind-protect clause so that, if a selection-converter signals an error, we tell the requestor that we were unable to do what they wanted @@ -488,19 +547,21 @@ static void x_selection_request_lisp_error (void) { struct selection_data *cs, *next; + struct x_selection_request *frame; + + frame = selection_request_stack; - for (cs = converted_selections; cs; cs = next) + for (cs = frame->converted_selections; cs; cs = next) { next = cs->next; if (! cs->nofree && cs->data) xfree (cs->data); xfree (cs); } - converted_selections = NULL; + frame->converted_selections = NULL; - if (x_selection_current_request != 0 - && selection_request_dpyinfo->display) - x_decline_selection_request (x_selection_current_request); + if (!frame->converted && frame->dpyinfo->display) + x_decline_selection_request (frame->request); } static void @@ -564,8 +625,11 @@ 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; + struct x_selection_request *frame; + + frame = selection_request_stack; reply->type = SelectionNotify; reply->display = display; @@ -589,7 +653,7 @@ x_reply_selection_request (struct selection_input_event *event, (section 2.7.2 of ICCCM). Note that we store the data for a MULTIPLE request in the opposite order; the ICCM says only that the conversion itself must be done in the same order. */ - for (cs = converted_selections; cs; cs = cs->next) + for (cs = frame->converted_selections; cs; cs = cs->next) { if (cs->property == None) continue; @@ -644,7 +708,7 @@ x_reply_selection_request (struct selection_input_event *event, be improved; there's a chance of deadlock if more than one subtarget in a MULTIPLE selection requires an INCR transfer, and the requestor and Emacs loop waiting on different transfers. */ - for (cs = converted_selections; cs; cs = cs->next) + for (cs = frame->converted_selections; cs; cs = cs->next) if (cs->wait_object) { int format_bytes = cs->format / 8; @@ -749,7 +813,6 @@ static void x_handle_selection_request (struct selection_input_event *event) { Time local_selection_time; - struct x_display_info *dpyinfo = SELECTION_EVENT_DPYINFO (event); Atom selection = SELECTION_EVENT_SELECTION (event); Lisp_Object selection_symbol = x_atom_to_symbol (dpyinfo, selection); @@ -758,9 +821,32 @@ 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 (); + bool pushed, use_alternate; + Lisp_Object alias, tem; + + alias = Vx_selection_alias_alist; - if (!dpyinfo) goto DONE; + FOR_EACH_TAIL_SAFE (alias) + { + tem = Qnil; + + if (CONSP (alias)) + tem = XCAR (alias); + + if (CONSP (tem) + && EQ (XCAR (tem), selection_symbol) + && SYMBOLP (XCDR (tem))) + { + selection_symbol = XCDR (tem); + break; + } + } + + pushed = false; + + if (!dpyinfo) + goto REALLY_DONE; local_selection_data = LOCAL_SELECTION (selection_symbol, dpyinfo); @@ -774,14 +860,23 @@ x_handle_selection_request (struct selection_input_event *event) && local_selection_time > SELECTION_EVENT_TIME (event)) goto DONE; - x_selection_current_request = event; - selection_request_dpyinfo = dpyinfo; - record_unwind_protect_void (x_selection_request_lisp_error); + use_alternate = false; - /* We might be able to handle nested x_handle_selection_requests, - but this is difficult to test, and seems unimportant. */ - x_start_queuing_selection_requests (); - record_unwind_protect_void (x_stop_queuing_selection_requests); + /* This is how the XDND protocol recommends dropping text onto a + target that doesn't support XDND. */ + if (dpyinfo->pending_dnd_time + && ((SELECTION_EVENT_TIME (event) + == dpyinfo->pending_dnd_time + 1) + || (SELECTION_EVENT_TIME (event) + == dpyinfo->pending_dnd_time + 2))) + use_alternate = true; + + block_input (); + pushed = true; + x_push_current_selection_request (event, dpyinfo); + record_unwind_protect_void (x_pop_current_selection_request); + record_unwind_protect_void (x_selection_request_lisp_error); + unblock_input (); TRACE2 ("x_handle_selection_request: selection=%s, target=%s", SDATA (SYMBOL_NAME (selection_symbol)), @@ -795,11 +890,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 +907,20 @@ 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, + use_alternate); + 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 @@ -824,23 +929,29 @@ x_handle_selection_request (struct selection_input_event *event) property = SELECTION_EVENT_TARGET (event); success = x_convert_selection (selection_symbol, target_symbol, property, - false, dpyinfo); + false, dpyinfo, + use_alternate); } DONE: + if (pushed) + selection_request_stack->converted = true; + if (success) x_reply_selection_request (event, dpyinfo); else x_decline_selection_request (event); - x_selection_current_request = 0; /* Run the `x-sent-selection-functions' abnormal hook. */ if (!NILP (Vx_sent_selection_functions) - && !EQ (Vx_sent_selection_functions, Qunbound)) + && !BASE_EQ (Vx_sent_selection_functions, Qunbound)) CALLN (Frun_hook_with_args, Qx_sent_selection_functions, selection_symbol, target_symbol, success ? Qt : Qnil); + /* Used to punt when dpyinfo is NULL. */ + REALLY_DONE: + unbind_to (count, Qnil); } @@ -854,14 +965,18 @@ x_handle_selection_request (struct selection_input_event *event) static bool x_convert_selection (Lisp_Object selection_symbol, Lisp_Object target_symbol, Atom property, - bool for_multiple, struct x_display_info *dpyinfo) + bool for_multiple, struct x_display_info *dpyinfo, + bool use_alternate) { Lisp_Object lisp_selection; struct selection_data *cs; + struct x_selection_request *frame; lisp_selection = x_get_local_selection (selection_symbol, target_symbol, - false, dpyinfo); + false, dpyinfo, Qnil, use_alternate); + + frame = selection_request_stack; /* A nil return value means we can't perform the conversion. */ if (NILP (lisp_selection) @@ -870,15 +985,16 @@ x_convert_selection (Lisp_Object selection_symbol, if (for_multiple) { cs = xmalloc (sizeof *cs); - cs->data = (unsigned char *) &conversion_fail_tag; + cs->data = ((unsigned char *) + &selection_request_stack->conversion_fail_tag); cs->size = 1; cs->format = 32; cs->type = XA_ATOM; cs->nofree = true; cs->property = property; cs->wait_object = NULL; - cs->next = converted_selections; - converted_selections = cs; + cs->next = frame->converted_selections; + frame->converted_selections = cs; } return false; @@ -890,8 +1006,8 @@ x_convert_selection (Lisp_Object selection_symbol, cs->nofree = true; cs->property = property; cs->wait_object = NULL; - cs->next = converted_selections; - converted_selections = cs; + cs->next = frame->converted_selections; + frame->converted_selections = cs; lisp_data_to_selection_data (dpyinfo, lisp_selection, cs); return true; } @@ -949,6 +1065,12 @@ x_handle_selection_clear (struct selection_input_event *event) /* Run the `x-lost-selection-functions' abnormal hook. */ CALLN (Frun_hook_with_args, Qx_lost_selection_functions, selection_symbol); + /* If Emacs lost ownership of XdndSelection during drag-and-drop, + there is no point in continuing the drag-and-drop session. */ + if (x_dnd_in_progress + && EQ (selection_symbol, QXdndSelection)) + error ("Lost ownership of XdndSelection"); + redisplay_preserve_echo_area (20); } @@ -958,8 +1080,6 @@ x_handle_selection_event (struct selection_input_event *event) TRACE0 ("x_handle_selection_event"); if (event->kind != SELECTION_REQUEST_EVENT) x_handle_selection_clear (event); - else if (x_queue_selection_requests) - x_queue_event (event); else x_handle_selection_request (event); } @@ -971,20 +1091,23 @@ x_handle_selection_event (struct selection_input_event *event) void x_clear_frame_selections (struct frame *f) { - Lisp_Object frame; - Lisp_Object rest; + Lisp_Object frame, rest, lost; struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); struct terminal *t = dpyinfo->terminal; XSETFRAME (frame, f); + lost = Qnil; /* Delete elements from the beginning of Vselection_alist. */ while (CONSP (t->Vselection_alist) && EQ (frame, XCAR (XCDR (XCDR (XCDR (XCAR (t->Vselection_alist))))))) { - /* Run the `x-lost-selection-functions' abnormal hook. */ - CALLN (Frun_hook_with_args, Qx_lost_selection_functions, - Fcar (Fcar (t->Vselection_alist))); + if (!x_auto_preserve_selections) + /* Run the `x-lost-selection-functions' abnormal hook. */ + CALLN (Frun_hook_with_args, Qx_lost_selection_functions, + Fcar (Fcar (t->Vselection_alist))); + else + lost = Fcons (Fcar (t->Vselection_alist), lost); tset_selection_alist (t, XCDR (t->Vselection_alist)); } @@ -994,11 +1117,18 @@ x_clear_frame_selections (struct frame *f) if (CONSP (XCDR (rest)) && EQ (frame, XCAR (XCDR (XCDR (XCDR (XCAR (XCDR (rest)))))))) { - CALLN (Frun_hook_with_args, Qx_lost_selection_functions, - XCAR (XCAR (XCDR (rest)))); + if (!x_auto_preserve_selections) + CALLN (Frun_hook_with_args, Qx_lost_selection_functions, + XCAR (XCAR (XCDR (rest)))); + else + lost = Fcons (XCAR (XCDR (rest)), lost); + XSETCDR (rest, XCDR (XCDR (rest))); break; } + + if (x_auto_preserve_selections) + x_preserve_selections (dpyinfo, lost, frame); } /* True if any properties for DISPLAY and WINDOW @@ -1073,7 +1203,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); @@ -1089,8 +1219,13 @@ wait_for_property_change (struct prop_location *location) intmax_t secs = timeout / 1000; int nsecs = (timeout % 1000) * 1000000; TRACE2 (" Waiting %"PRIdMAX" secs, %d nsecs", secs, nsecs); - wait_reading_process_output (secs, nsecs, 0, false, - property_change_reply, NULL, 0); + + if (!input_blocked_p ()) + wait_reading_process_output (secs, nsecs, 0, false, + property_change_reply, NULL, 0); + else + x_wait_for_cell_change (property_change_reply, + make_timespec (secs, nsecs)); if (NILP (XCAR (property_change_reply))) { @@ -1133,6 +1268,20 @@ x_handle_property_notify (const XPropertyEvent *event) } } +static void +x_display_selection_waiting_message (struct atimer *timer) +{ + Lisp_Object val; + + val = build_string ("Waiting for reply from selection owner..."); + message3_nolog (val); +} + +static void +x_cancel_atimer (void *atimer) +{ + cancel_atimer (atimer); +} /* Variables for communication with x_handle_selection_notify. */ @@ -1158,9 +1307,14 @@ x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type, Atom type_atom = (CONSP (target_type) ? symbol_to_x_atom (dpyinfo, XCAR (target_type)) : symbol_to_x_atom (dpyinfo, target_type)); + struct atimer *delayed_message; + struct timespec message_interval; + specpdl_ref count; + + count = SPECPDL_INDEX (); if (!FRAME_LIVE_P (f)) - return Qnil; + return unbind_to (count, Qnil); if (! NILP (time_stamp)) CONS_TO_INTEGER (time_stamp, Time, requestor_time); @@ -1192,25 +1346,53 @@ x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type, unblock_input (); + message_interval = make_timespec (1, 0); + delayed_message = start_atimer (ATIMER_RELATIVE, message_interval, + x_display_selection_waiting_message, + NULL); + record_unwind_protect_ptr (x_cancel_atimer, delayed_message); + /* This allows quits. Also, don't wait forever. */ intmax_t timeout = max (0, x_selection_timeout); intmax_t secs = timeout / 1000; int nsecs = (timeout % 1000) * 1000000; - TRACE1 (" Start waiting %"PRIdMAX" secs for SelectionNotify", secs); - wait_reading_process_output (secs, nsecs, 0, false, - reading_selection_reply, NULL, 0); - TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply))); + TRACE1 (" Start waiting %"PRIdMAX" secs for SelectionNotify.", secs); + + if (input_blocked_p ()) + TRACE0 (" Input is blocked."); + else + TRACE1 (" Waiting for %d nsecs in addition.", nsecs); + + /* This function can be called with input blocked inside Xt or GTK + timeouts run inside popup menus, so use a function that works + when input is blocked. Prefer wait_reading_process_output + otherwise, or the toolkit might not get some events. + (bug#22214) */ + if (!input_blocked_p ()) + wait_reading_process_output (secs, nsecs, 0, false, + reading_selection_reply, NULL, 0); + else + x_wait_for_cell_change (reading_selection_reply, + make_timespec (secs, nsecs)); + TRACE1 (" Got event = %s", (!NILP (XCAR (reading_selection_reply)) + ? (SYMBOLP (XCAR (reading_selection_reply)) + ? SSDATA (SYMBOL_NAME (XCAR (reading_selection_reply))) + : "YES") + : "NO")); if (NILP (XCAR (reading_selection_reply))) error ("Timed out waiting for reply from selection owner"); if (EQ (XCAR (reading_selection_reply), Qlambda)) - return Qnil; + return unbind_to (count, Qnil); /* Otherwise, the selection is waiting for us on the requested property. */ - return - x_get_window_property_as_lisp_data (dpyinfo, requestor_window, - target_property, target_type, - selection_atom); + return unbind_to (count, + x_get_window_property_as_lisp_data (dpyinfo, + requestor_window, + target_property, + target_type, + selection_atom, + false)); } /* Subroutines of x_get_window_property_as_lisp_data */ @@ -1461,7 +1643,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 +1660,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 +1684,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 +1700,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. */ @@ -1855,9 +2043,9 @@ clean_local_selection_data (Lisp_Object obj) && INTEGERP (XCAR (obj)) && FIXNUMP (XCDR (obj))) { - if (EQ (XCAR (obj), make_fixnum (0))) + if (BASE_EQ (XCAR (obj), make_fixnum (0))) return XCDR (obj); - if (EQ (XCAR (obj), make_fixnum (-1))) + if (BASE_EQ (XCAR (obj), make_fixnum (-1))) return make_fixnum (- XFIXNUM (XCDR (obj))); } if (VECTORP (obj)) @@ -1888,7 +2076,7 @@ x_handle_selection_notify (const XSelectionEvent *event) if (event->selection != reading_which_selection) return; - TRACE0 ("Received SelectionNotify"); + TRACE1 ("Received SelectionNotify: %d", (int) event->property); XSETCAR (reading_selection_reply, (event->property != 0 ? Qt : Qlambda)); } @@ -1962,7 +2150,7 @@ On Nextstep, FRAME is unused. */) CHECK_SYMBOL (selection); if (NILP (value)) error ("VALUE may not be nil"); - x_own_selection (selection, value, frame); + x_own_selection (selection, value, frame, Qnil, 0); return value; } @@ -1990,17 +2178,29 @@ On Nextstep, TIME-STAMP and TERMINAL are unused. */) Lisp_Object time_stamp, Lisp_Object terminal) { Lisp_Object val = Qnil; + Lisp_Object maybe_alias; struct frame *f = frame_for_x_selection (terminal); CHECK_SYMBOL (selection_symbol); CHECK_SYMBOL (target_type); + if (EQ (target_type, QMULTIPLE)) error ("Retrieving MULTIPLE selections is currently unimplemented"); if (!f) error ("X selection unavailable for this frame"); + /* Quitting inside this function is okay, so we don't have to use + FOR_EACH_TAIL_SAFE. */ + maybe_alias = Fassq (selection_symbol, Vx_selection_alias_alist); + + if (!NILP (maybe_alias)) + { + selection_symbol = XCDR (maybe_alias); + CHECK_SYMBOL (selection_symbol); + } + val = x_get_local_selection (selection_symbol, target_type, true, - FRAME_DISPLAY_INFO (f)); + FRAME_DISPLAY_INFO (f), Qnil, false); if (NILP (val) && FRAME_LIVE_P (f)) { @@ -2142,6 +2342,49 @@ On Nextstep, TERMINAL is unused. */) return (owner ? Qt : Qnil); } +DEFUN ("x-get-local-selection", Fx_get_local_selection, Sx_get_local_selection, + 0, 2, 0, + doc: /* Run selection converters for VALUE, and return the result. +TARGET is the selection target that is used to find a suitable +converter. VALUE is a list of 4 values NAME, SELECTION-VALUE, +TIMESTAMP and FRAME. NAME is the name of the selection that will be +passed to selection converters, SELECTION-VALUE is the value of the +selection used by the converter, TIMESTAMP is not meaningful (but must +be a number that fits in an X timestamp), and FRAME is the frame +describing the terminal for which the selection converter will be +run. */) + (Lisp_Object value, Lisp_Object target) +{ + Time time; + Lisp_Object name, timestamp, frame, result; + + CHECK_SYMBOL (target); + + /* Check that VALUE has 4 elements, for x_get_local_selection. */ + Lisp_Object v = value; CHECK_CONS (v); + name = XCAR (v); v = XCDR (v); CHECK_CONS (v); + v = XCDR (v); CHECK_CONS (v); + timestamp = XCAR (v); v = XCDR (v); CHECK_CONS (v); + frame = XCAR (v); + + CHECK_SYMBOL (name); + CONS_TO_INTEGER (timestamp, Time, time); + check_window_system (decode_live_frame (frame)); + + result = x_get_local_selection (name, target, true, + NULL, value, false); + + if (CONSP (result) && SYMBOLP (XCAR (result))) + { + result = XCDR (result); + + if (CONSP (result) && NILP (XCDR (result))) + result = XCAR (result); + } + + return clean_local_selection_data (result); +} + /* Send clipboard manager a SAVE_TARGETS request with a UTF8_STRING property (https://www.freedesktop.org/wiki/ClipboardManager/). */ @@ -2389,28 +2632,29 @@ If the value is 0 or the atom is not known, return the empty string. */) (Lisp_Object value, Lisp_Object frame) { struct frame *f = decode_window_system_frame (frame); - char *name = 0; - char empty[] = ""; - Lisp_Object ret = Qnil; Display *dpy = FRAME_X_DISPLAY (f); + struct x_display_info *dpyinfo; Atom atom; - bool had_errors_p; + bool had_errors_p, need_sync; + char *name; + Lisp_Object ret; + dpyinfo = FRAME_DISPLAY_INFO (f); CONS_TO_INTEGER (value, Atom, atom); - block_input (); x_catch_errors (dpy); - name = atom ? XGetAtomName (dpy, atom) : empty; - had_errors_p = x_had_errors_p (dpy); + name = x_get_atom_name (dpyinfo, atom, &need_sync); + had_errors_p = need_sync && x_had_errors_p (dpy); x_uncatch_errors_after_check (); - if (!had_errors_p) - ret = build_string (name); + ret = empty_unibyte_string; - if (atom && name) XFree (name); - if (NILP (ret)) ret = empty_unibyte_string; - - unblock_input (); + if (name) + { + if (!had_errors_p) + ret = build_string (name); + xfree (name); + } return ret; } @@ -2427,13 +2671,13 @@ FRAME is on. If FRAME is nil, the selected frame is used. */) ptrdiff_t i; struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); - if (SYMBOLP (atom)) x_atom = symbol_to_x_atom (dpyinfo, atom); else if (STRINGP (atom)) { block_input (); - x_atom = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (atom), False); + x_atom = x_intern_cached_atom (dpyinfo, SSDATA (atom), + false); unblock_input (); } else @@ -2456,7 +2700,8 @@ FRAME is on. If FRAME is nil, the selected frame is used. */) bool x_handle_dnd_message (struct frame *f, const XClientMessageEvent *event, - struct x_display_info *dpyinfo, struct input_event *bufp) + struct x_display_info *dpyinfo, struct input_event *bufp, + bool root_window_coords, int root_x, int root_y) { Lisp_Object vec; Lisp_Object frame; @@ -2466,6 +2711,7 @@ x_handle_dnd_message (struct frame *f, const XClientMessageEvent *event, unsigned char *data = (unsigned char *) event->data.b; int idata[5]; ptrdiff_t i; + Window child_return; for (i = 0; i < dpyinfo->x_dnd_atoms_length; ++i) if (dpyinfo->x_dnd_atoms[i] == event->message_type) break; @@ -2497,7 +2743,15 @@ x_handle_dnd_message (struct frame *f, const XClientMessageEvent *event, event->format, size)); - x_relative_mouse_position (f, &x, &y); + if (!root_window_coords) + x_relative_mouse_position (f, &x, &y); + else + XTranslateCoordinates (dpyinfo->display, + dpyinfo->root_window, + FRAME_X_WINDOW (f), + root_x, root_y, + &x, &y, &child_return); + bufp->kind = DRAG_N_DROP_EVENT; bufp->frame_or_window = frame; bufp->timestamp = CurrentTime; @@ -2533,7 +2787,11 @@ to send. If a value is a string, it is converted to an Atom and the value of the Atom is sent. If a value is a cons, it is converted to a 32 bit number with the high 16 bits from the car and the lower 16 bit from the cdr. If more values than fits into the event is given, the excessive values -are ignored. */) +are ignored. + +Wait for the event to be sent and signal any error, unless +`x-fast-protocol-requests' is non-nil, in which case errors will be +silently ignored. */) (Lisp_Object display, Lisp_Object dest, Lisp_Object from, Lisp_Object message_type, Lisp_Object format, Lisp_Object values) { @@ -2549,7 +2807,7 @@ are ignored. */) return Qnil; } -void +static void x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from, Atom message_type, Lisp_Object format, Lisp_Object values) { @@ -2614,7 +2872,7 @@ x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from, the destination window. But if we are sending to the root window, there is no such client. Then we set the event mask to 0xffffff. The event then goes to clients selecting for events on the root window. */ - x_catch_errors (dpyinfo->display); + x_catch_errors_for_lisp (dpyinfo); { bool propagate = !to_root; long mask = to_root ? 0xffffff : 0; @@ -2622,12 +2880,32 @@ x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from, XSendEvent (dpyinfo->display, wdest, propagate, mask, &event); XFlush (dpyinfo->display); } - x_uncatch_errors (); + x_check_errors_for_lisp (dpyinfo, "Failed to send client event: %s"); + x_uncatch_errors_for_lisp (dpyinfo); unblock_input (); } +/* 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; +} + static void syms_of_xselect_for_pdumper (void); void @@ -2642,6 +2920,7 @@ syms_of_xselect (void) defsubr (&Sx_get_atom_name); defsubr (&Sx_send_client_message); defsubr (&Sx_register_dnd_atom); + defsubr (&Sx_get_local_selection); reading_selection_reply = Fcons (Qnil, Qnil); staticpro (&reading_selection_reply); @@ -2652,11 +2931,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. @@ -2702,6 +2988,23 @@ A value of 0 means wait as long as necessary. This is initialized from the \"*selectionTimeout\" resource. */); x_selection_timeout = 0; + DEFVAR_LISP ("x-treat-local-requests-remotely", Vx_treat_local_requests_remotely, + doc: /* Whether to treat local selection requests as remote ones. + +If non-nil, selection converters for string types (`STRING', +`UTF8_STRING', `COMPOUND_TEXT', etc) will encode the strings, even +when Emacs itself is converting the selection. */); + Vx_treat_local_requests_remotely = Qnil; + + DEFVAR_LISP ("x-selection-alias-alist", Vx_selection_alias_alist, + doc: /* List of selections to alias to another. +It should be an alist of a selection name to another. When a +selection request arrives for the first selection, Emacs will respond +as if the request was meant for the other. + +Note that this does not affect setting or owning selections. */); + Vx_selection_alias_alist = Qnil; + /* QPRIMARY is defined in keyboard.c. */ DEFSYM (QSECONDARY, "SECONDARY"); DEFSYM (QSTRING, "STRING"); @@ -2723,10 +3026,16 @@ A value of 0 means wait as long as necessary. This is initialized from the DEFSYM (QCLIPBOARD_MANAGER, "CLIPBOARD_MANAGER"); DEFSYM (QSAVE_TARGETS, "SAVE_TARGETS"); DEFSYM (QNULL, "NULL"); + DEFSYM (QXdndDirectSave0, "XdndDirectSave0"); + DEFSYM (QXdndActionDirectSave, "XdndActionDirectSave"); + DEFSYM (Qtext_plain, "text/plain"); DEFSYM (Qforeign_selection, "foreign-selection"); DEFSYM (Qx_lost_selection_functions, "x-lost-selection-functions"); DEFSYM (Qx_sent_selection_functions, "x-sent-selection-functions"); + DEFSYM (QXmTRANSFER_SUCCESS, "XmTRANSFER_SUCCESS"); + DEFSYM (QXmTRANSFER_FAILURE, "XmTRANSFER_FAILURE"); + pdumper_do_now_and_after_load (syms_of_xselect_for_pdumper); } @@ -2738,6 +3047,4 @@ syms_of_xselect_for_pdumper (void) property_change_wait_list = 0; prop_location_identifier = 0; property_change_reply = Fcons (Qnil, Qnil); - converted_selections = NULL; - conversion_fail_tag = None; } diff --git a/src/xsettings.c b/src/xsettings.c index 33e46d36048..c29a844e0a8 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, @@ -191,6 +206,11 @@ struct xsettings unsigned seen; }; +#ifdef HAVE_PGTK +/* The cairo font_options as obtained using gsettings. */ +static cairo_font_options_t *font_options; +#endif + #ifdef HAVE_GSETTINGS #define GSETTINGS_SCHEMA "org.gnome.desktop.interface" #define GSETTINGS_TOOL_BAR_STYLE "toolbar-style" @@ -200,11 +220,162 @@ struct xsettings #define GSETTINGS_FONT_NAME "font-name" #endif +#ifdef HAVE_PGTK +#define GSETTINGS_FONT_ANTIALIASING "font-antialiasing" +#define GSETTINGS_FONT_RGBA_ORDER "font-rgba-order" +#define GSETTINGS_FONT_HINTING "font-hinting" +#endif /* The single GSettings instance, or NULL if not connected to GSettings. */ static GSettings *gsettings_client; +#if defined HAVE_PGTK && defined HAVE_GSETTINGS + +static bool +xg_settings_key_valid_p (GSettings *settings, const char *key) +{ +#ifdef GLIB_VERSION_2_32 + GSettingsSchema *schema; + bool rc; + + g_object_get (G_OBJECT (settings), + "settings-schema", &schema, + NULL); + + if (!schema) + return false; + + rc = g_settings_schema_has_key (schema, key); + g_settings_schema_unref (schema); + + return rc; +#else + return false; +#endif +} + +#endif + +#ifdef HAVE_PGTK +/* Store an event for re-rendering of the fonts. */ +static void +store_font_options_changed (void) +{ + if (dpyinfo_valid (first_dpyinfo)) + store_config_changed_event (Qfont_render, + XCAR (first_dpyinfo->name_list_element)); +} + +/* Apply changes in the hinting system setting. */ +static void +apply_gsettings_font_hinting (GSettings *settings) +{ + GVariant *val; + const char *hinting; + + if (!xg_settings_key_valid_p (settings, GSETTINGS_FONT_HINTING)) + return; + + val = g_settings_get_value (settings, GSETTINGS_FONT_HINTING); + + if (val) + { + g_variant_ref_sink (val); + + if (g_variant_is_of_type (val, G_VARIANT_TYPE_STRING)) + { + hinting = g_variant_get_string (val, NULL); + + if (!strcmp (hinting, "full")) + cairo_font_options_set_hint_style (font_options, + CAIRO_HINT_STYLE_FULL); + else if (!strcmp (hinting, "medium")) + cairo_font_options_set_hint_style (font_options, + CAIRO_HINT_STYLE_MEDIUM); + else if (!strcmp (hinting, "slight")) + cairo_font_options_set_hint_style (font_options, + CAIRO_HINT_STYLE_SLIGHT); + else if (!strcmp (hinting, "none")) + cairo_font_options_set_hint_style (font_options, + CAIRO_HINT_STYLE_NONE); + } + g_variant_unref (val); + } +} + +/* Apply changes in the antialiasing system setting. */ +static void +apply_gsettings_font_antialias (GSettings *settings) +{ + GVariant *val; + const char *antialias; + + if (!xg_settings_key_valid_p (settings, GSETTINGS_FONT_ANTIALIASING)) + return; + + val = g_settings_get_value (settings, GSETTINGS_FONT_ANTIALIASING); + + if (val) + { + g_variant_ref_sink (val); + if (g_variant_is_of_type (val, G_VARIANT_TYPE_STRING)) + { + antialias = g_variant_get_string (val, NULL); + + if (!strcmp (antialias, "none")) + cairo_font_options_set_antialias (font_options, + CAIRO_ANTIALIAS_NONE); + else if (!strcmp (antialias, "grayscale")) + cairo_font_options_set_antialias (font_options, + CAIRO_ANTIALIAS_GRAY); + else if (!strcmp (antialias, "rgba")) + cairo_font_options_set_antialias (font_options, + CAIRO_ANTIALIAS_SUBPIXEL); + } + g_variant_unref (val); + } +} + +/* Apply the settings for the rgb element ordering. */ +static void +apply_gsettings_font_rgba_order (GSettings *settings) +{ + GVariant *val; + const char *rgba_order; + + if (!xg_settings_key_valid_p (settings, GSETTINGS_FONT_RGBA_ORDER)) + return; + + val = g_settings_get_value (settings, + GSETTINGS_FONT_RGBA_ORDER); + + if (val) + { + g_variant_ref_sink (val); + + if (g_variant_is_of_type (val, G_VARIANT_TYPE_STRING)) + { + rgba_order = g_variant_get_string (val, NULL); + + if (!strcmp (rgba_order, "rgb")) + cairo_font_options_set_subpixel_order (font_options, + CAIRO_SUBPIXEL_ORDER_RGB); + else if (!strcmp (rgba_order, "bgr")) + cairo_font_options_set_subpixel_order (font_options, + CAIRO_SUBPIXEL_ORDER_BGR); + else if (!strcmp (rgba_order, "vrgb")) + cairo_font_options_set_subpixel_order (font_options, + CAIRO_SUBPIXEL_ORDER_VRGB); + else if (!strcmp (rgba_order, "vbgr")) + cairo_font_options_set_subpixel_order (font_options, + CAIRO_SUBPIXEL_ORDER_VBGR); + } + g_variant_unref (val); + } +} +#endif /* HAVE_PGTK */ + /* Callback called when something changed in GSettings. */ static void @@ -258,6 +429,23 @@ something_changed_gsettingsCB (GSettings *settings, } } #endif /* USE_CAIRO || HAVE_XFT */ +#ifdef HAVE_PGTK + else if (!strcmp (key, GSETTINGS_FONT_ANTIALIASING)) + { + apply_gsettings_font_antialias (settings); + store_font_options_changed (); + } + else if (!strcmp (key, GSETTINGS_FONT_HINTING)) + { + apply_gsettings_font_hinting (settings); + store_font_options_changed (); + } + else if (!strcmp (key, GSETTINGS_FONT_RGBA_ORDER)) + { + apply_gsettings_font_rgba_order (settings); + store_font_options_changed (); + } +#endif /* HAVE_PGTK */ } #endif /* HAVE_GSETTINGS */ @@ -321,10 +509,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 +528,9 @@ get_prop_window (struct x_display_info *dpyinfo) XUngrabServer (dpy); } +#endif + +#ifndef HAVE_PGTK #define PAD(nr) (((nr) + 3) & ~3) @@ -566,13 +758,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 +794,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 +927,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 +961,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 +1005,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. */ @@ -872,6 +1073,16 @@ init_gsettings (void) dupstring (¤t_font, g_variant_get_string (val, NULL)); g_variant_unref (val); } + + /* Only use the gsettings font entries for the Cairo backend + running on PGTK. */ +#ifdef HAVE_PGTK + font_options = cairo_font_options_create (); + apply_gsettings_font_antialias (gsettings_client); + apply_gsettings_font_hinting (gsettings_client); + apply_gsettings_font_rgba_order (gsettings_client); +#endif /* HAVE_PGTK */ + #endif /* USE_CAIRO || HAVE_XFT */ #endif /* HAVE_GSETTINGS */ @@ -940,10 +1151,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 +1171,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 (); } @@ -989,6 +1204,21 @@ xsettings_get_system_normal_font (void) } #endif +#ifdef HAVE_PGTK +/* Return the cairo font options, updated from the gsettings font + config entries. The caller should call cairo_font_options_destroy + on the result. */ +cairo_font_options_t * +xsettings_get_font_options (void) +{ + if (font_options != NULL) + return cairo_font_options_copy (font_options); + else + /* GSettings is not configured. */ + return cairo_font_options_create (); +} +#endif + DEFUN ("font-get-system-normal-font", Ffont_get_system_normal_font, Sfont_get_system_normal_font, 0, 0, 0, @@ -1041,6 +1271,10 @@ syms_of_xsettings (void) gconf_client = NULL; PDUMPER_IGNORE (gconf_client); #endif +#ifdef HAVE_PGTK + font_options = NULL; + PDUMPER_IGNORE (font_options); +#endif DEFSYM (Qmonospace_font_name, "monospace-font-name"); DEFSYM (Qfont_name, "font-name"); diff --git a/src/xsettings.h b/src/xsettings.h index f75bff4a6ae..5e5df37062b 100644 --- a/src/xsettings.h +++ b/src/xsettings.h @@ -20,16 +20,31 @@ 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> +#else +#include <cairo.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); #endif +#ifdef HAVE_PGTK +extern cairo_font_options_t *xsettings_get_font_options (void); +#endif #endif /* XSETTINGS_H */ diff --git a/src/xsmfns.c b/src/xsmfns.c index 199e3ded3dd..7015a8eb633 100644 --- a/src/xsmfns.c +++ b/src/xsmfns.c @@ -522,7 +522,7 @@ Do not call this function yourself. */) { /* We should not do user interaction here, but it is not easy to prevent. Fix this in next version. */ - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); #if false /* This will not be reached, but we want kill-emacs-hook to be run. */ diff --git a/src/xterm.c b/src/xterm.c index 9a8c3e9ad76..1d0e69d32bc 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -20,9 +20,547 @@ 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 + explicitly 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 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 almost entirely + in C. X Windows has several competing drag-and-drop protocols, of + which Emacs supports two on the C level: 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. + + When a drop happens on a window not supporting any protocol + implemented on the C level, the function inside + `x-dnd-unsupported-drop-function' is called with some parameters of + the drop. If it returns non-nil, then Emacs tries to simulate a + drop happening with the primary selection and synthetic button + events (see `x_dnd_do_unsupported_drop'). That function implements + the OffiX drag-and-drop protocol by default. See + `x-dnd-handle-unsupported-drop' in `x-dnd.el' for more details. */ + #include <config.h> #include <stdlib.h> #include <math.h> +#include <signal.h> #include "lisp.h" #include "blockinput.h" @@ -33,6 +571,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 +586,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 +627,10 @@ 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 <c-ctype.h> +#include <byteswap.h> + #include "character.h" #include "coding.h" #include "composite.h" @@ -78,6 +654,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 +670,20 @@ 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> +#include <Xm/CascadeB.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 */ @@ -126,12 +710,26 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #endif #endif +#ifdef USE_GTK +#include <xgselect.h> +#endif + #include "bitmaps/gray.xbm" #ifdef HAVE_XKB #include <X11/XKBlib.h> #endif +/* Although X11/Xlib.h commonly defines the types XErrorHandler and + XIOErrorHandler, they are not in the Xlib spec, so for portability + define and use names with an Emacs_ prefix instead. */ +typedef int (*Emacs_XErrorHandler) (Display *, XErrorEvent *); +typedef int (*Emacs_XIOErrorHandler) (Display *); + +#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 +737,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. */ @@ -166,6 +781,10 @@ static bool toolkit_scroll_bar_interaction; static Time ignore_next_mouse_click_timeout; +/* The display that ignore_next_mouse_click_timeout applies to. */ + +static struct x_display_info *mouse_click_timeout_display; + /* Used locally within XTread_socket. */ static int x_noop_count; @@ -175,8 +794,274 @@ 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 + +#ifdef HAVE_XINPUT2 +#ifndef X_XIGrabDevice +#define X_XIGrabDevice 51 +#endif + +#ifndef X_XIUngrabDevice +#define X_XIUngrabDevice 52 +#endif + +#ifndef X_XIAllowEvents +#define X_XIAllowEvents 53 +#endif +#endif + +/* Queue selection requests in `pending_selection_requests' if more + than 0. */ +static int x_use_pending_selection_requests; + +/* Like `next_kbd_event', but for use in X code. */ +#define X_NEXT_KBD_EVENT(ptr) \ + ((ptr) == kbd_buffer + KBD_BUFFER_SIZE - 1 ? kbd_buffer : (ptr) + 1) + +static void x_push_selection_request (struct selection_input_event *); + +/* Defer selection requests. Between this and + x_release_selection_requests, any selection requests can be + processed by calling `x_handle_pending_selection_requests'. + + Also run through and queue all the selection events already in the + keyboard buffer. */ +void +x_defer_selection_requests (void) +{ + union buffered_input_event *event; + bool between; + + between = false; + + block_input (); + if (!x_use_pending_selection_requests) + { + event = kbd_fetch_ptr; + + while (event != kbd_store_ptr) + { + if (event->ie.kind == SELECTION_REQUEST_EVENT + || event->ie.kind == SELECTION_CLEAR_EVENT) + { + x_push_selection_request (&event->sie); + + /* Mark this selection event as invalid. */ + SELECTION_EVENT_DPYINFO (&event->sie) = NULL; + + /* Move the kbd_fetch_ptr along if doing so would not + result in any other events being skipped. This + avoids exhausting the keyboard buffer with some + over-enthusiastic clipboard managers. */ + if (!between) + { + kbd_fetch_ptr = X_NEXT_KBD_EVENT (event); + + /* `detect_input_pending' will then recompute + whether or not pending input events exist. */ + input_pending = false; + } + } + else + between = true; + + event = X_NEXT_KBD_EVENT (event); + } + } + + x_use_pending_selection_requests++; + unblock_input (); +} + +static void +x_release_selection_requests (void) +{ + x_use_pending_selection_requests--; +} + +void +x_release_selection_requests_and_flush (void) +{ + x_release_selection_requests (); + + if (!x_use_pending_selection_requests) + x_handle_pending_selection_requests (); +} + +struct x_selection_request_event +{ + /* The selection request event. */ + struct selection_input_event se; + + /* The next unprocessed selection request event. */ + struct x_selection_request_event *next; +}; + +/* Chain of unprocessed selection request events. Used to handle + selection requests inside long-lasting modal event loops, such as + the drag-and-drop loop. */ + +struct x_selection_request_event *pending_selection_requests; + +/* Compare two request serials A and B with OP, handling + wraparound. */ +#define X_COMPARE_SERIALS(a, op ,b) \ + (((long) (a) - (long) (b)) op 0) + +struct x_atom_ref +{ + /* Atom name. */ + const char *name; + + /* Offset of atom in the display info structure. */ + int offset; +}; + +/* List of all atoms that should be interned when connecting to a + display. */ +static const struct x_atom_ref x_atom_refs[] = + { +#define ATOM_REFS_INIT(string, member) \ + { string, offsetof (struct x_display_info, member) }, + ATOM_REFS_INIT ("WM_PROTOCOLS", Xatom_wm_protocols) + ATOM_REFS_INIT ("WM_TAKE_FOCUS", Xatom_wm_take_focus) + 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) + ATOM_REFS_INIT ("TEXT", Xatom_TEXT) + ATOM_REFS_INIT ("COMPOUND_TEXT", Xatom_COMPOUND_TEXT) + ATOM_REFS_INIT ("UTF8_STRING", Xatom_UTF8_STRING) + ATOM_REFS_INIT ("DELETE", Xatom_DELETE) + 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) + ATOM_REFS_INIT ("_EMACS_DRAG_ATOM", Xatom_EMACS_DRAG_ATOM) + /* For properties of font. */ + ATOM_REFS_INIT ("PIXEL_SIZE", Xatom_PIXEL_SIZE) + ATOM_REFS_INIT ("AVERAGE_WIDTH", Xatom_AVERAGE_WIDTH) + ATOM_REFS_INIT ("_MULE_BASELINE_OFFSET", Xatom_MULE_BASELINE_OFFSET) + ATOM_REFS_INIT ("_MULE_RELATIVE_COMPOSE", Xatom_MULE_RELATIVE_COMPOSE) + ATOM_REFS_INIT ("_MULE_DEFAULT_ASCENT", Xatom_MULE_DEFAULT_ASCENT) + /* Ghostscript support. */ + ATOM_REFS_INIT ("DONE", Xatom_DONE) + ATOM_REFS_INIT ("PAGE", Xatom_PAGE) + ATOM_REFS_INIT ("SCROLLBAR", Xatom_Scrollbar) + ATOM_REFS_INIT ("HORIZONTAL_SCROLLBAR", Xatom_Horizontal_Scrollbar) + ATOM_REFS_INIT ("_XEMBED", Xatom_XEMBED) + /* EWMH */ + ATOM_REFS_INIT ("_NET_WM_STATE", Xatom_net_wm_state) + ATOM_REFS_INIT ("_NET_WM_STATE_FULLSCREEN", Xatom_net_wm_state_fullscreen) + ATOM_REFS_INIT ("_NET_WM_STATE_MAXIMIZED_HORZ", + Xatom_net_wm_state_maximized_horz) + 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", + Xatom_net_window_type_tooltip) + ATOM_REFS_INIT ("_NET_WM_ICON_NAME", Xatom_net_wm_icon_name) + ATOM_REFS_INIT ("_NET_WM_NAME", Xatom_net_wm_name) + ATOM_REFS_INIT ("_NET_SUPPORTED", Xatom_net_supported) + ATOM_REFS_INIT ("_NET_SUPPORTING_WM_CHECK", Xatom_net_supporting_wm_check) + ATOM_REFS_INIT ("_NET_WM_WINDOW_OPACITY", Xatom_net_wm_window_opacity) + ATOM_REFS_INIT ("_NET_ACTIVE_WINDOW", Xatom_net_active_window) + 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) + ATOM_REFS_INIT ("MANAGER", Xatom_xsettings_mgr) + 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) + /* XDS source and target. */ + ATOM_REFS_INIT ("XdndDirectSave0", Xatom_XdndDirectSave0) + ATOM_REFS_INIT ("XdndActionDirectSave", Xatom_XdndActionDirectSave) + ATOM_REFS_INIT ("text/plain", Xatom_text_plain) + /* 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) + /* Old OffiX (a.k.a. old KDE) drop protocol support. */ + ATOM_REFS_INIT ("DndProtocol", Xatom_DndProtocol) + ATOM_REFS_INIT ("_DND_PROTOCOL", Xatom_DND_PROTOCOL) + }; + +enum +{ + X_EVENT_NORMAL, + X_EVENT_GOTO_OUT, + X_EVENT_DROP +}; enum xembed_info { @@ -211,6 +1096,7 @@ static void x_frame_rehighlight (struct x_display_info *); static void x_clip_to_row (struct window *, struct glyph_row *, enum glyph_row_area, GC); static struct scroll_bar *x_window_to_scroll_bar (Display *, Window, int); +static struct frame *x_window_to_frame (struct x_display_info *, int); static void x_scroll_bar_report_motion (struct frame **, Lisp_Object *, enum scroll_bar_part *, Lisp_Object *, Lisp_Object *, @@ -223,9 +1109,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 +1125,3709 @@ 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 +static void x_clean_failable_requests (struct x_display_info *); + +static struct frame *x_tooltip_window_to_frame (struct x_display_info *, + Window, bool *); +static Window x_get_window_below (Display *, Window, int, int, int *, int *); + +/* 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; + +/* That frame, but set when x_dnd_waiting_for_finish is true. Used to + prevent the frame from being deleted inside selection handlers and + other callbacks. */ +struct frame *x_dnd_finish_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. */ +bool x_dnd_waiting_for_finish; + +/* Flag that means (when set in addition to + `x_dnd_waiting_for_finish') to run the unsupported drop function + with the given arguments. */ +static bool x_dnd_run_unsupported_drop_function; + +/* The "before"-time of the unsupported drop. */ +static Time x_dnd_unsupported_drop_time; + +/* The target window of the unsupported drop. */ +static Window x_dnd_unsupported_drop_window; + +/* The Lisp data associated with the unsupported drop function. */ +static Lisp_Object x_dnd_unsupported_drop_data; + +/* Whether or not to move the tooltip along with the mouse pointer + during drag-and-drop. */ +static bool x_dnd_update_tooltip; + +/* Monitor attribute list used for updating the tooltip position. */ +static Lisp_Object x_dnd_monitors; + +/* The display the drop target that is supposed to send information is + on. */ +static Display *x_dnd_finish_display; + +/* 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; + +/* The display the Motif drag receiver will send response data + from. */ +struct x_display_info *x_dnd_waiting_for_motif_finish_display; + +/* 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 Motif drag atom used during the drag-and-drop operation. */ +static Atom x_dnd_motif_atom; + +/* 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 the `XdndTypeList' property has already been set on + the drag frame. */ +static bool x_dnd_init_type_lists; + +/* 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; + +/* Whether or not the last seen window is actually one of our + frames. */ +static bool x_dnd_last_window_is_frame; + +/* 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; + +/* If not None, Emacs is waiting for an XdndStatus event from this + window. */ +static Window x_dnd_waiting_for_status_window; + +/* If .type != 0, an event that should be sent to .xclient.window + upon receiving an XdndStatus event from said window. */ +static XEvent x_dnd_pending_send_position; + +/* If true, send a drop from `x_dnd_finish_frame' to the pending + status window after receiving all pending XdndStatus events. */ +static bool x_dnd_need_send_drop; + +/* The protocol version of any such drop. */ +static int x_dnd_send_drop_proto; + +/* 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 symbol to return from `x-begin-drag' if non-nil. Takes + precedence over `x_dnd_action`. */ +static Lisp_Object x_dnd_action_symbol; + +/* 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; + +/* The set of optional actions available to a Motif drop target + computed at the start of the drag-and-drop operation. */ +static uint8_t x_dnd_motif_operations; + +/* The preferred optional action out of that set. Only takes effect + if `x_dnd_action' is XdndAsk. */ +static uint8_t x_dnd_first_motif_operation; + +/* Array of selection targets available to the drop target. */ +static Atom *x_dnd_targets; + +/* 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 + +/* jmp_buf that gets us out of the IO error handler if an error occurs + terminating DND as part of the display disconnect handler. */ +static sigjmp_buf x_dnd_disconnect_handler; + +/* Whether or not the current invocation of handle_one_xevent + happened inside the drag_and_drop event loop. */ +static bool x_dnd_inside_handle_one_xevent; + +/* The recursive edit depth when the drag-and-drop operation was + started. */ +static int x_dnd_recursion_depth; + +/* The cons cell containing the selection alias between the Motif drag + selection and `XdndSelection'. The car and cdr are only set when + initiating Motif drag-and-drop for the first time. */ +static Lisp_Object x_dnd_selection_alias_cell; + +/* Structure describing a single window that can be the target of + drag-and-drop operations. */ +struct x_client_list_window +{ + /* The window itself. */ + Window window; + + /* The display that window is on. */ + Display *dpy; + + /* Its X and Y coordinates from the root window. */ + int x, y; + + /* The width and height of the window. */ + int width, height; + + /* Whether or not the window is mapped. */ + bool mapped_p; + + /* A bitmask describing events Emacs was listening for from the + window before some extra events were added in + `x_dnd_compute_toplevels'. */ + long previous_event_mask; + + /* The window manager state of the window. */ + unsigned long wm_state; + + /* The next window in this list. */ + struct x_client_list_window *next; + + /* The Motif protocol style of this window, if any. */ + uint8_t xm_protocol_style; + + /* The extents of the frame window in each direction. */ + int frame_extents_left; + int frame_extents_right; + int frame_extents_top; + int frame_extents_bottom; + +#ifdef HAVE_XSHAPE + /* The border width of this window. */ + int border_width; + + /* The rectangles making up the input shape. */ + XRectangle *input_rects; + + /* The number of rectangles composing the input shape. */ + int n_input_rects; + + /* The rectangles making up the bounding shape. */ + XRectangle *bounding_rects; + + /* The number of rectangles composing the bounding shape. */ + int n_bounding_rects; +#endif +}; + +/* List of all toplevels in stacking order, from top to bottom. */ +static struct x_client_list_window *x_dnd_toplevels; + +/* Whether or not the window manager supports the required features + for `x_dnd_toplevels' to work. */ +static bool x_dnd_use_toplevels; + +/* Motif drag-and-drop protocol support. */ + +/* Pointer to a variable which stores whether or not an X error + occured while trying to create the Motif drag window. */ +static volatile bool *xm_drag_window_error; + +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; + +#ifdef ENABLE_CHECKING + +#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; \ + } + +#else +#define SWAPCARD32(l) ((l) = bswap_32 (l)) +#define SWAPCARD16(l) ((l) = bswap_16 (l)) +#endif + +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_drag_motion_reply +{ + /* BYTE */ uint8_t reason; + /* BYTE */ uint8_t byte_order; + + /* CARD16 */ uint16_t side_effects; + /* CARD32 */ uint32_t timestamp; + /* CARD16 */ uint16_t better_x; + /* CARD16 */ uint16_t better_y; +} xm_drag_motion_reply; + +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) + +enum xm_drag_operation + { + XM_DRAG_NOOP = 0, + XM_DRAG_MOVE = (1L << 0), + XM_DRAG_COPY = (1L << 1), + XM_DRAG_LINK = (1L << 2), + XM_DRAG_LINK_REC = 3, + }; + +#define XM_DRAG_OPERATION_IS_LINK(op) ((op) == XM_DRAG_LINK \ + || (op) == XM_DRAG_LINK_REC) + +enum xm_drag_action + { + XM_DROP_ACTION_DROP = 0, + XM_DROP_ACTION_DROP_HELP = 1, + 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) + +enum xm_drag_reason + { + XM_DRAG_REASON_DROP_START = 5, + XM_DRAG_REASON_TOP_LEVEL_ENTER = 0, + XM_DRAG_REASON_TOP_LEVEL_LEAVE = 1, + XM_DRAG_REASON_DRAG_MOTION = 2, + }; + +enum xm_drag_originator + { + XM_DRAG_ORIGINATOR_INITIATOR = 0, + XM_DRAG_ORIGINATOR_RECEIVER = 1, + }; + +enum xm_drag_style + { + /* The values ending with _REC should be treated as equivalent to + the ones without in messages from the receiver. */ + XM_DRAG_STYLE_NONE = 0, + XM_DRAG_STYLE_DROP_ONLY = 1, + XM_DRAG_STYLE_DROP_ONLY_REC = 3, + XM_DRAG_STYLE_DYNAMIC = 5, + XM_DRAG_STYLE_DYNAMIC_REC = 2, + 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) + +enum xm_drop_site_status + { + XM_DROP_SITE_VALID = 3, + XM_DROP_SITE_INVALID = 2, + XM_DROP_SITE_NONE = 1, + }; + +/* The version of the Motif drag-and-drop protocols that Emacs + supports. */ +#define XM_DRAG_PROTOCOL_VERSION 0 + +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; + else if (action == dpyinfo->Xatom_XdndActionAsk) + return x_dnd_first_motif_operation; + + return XM_DRAG_NOOP; +} + +static uint8_t +xm_operations_from_actions (struct x_display_info *dpyinfo, + Atom *ask_actions, int n_ask_actions) +{ + int i; + uint8_t flags; + + flags = 0; + + for (i = 0; i < n_ask_actions; ++i) + { + if (ask_actions[i] == dpyinfo->Xatom_XdndActionCopy) + flags |= XM_DRAG_COPY; + else if (ask_actions[i] == dpyinfo->Xatom_XdndActionMove) + flags |= XM_DRAG_MOVE; + else if (ask_actions[i] == dpyinfo->Xatom_XdndActionLink) + flags |= XM_DRAG_LINK; + } + + return flags; +} + +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 (byteorder != XM_BYTE_ORDER_CUR_FIRST) + SWAPCARD16 (nitems); + + if (length < 2 + nitems * 4) + return NULL; + + 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; + + if (info->byteorder != XM_BYTE_ORDER_CUR_FIRST) + { + SWAPCARD16 (info->table_index); + SWAPCARD16 (info->selection); + } + + *((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 int +xm_drag_window_error_handler (Display *display, XErrorEvent *event) +{ + if (xm_drag_window_error) + *xm_drag_window_error = true; + + return 0; +} + +static _Noreturn int +xm_drag_window_io_error_handler (Display *dpy) +{ + /* DPY isn't created through GDK, so it doesn't matter if we don't + crash here. */ + siglongjmp (x_dnd_disconnect_handler, 1); +} + +/* Determine whether or not WINDOW exists on DPYINFO by selecting for + input from it. */ +static bool +x_special_window_exists_p (struct x_display_info *dpyinfo, + Window window) +{ + bool rc; + + x_catch_errors (dpyinfo->display); + XSelectInput (dpyinfo->display, window, + StructureNotifyMask); + rc = !x_had_errors_p (dpyinfo->display); + x_uncatch_errors_after_check (); + + return rc; +} + +/* Drag window creation strategy (very tricky, but race-free): + + First look for _MOTIF_DRAG_WINDOW. If it is already present, + return it immediately to avoid the overhead of new display + connections. + + Otherwise, create a new connection to the display. In that + connection, create a window, which will be the new drag window. Set + the client disconnect mode of the new connection to + RetainPermanent, and close it. + + Grab the current display. Look up _MOTIF_DRAG_WINDOW, the current + drag window. If it exists (which means _MOTIF_DRAG_WINDOW was + created between the first step and now), kill the client that + created the new drag window to free the client slot on the X + server. Otherwise, set _MOTIF_DRAG_WINDOW to the new drag window. + + Ungrab the display and return whichever window is currently in + _MOTIF_DRAG_WINDOW. */ + +static Window +xm_get_drag_window_1 (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; + Display *temp_display; + Emacs_XErrorHandler old_handler; + Emacs_XIOErrorHandler old_io_handler; + + /* This is volatile because GCC mistakenly warns about them being + clobbered by longjmp. */ + volatile bool error; + + 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 && actual_type == XA_WINDOW + && actual_format == 32 && nitems == 1 + && tmp_data) + { + drag_window = *(Window *) tmp_data; + rc = x_special_window_exists_p (dpyinfo, drag_window); + + if (!rc) + drag_window = None; + } + + if (tmp_data) + XFree (tmp_data); + + if (drag_window == None) + { + block_input (); + old_io_handler = XSetIOErrorHandler (xm_drag_window_io_error_handler); + + if (sigsetjmp (x_dnd_disconnect_handler, 1)) + { + XSetIOErrorHandler (old_io_handler); + unblock_input (); + + return None; + } + + unrequest_sigio (); + temp_display = XOpenDisplay (XDisplayString (dpyinfo->display)); + request_sigio (); + + if (!temp_display) + { + XSetIOErrorHandler (old_io_handler); + unblock_input (); + + return None; + } + + error = false; + xm_drag_window_error = &error; + + XSetCloseDownMode (temp_display, RetainPermanent); + old_handler = XSetErrorHandler (xm_drag_window_error_handler); + + attrs.override_redirect = True; + drag_window = XCreateWindow (temp_display, DefaultRootWindow (temp_display), + -1, -1, 1, 1, 0, CopyFromParent, InputOnly, + CopyFromParent, CWOverrideRedirect, &attrs); + + /* Handle all errors now. */ + XSync (temp_display, False); + + /* Some part of the drag window creation process failed, so + punt. Release all resources too. */ + if (error) + { + XSetCloseDownMode (temp_display, DestroyAll); + drag_window = None; + } + + xm_drag_window_error = NULL; + + /* FIXME: why does XCloseDisplay hang if SIGIO arrives and there + are multiple displays? */ + unrequest_sigio (); + XCloseDisplay (temp_display); + request_sigio (); + + XSetErrorHandler (old_handler); + XSetIOErrorHandler (old_io_handler); + + /* 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. */ + if (!x_special_window_exists_p (dpyinfo, drag_window)) + drag_window = None; + unblock_input (); + + if (drag_window != None) + { + XGrabServer (dpyinfo->display); + + x_catch_errors (dpyinfo->display); + tmp_data = NULL; + + 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 && actual_type == XA_WINDOW + && actual_format == 32 && nitems == 1 + && tmp_data + && x_special_window_exists_p (dpyinfo, + *(Window *) tmp_data)) + { + /* Kill the client now to avoid leaking a client slot, + which is a limited resource. */ + XKillClient (dpyinfo->display, drag_window); + drag_window = *(Window *) tmp_data; + } + else + XChangeProperty (dpyinfo->display, dpyinfo->root_window, + dpyinfo->Xatom_MOTIF_DRAG_WINDOW, + XA_WINDOW, 32, PropModeReplace, + (unsigned char *) &drag_window, 1); + + if (tmp_data) + XFree (tmp_data); + + if (x_had_errors_p (dpyinfo->display)) + drag_window = None; + x_uncatch_errors (); + + XUngrabServer (dpyinfo->display); + } + } + + return drag_window; +} + +static Window +xm_get_drag_window (struct x_display_info *dpyinfo) +{ + if (dpyinfo->motif_drag_window != None) + return dpyinfo->motif_drag_window; + + dpyinfo->motif_drag_window = xm_get_drag_window_1 (dpyinfo); + return dpyinfo->motif_drag_window; +} + +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; + bool had_errors; + xm_targets_table_header header; + xm_targets_table_rec **recs; + xm_byte_order byteorder; + uint8_t *data; + ptrdiff_t total_bytes, total_items, i; + uint32_t size, target_count; + + retry_drag_window: + + 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); + + x_catch_errors (dpyinfo->display); + rc = XGetWindowProperty (dpyinfo->display, drag_window, + dpyinfo->Xatom_MOTIF_DRAG_TARGETS, + 0L, LONG_MAX, False, + dpyinfo->Xatom_MOTIF_DRAG_TARGETS, + &actual_type, &actual_format, &nitems, + &bytes_remaining, &tmp_data) == Success; + had_errors = x_had_errors_p (dpyinfo->display); + x_uncatch_errors_after_check (); + + /* The drag window is probably invalid, so remove our record of + it. */ + if (had_errors) + { + dpyinfo->motif_drag_window = None; + XUngrabServer (dpyinfo->display); + + goto retry_drag_window; + } + + 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 = XM_DRAG_PROTOCOL_VERSION; + 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) + { + target_count = header.target_list_count; + rc = false; + + if (INT_ADD_WRAPV (header.target_list_count, 1, + &header.target_list_count) + || INT_MULTIPLY_WRAPV (ntargets, 4, &size) + || INT_ADD_WRAPV (header.total_data_size, size, + &header.total_data_size) + || INT_ADD_WRAPV (header.total_data_size, 2, + &header.total_data_size)) + { + /* Overflow, remove every entry from the targets table + and add one for our current targets list. This + confuses real Motif but not GTK 2.x, and there is no + other choice. */ + + for (i = 0; i < target_count; ++i) + xfree (recs[i]); + + xfree (recs); + + header.byte_order = XM_BYTE_ORDER_CUR_FIRST; + header.protocol = XM_DRAG_PROTOCOL_VERSION; + 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 + { + 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; + } + } + } + + if (!rc) + { + /* Some implementations of Motif DND set the protocol version of + just the targets table to 1 without actually changing the + data format. To avoid confusing Motif when that happens, set + it back to 0. There will probably be no more updates to the + protocol either. */ + header.protocol = XM_DRAG_PROTOCOL_VERSION; + + x_catch_errors (dpyinfo->display); + xm_write_targets_table (dpyinfo->display, drag_window, + dpyinfo->Xatom_MOTIF_DRAG_TARGETS, + &header, recs); + /* Presumably we got a BadAlloc upon writing the targets + table. */ + if (x_had_errors_p (dpyinfo->display)) + idx = -1; + x_uncatch_errors_after_check (); + } + + XUngrabServer (dpyinfo->display); + + for (i = 0; i < header.target_list_count; ++i) + xfree (recs[i]); + + xfree (recs); + xfree (targets_sorted); + + return idx; +} + +/* Allocate an atom that will be used for the Motif selection during + the drag-and-drop operation. + + Grab the server, and then retrieve a list of atoms named + _EMACS_DRAG_ATOM from the root window. Find the first atom that + has no selection owner, own it and return it. If there is no such + atom, add a unique atom to the end of the list and return that + instead. */ + +static Atom +xm_get_drag_atom_1 (struct x_display_info *dpyinfo, + struct frame *source_frame) +{ + Atom actual_type, *atoms, atom; + unsigned long nitems, bytes_remaining; + unsigned char *tmp_data; + int rc, actual_format; + unsigned long i; + char *buffer; + Window owner; + + /* Make sure this operation is done atomically. */ + XGrabServer (dpyinfo->display); + + rc = XGetWindowProperty (dpyinfo->display, dpyinfo->root_window, + dpyinfo->Xatom_EMACS_DRAG_ATOM, + 0, LONG_MAX, False, XA_ATOM, &actual_type, + &actual_format, &nitems, &bytes_remaining, + &tmp_data); + atom = None; + /* GCC thinks i is used unitialized, but it's always initialized if + `atoms' exists at that particular spot. */ + i = 0; + + if (rc == Success + && actual_format == 32 && nitems + && actual_type == XA_ATOM) + { + atoms = (Atom *) tmp_data; + + x_catch_errors (dpyinfo->display); + + for (i = 0; i < nitems; ++i) + { + owner = XGetSelectionOwner (dpyinfo->display, atoms[i]); + + if (!x_had_errors_p (dpyinfo->display) + && (owner == None + /* If we already own this selection (even if another + frame owns it), use it. There is no way of + knowing when ownership was asserted, so it still + has to be owned again. */ + || x_window_to_frame (dpyinfo, owner))) + { + atom = atoms[i]; + + break; + } + } + + x_uncatch_errors (); + } + + if (tmp_data) + XFree (tmp_data); + + buffer = dpyinfo->motif_drag_atom_name; + + if (atom) + { + sprintf (buffer, "_EMACS_ATOM_%lu", i + 1); + XSetSelectionOwner (dpyinfo->display, atom, + FRAME_X_WINDOW (source_frame), + dpyinfo->last_user_time); + + /* The selection's last-change time is newer than our + last_user_time, so create a new selection instead. */ + if (XGetSelectionOwner (dpyinfo->display, atom) + != FRAME_X_WINDOW (source_frame)) + atom = None; + } + + while (!atom) + { + sprintf (buffer, "_EMACS_ATOM_%lu", nitems + 1); + atom = XInternAtom (dpyinfo->display, buffer, False); + + XSetSelectionOwner (dpyinfo->display, atom, + FRAME_X_WINDOW (source_frame), + dpyinfo->last_user_time); + + XChangeProperty (dpyinfo->display, dpyinfo->root_window, + dpyinfo->Xatom_EMACS_DRAG_ATOM, XA_ATOM, 32, + (rc != Success + || (actual_format != 32 + || actual_type != XA_ATOM) + ? PropModeReplace : PropModeAppend), + (unsigned char *) &atom, 1); + + actual_format = 32; + actual_type = XA_ATOM; + rc = Success; + nitems += 1; + + /* The selection's last-change time is newer than our + last_user_time, so create a new selection (again). */ + if (XGetSelectionOwner (dpyinfo->display, atom) + != FRAME_X_WINDOW (source_frame)) + atom = None; + } + + dpyinfo->motif_drag_atom_time = dpyinfo->last_user_time; + dpyinfo->motif_drag_atom_owner = source_frame; + + XUngrabServer (dpyinfo->display); + return atom; +} + +static Atom +xm_get_drag_atom (struct x_display_info *dpyinfo) +{ + Atom atom; + + if (dpyinfo->motif_drag_atom != None) + atom = dpyinfo->motif_drag_atom; + else + atom = xm_get_drag_atom_1 (dpyinfo, x_dnd_frame); + + dpyinfo->motif_drag_atom = atom; + return atom; +} + +static void +xm_setup_drag_info (struct x_display_info *dpyinfo, + struct frame *source_frame) +{ + Atom atom; + xm_drag_initiator_info drag_initiator_info; + int idx; + + atom = xm_get_drag_atom (dpyinfo); + + if (atom == None) + return; + + XSETCAR (x_dnd_selection_alias_cell, + x_atom_to_symbol (dpyinfo, atom)); + XSETCDR (x_dnd_selection_alias_cell, QXdndSelection); + + 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 = XM_DRAG_PROTOCOL_VERSION; + drag_initiator_info.table_index = idx; + drag_initiator_info.selection = atom; + + xm_write_drag_initiator_info (dpyinfo->display, + FRAME_X_WINDOW (source_frame), atom, + dpyinfo->Xatom_MOTIF_DRAG_INITIATOR_INFO, + &drag_initiator_info); + + x_dnd_motif_setup_p = true; + x_dnd_motif_atom = atom; + } +} + +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_ignore_errors_for_next_request (dpyinfo); + XSendEvent (dpyinfo->display, target, False, NoEventMask, &msg); + x_stop_ignoring_errors (dpyinfo); +} + +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_ignore_errors_for_next_request (dpyinfo); + XSendEvent (dpyinfo->display, target, False, NoEventMask, &msg); + x_stop_ignoring_errors (dpyinfo); +} + +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_ignore_errors_for_next_request (dpyinfo); + XSendEvent (dpyinfo->display, target, False, NoEventMask, &msg); + x_stop_ignoring_errors (dpyinfo); +} + +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, x_dnd_motif_operations, + XM_DROP_ACTION_DROP_CANCEL); + mmsg.timestamp = dmsg->timestamp; + + /* Use X_SHRT_MAX instead of the max value of uint16_t since + that will be interpreted as a plausible position by Motif, + and as such breaks if the drop target is beneath that + position. */ + mmsg.x = X_SHRT_MAX; + mmsg.y = X_SHRT_MAX; + + 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_ignore_errors_for_next_request (dpyinfo); + XSendEvent (dpyinfo->display, target, False, NoEventMask, &msg); + x_stop_ignoring_errors (dpyinfo); +} + +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_drop_start_message (const XEvent *msg, + xm_drop_start_message *dmsg) +{ + const uint8_t *data; + + data = (const uint8_t *) &msg->xclient.data.b[0]; + + if ((XM_DRAG_REASON_ORIGINATOR (data[0]) + != XM_DRAG_ORIGINATOR_INITIATOR) + || (XM_DRAG_REASON_CODE (data[0]) + != XM_DRAG_REASON_DROP_START)) + return 1; + + dmsg->reason = *(data++); + dmsg->byte_order = *(data++); + dmsg->side_effects = *(uint16_t *) data; + dmsg->timestamp = *(uint32_t *) (data + 2); + dmsg->x = *(uint16_t *) (data + 6); + dmsg->y = *(uint16_t *) (data + 8); + dmsg->index_atom = *(uint32_t *) (data + 10); + dmsg->source_window = *(uint32_t *) (data + 14); + + if (dmsg->byte_order != XM_BYTE_ORDER_CUR_FIRST) + { + SWAPCARD16 (dmsg->side_effects); + SWAPCARD32 (dmsg->timestamp); + SWAPCARD16 (dmsg->x); + SWAPCARD16 (dmsg->y); + SWAPCARD32 (dmsg->index_atom); + SWAPCARD32 (dmsg->source_window); + } + + dmsg->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; + + if (data[1] > XM_DRAG_PROTOCOL_VERSION) + return 1; + + 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 int +xm_read_drag_motion_message (const XEvent *msg, + xm_drag_motion_message *dmsg) +{ + const uint8_t *data; + + data = (const uint8_t *) &msg->xclient.data.b[0]; + + if ((XM_DRAG_REASON_CODE (data[0]) + != XM_DRAG_REASON_DRAG_MOTION) + || (XM_DRAG_REASON_ORIGINATOR (data[0]) + != XM_DRAG_ORIGINATOR_INITIATOR)) + return 1; + + dmsg->reason = *(data++); + dmsg->byteorder = *(data++); + dmsg->side_effects = *(uint16_t *) data; + dmsg->timestamp = *(uint32_t *) (data + 2); + dmsg->x = *(uint16_t *) (data + 6); + dmsg->y = *(uint16_t *) (data + 8); + + if (dmsg->byteorder != XM_BYTE_ORDER_CUR_FIRST) + { + SWAPCARD16 (dmsg->side_effects); + SWAPCARD32 (dmsg->timestamp); + SWAPCARD16 (dmsg->x); + SWAPCARD16 (dmsg->y); + } + + dmsg->byteorder = XM_BYTE_ORDER_CUR_FIRST; + + return 0; +} + +static int +xm_read_drag_motion_reply (const XEvent *msg, xm_drag_motion_reply *reply) +{ + const uint8_t *data; + + data = (const uint8_t *) &msg->xclient.data.b[0]; + + if ((XM_DRAG_REASON_CODE (data[0]) + != XM_DRAG_REASON_DRAG_MOTION) + || (XM_DRAG_REASON_ORIGINATOR (data[0]) + != XM_DRAG_ORIGINATOR_RECEIVER)) + return 1; + + reply->reason = *(data++); + reply->byte_order = *(data++); + reply->side_effects = *(uint16_t *) data; + reply->timestamp = *(uint32_t *) (data + 2); + reply->better_x = *(uint16_t *) (data + 6); + reply->better_y = *(uint16_t *) (data + 8); + + if (reply->byte_order != XM_BYTE_ORDER_CUR_FIRST) + { + SWAPCARD16 (reply->side_effects); + SWAPCARD32 (reply->timestamp); + SWAPCARD16 (reply->better_x); + SWAPCARD16 (reply->better_y); + } + + reply->byte_order = XM_BYTE_ORDER_CUR_FIRST; + + return 0; +} + +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 (bool display_alive) +{ + struct x_client_list_window *last; + struct x_client_list_window *tem = x_dnd_toplevels; + ptrdiff_t n_windows, i, buffer_size; + Window *destroy_windows; + unsigned long *prev_masks; + specpdl_ref count; + Display *dpy; + struct x_display_info *dpyinfo; + + if (!x_dnd_toplevels) + /* Probably called inside an IO error handler. */ + return; + + /* Pacify GCC. */ + prev_masks = NULL; + destroy_windows = NULL; + + if (display_alive) + { + buffer_size = 1024; + destroy_windows = xmalloc (sizeof *destroy_windows + * buffer_size); + prev_masks = xmalloc (sizeof *prev_masks * + buffer_size); + n_windows = 0; + } + + block_input (); + while (tem) + { + last = tem; + tem = tem->next; + + if (display_alive) + { + if (++n_windows >= buffer_size) + { + buffer_size += 1024; + destroy_windows + = xrealloc (destroy_windows, (sizeof *destroy_windows + * buffer_size)); + prev_masks + = xrealloc (prev_masks, (sizeof *prev_masks + * buffer_size)); + } + + dpy = last->dpy; + prev_masks[n_windows - 1] = last->previous_event_mask; + destroy_windows[n_windows - 1] = last->window; + } + +#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; + + if (!display_alive) + { + unblock_input (); + return; + } + + count = SPECPDL_INDEX (); + record_unwind_protect_ptr (xfree, destroy_windows); + record_unwind_protect_ptr (xfree, prev_masks); + + if (display_alive) + { + dpyinfo = x_display_info_for_display (dpy); + + if (n_windows) + { + x_ignore_errors_for_next_request (dpyinfo); + + for (i = 0; i < n_windows; ++i) + { + XSelectInput (dpy, destroy_windows[i], prev_masks[i]); +#ifdef HAVE_XSHAPE + XShapeSelectInput (dpy, destroy_windows[i], None); +#endif + } + + x_stop_ignoring_errors (dpyinfo); + } + } + + unbind_to (count, Qnil); + unblock_input (); +} + +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 + USE_SAFE_ALLOCA; + + window_attribute_cookies + = SAFE_ALLOCA (sizeof *window_attribute_cookies * nitems); + translate_coordinate_cookies + = SAFE_ALLOCA (sizeof *translate_coordinate_cookies * nitems); + get_property_cookies + = SAFE_ALLOCA (sizeof *get_property_cookies * nitems); + xm_property_cookies + = SAFE_ALLOCA (sizeof *xm_property_cookies * nitems); + extent_property_cookies + = SAFE_ALLOCA (sizeof *extent_property_cookies * nitems); + get_geometry_cookies + = SAFE_ALLOCA (sizeof *get_geometry_cookies * nitems); + +#ifdef HAVE_XCB_SHAPE + bounding_rect_cookies + = SAFE_ALLOCA (sizeof *bounding_rect_cookies * nitems); +#endif + +#ifdef HAVE_XCB_SHAPE_INPUT_RECTS + input_rect_cookies + = SAFE_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); + + if (xmdata[1] <= XM_DRAG_PROTOCOL_VERSION) + 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_ignore_errors_for_next_request (dpyinfo); + XShapeSelectInput (dpyinfo->display, + toplevels[i], + ShapeNotifyMask); + x_stop_ignoring_errors (dpyinfo); + +#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 + bounding 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_ignore_errors_for_next_request (dpyinfo); + XSelectInput (dpyinfo->display, toplevels[i], + (attrs.your_event_mask + | StructureNotifyMask + | PropertyChangeMask)); + x_stop_ignoring_errors (dpyinfo); + + 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 + } + +#ifdef USE_XCB + SAFE_FREE (); +#endif + + if (data) + XFree (data); + + return 0; +} + +static _Noreturn int +x_dnd_io_error_handler (Display *display) +{ +#ifdef USE_GTK + emacs_abort (); +#else + siglongjmp (x_dnd_disconnect_handler, 1); +#endif +} + +#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 = (x_dnd_disable_motif_protocol + ? XM_DRAG_STYLE_NONE + : 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, owner; + Lisp_Object current_value; + struct frame *f; + + f = decode_window_system_frame (frame); + + if (NILP (value)) + return; + + if (!x_dnd_use_unsupported_drop) + return; + + 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, dpyinfo->root_window, + child, root_x, root_y, &dest_x, &dest_y, + &child_return) + && child_return != None) + child = child_return; + + x_uncatch_errors (); + + if (!CONSP (value)) + return; + + current_value = assq_no_quit (QPRIMARY, + dpyinfo->terminal->Vselection_alist); + + if (!NILP (current_value)) + current_value = XCAR (XCDR (current_value)); + + x_own_selection (QPRIMARY, current_value, frame, + XCAR (XCDR (value)), before); + + owner = XGetSelectionOwner (dpyinfo->display, XA_PRIMARY); + + /* If we didn't successfully obtain selection ownership, refrain + from generating events that will insert something else. */ + + if (owner != FRAME_X_WINDOW (f)) + return; + + event.xbutton.window = child; + event.xbutton.subwindow = None; + event.xbutton.x = dest_x; + event.xbutton.y = dest_y; + event.xbutton.state = 0; + event.xbutton.button = 2; + event.xbutton.same_screen = True; + + dpyinfo->pending_dnd_time = before; + + event.xbutton.type = ButtonPress; + event.xbutton.time = before + 1; + + x_ignore_errors_for_next_request (dpyinfo); + XSendEvent (dpyinfo->display, child, + True, ButtonPressMask, &event); + x_stop_ignoring_errors (dpyinfo); + + event.xbutton.type = ButtonRelease; + event.xbutton.time = before + 2; + + x_ignore_errors_for_next_request (dpyinfo); + XSendEvent (dpyinfo->display, child, + True, ButtonReleaseMask, &event); + x_stop_ignoring_errors (dpyinfo); + + x_dnd_action_symbol = QXdndActionPrivate; + + return; +} + +static void +x_dnd_send_unsupported_drop (struct x_display_info *dpyinfo, Window target_window, + int root_x, int root_y, Time before) +{ + Lisp_Object targets, arg; + int i; + char **atom_names, *name; + + 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; + + for (i = x_dnd_n_targets; i > 0; --i) + { + targets = Fcons (build_string (atom_names[i - 1]), + targets); + XFree (atom_names[i - 1]); + } + + name = x_get_atom_name (dpyinfo, x_dnd_wanted_action, + NULL); + + if (name) + { + arg = intern (name); + xfree (name); + } + else + arg = Qnil; + + x_dnd_run_unsupported_drop_function = true; + x_dnd_unsupported_drop_time = before; + x_dnd_unsupported_drop_window = target_window; + x_dnd_unsupported_drop_data + = listn (5, assq_no_quit (QXdndSelection, + dpyinfo->terminal->Vselection_alist), + targets, arg, make_fixnum (root_x), + make_fixnum (root_y)); + + x_dnd_waiting_for_finish = true; + x_dnd_finish_display = dpyinfo->display; +} + +static Window +x_dnd_fill_empty_target (int *proto_out, int *motif_out, + Window *toplevel_out, bool *was_frame) +{ + *proto_out = -1; + *motif_out = XM_DRAG_STYLE_NONE; + *toplevel_out = None; + *was_frame = false; + + return None; +} + +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, + bool *was_frame) +{ + Window child_return, child, proxy; + int dest_x_return, dest_y_return, rc, proto, motif; + int parent_x, parent_y; + bool extents_p; +#if defined HAVE_XCOMPOSITE && (XCOMPOSITE_MAJOR > 0 || XCOMPOSITE_MINOR > 2) + Window overlay_window; + XWindowAttributes attrs; +#endif + int wmstate; + struct frame *tooltip, *f; + bool unrelated; + + 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; + *was_frame = false; + + 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; + + f = x_top_window_to_frame (dpyinfo, child); + + *toplevel_out = child; + + if (child != None) + { + if (f) + { + *was_frame = true; + *proto_out = -1; + *motif_out = XM_DRAG_STYLE_NONE; + + return child; + } + +#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); + XGrabServer (dpyinfo->display); + overlay_window = XCompositeGetOverlayWindow (dpyinfo->display, + dpyinfo->root_window); + XCompositeReleaseOverlayWindow (dpyinfo->display, + dpyinfo->root_window); + XUngrabServer (dpyinfo->display); + + 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; + parent_x = dest_x_return; + parent_y = dest_y_return; + + x_catch_errors (dpyinfo->display); + rc = XTranslateCoordinates (dpyinfo->display, dpyinfo->root_window, + child_return, root_x, root_y, &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 child_return is a tooltip frame, look beneath it. We + never want to drop anything onto a tooltip frame. */ + + tooltip = x_tooltip_window_to_frame (dpyinfo, child_return, + &unrelated); + + if (tooltip || unrelated) + child_return = x_get_window_below (dpyinfo->display, child_return, + parent_x, parent_y, &dest_x_return, + &dest_y_return); + + if (!child_return) + { + x_uncatch_errors (); + break; + } + + f = x_top_window_to_frame (dpyinfo, child_return); + + if (f) + { + *proto_out = -1; + *motif_out = XM_DRAG_STYLE_NONE; + *toplevel_out = child_return; + *was_frame = true; + + return 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 = (x_dnd_disable_motif_protocol + ? XM_DRAG_STYLE_NONE : 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; + } + } + } + + x_uncatch_errors (); + } + +#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); + XGrabServer (dpyinfo->display); + overlay_window = XCompositeGetOverlayWindow (dpyinfo->display, + dpyinfo->root_window); + XCompositeReleaseOverlayWindow (dpyinfo->display, + dpyinfo->root_window); + XUngrabServer (dpyinfo->display); + + 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; + + 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 && !x_dnd_init_type_lists) + 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); + + /* Now record that the type list has already been set (if required), + so we don't have to set it again. */ + x_dnd_init_type_lists = true; + + x_ignore_errors_for_next_request (dpyinfo); + XSendEvent (FRAME_X_DISPLAY (f), target, False, NoEventMask, &msg); + x_stop_ignoring_errors (dpyinfo); +} + +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; + + 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 <= 7) + { + 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; + + if (x_dnd_waiting_for_status_window == target) + x_dnd_pending_send_position = msg; + else + { + x_ignore_errors_for_next_request (dpyinfo); + XSendEvent (FRAME_X_DISPLAY (f), target, False, NoEventMask, &msg); + x_stop_ignoring_errors (dpyinfo); + + x_dnd_waiting_for_status_window = target; + } +} + +static void +x_dnd_send_leave (struct frame *f, Window target) +{ + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + XEvent msg; + + 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_dnd_waiting_for_status_window = None; + + x_ignore_errors_for_next_request (dpyinfo); + XSendEvent (FRAME_X_DISPLAY (f), target, False, NoEventMask, &msg); + x_stop_ignoring_errors (dpyinfo); +} + +static bool +x_dnd_send_drop (struct frame *f, Window target, Time timestamp, + int supported) +{ + struct x_display_info *dpyinfo; + XEvent msg; + + if (x_dnd_action == None) + { + x_dnd_send_leave (f, target); + return false; + } + + dpyinfo = FRAME_DISPLAY_INFO (f); + + 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_ignore_errors_for_next_request (dpyinfo); + XSendEvent (FRAME_X_DISPLAY (f), target, False, NoEventMask, &msg); + x_stop_ignoring_errors (dpyinfo); + return true; +} + +static bool +x_dnd_do_drop (Window target, int supported) +{ + if (x_dnd_waiting_for_status_window != target) + return x_dnd_send_drop (x_dnd_frame, target, + x_dnd_selection_timestamp, supported); + + x_dnd_need_send_drop = true; + x_dnd_send_drop_proto = supported; + + return true; +} + +static void +x_set_dnd_targets (Atom *targets, int ntargets) +{ + if (x_dnd_targets) + xfree (x_dnd_targets); + + block_input (); + x_dnd_targets = xmalloc (sizeof *targets * ntargets); + x_dnd_n_targets = ntargets; + + memcpy (x_dnd_targets, targets, + sizeof *targets * ntargets); + unblock_input (); +} + +static void +x_free_dnd_targets (void) +{ + if (!x_dnd_targets) + return; + + xfree (x_dnd_targets); + x_dnd_targets = NULL; + x_dnd_n_targets = 0; +} + +/* Clear some Lisp variables after the drop finishes, so they are + freed by the GC. */ + +static void +x_clear_dnd_variables (void) +{ + x_dnd_monitors = Qnil; + x_dnd_unsupported_drop_data = Qnil; +} + +static void +x_free_dnd_toplevels (void) +{ + if (!x_dnd_use_toplevels || !x_dnd_toplevels) + return; + + /* If the display is deleted, x_dnd_toplevels will already be + NULL, so we can always assume the display is alive here. */ + + x_dnd_free_toplevels (true); +} + +/* Restore event masks and window properties changed during a + drag-and-drop operation, after it finishes. */ +static void +x_restore_events_after_dnd (struct frame *f, XWindowAttributes *wa) +{ + struct x_display_info *dpyinfo; + + dpyinfo = FRAME_DISPLAY_INFO (f); + + /* Restore the old event mask. */ + XSelectInput (dpyinfo->display, dpyinfo->root_window, + wa->your_event_mask); +#ifdef HAVE_XKB + if (dpyinfo->supports_xkb) + XkbSelectEvents (dpyinfo->display, XkbUseCoreKbd, + XkbStateNotifyMask, 0); +#endif + /* Delete the Motif drag initiator info if it was set up. */ + if (x_dnd_motif_setup_p) + XDeleteProperty (dpyinfo->display, FRAME_X_WINDOW (f), + x_dnd_motif_atom); + + /* Remove any type list set as well. */ + if (x_dnd_init_type_lists && x_dnd_n_targets > 3) + XDeleteProperty (dpyinfo->display, FRAME_X_WINDOW (f), + dpyinfo->Xatom_XdndTypeList); +} + +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, x_dnd_motif_operations, + XM_DROP_ACTION_DROP_CANCEL); + dmsg.x = 0; + dmsg.y = 0; + dmsg.index_atom = x_dnd_motif_atom; + 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_dnd_waiting_for_finish = false; + + 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; + x_dnd_frame = NULL; + + x_restore_events_after_dnd (f, &x_dnd_old_window_attrs); +} + +static void +x_dnd_note_self_position (struct x_display_info *dpyinfo, Window target, + unsigned short root_x, unsigned short root_y) +{ + struct frame *f; + int dest_x, dest_y; + Window child_return; + + f = x_top_window_to_frame (dpyinfo, target); + + if (f && XTranslateCoordinates (dpyinfo->display, + dpyinfo->root_window, + FRAME_X_WINDOW (f), + root_x, root_y, &dest_x, + &dest_y, &child_return)) + { + x_dnd_movement_frame = f; + x_dnd_movement_x = dest_x; + x_dnd_movement_y = dest_y; + + return; + } +} + +static void +x_dnd_note_self_drop (struct x_display_info *dpyinfo, Window target, + unsigned short root_x, unsigned short root_y, + Time timestamp) +{ + struct input_event ie; + struct frame *f; + Lisp_Object lval; + char **atom_names; + char *name; + int win_x, win_y, i; + Window dummy; + + if (!x_dnd_allow_current_frame + && (FRAME_OUTER_WINDOW (x_dnd_frame) + == target)) + return; + + f = x_top_window_to_frame (dpyinfo, target); + + if (!f) + return; + + if (NILP (Vx_dnd_native_test_function)) + return; + + if (!XTranslateCoordinates (dpyinfo->display, dpyinfo->root_window, + FRAME_X_WINDOW (f), root_x, root_y, + &win_x, &win_y, &dummy)) + return; + + /* Emacs can't respond to DND events inside the nested event loop, + so when dragging items to itself, call the test function + manually. */ + + XSETFRAME (lval, f); + x_dnd_action = None; + x_dnd_action_symbol + = safe_call2 (Vx_dnd_native_test_function, + Fposn_at_x_y (make_fixnum (win_x), + make_fixnum (win_y), + lval, Qnil), + x_atom_to_symbol (dpyinfo, + x_dnd_wanted_action)); + + if (!SYMBOLP (x_dnd_action_symbol)) + return; + + EVENT_INIT (ie); + + ie.kind = DRAG_N_DROP_EVENT; + XSETFRAME (ie.frame_or_window, f); + + lval = Qnil; + atom_names = alloca (x_dnd_n_targets * sizeof *atom_names); + name = x_get_atom_name (dpyinfo, x_dnd_wanted_action, NULL); + + if (!XGetAtomNames (dpyinfo->display, x_dnd_targets, + x_dnd_n_targets, atom_names)) + { + xfree (name); + return; + } + + for (i = x_dnd_n_targets; i != 0; --i) + { + lval = Fcons (intern (atom_names[i - 1]), lval); + XFree (atom_names[i - 1]); + } + + lval = Fcons (assq_no_quit (QXdndSelection, + FRAME_TERMINAL (f)->Vselection_alist), + lval); + lval = Fcons (intern (name), lval); + lval = Fcons (QXdndSelection, lval); + ie.arg = lval; + ie.timestamp = timestamp; + + XSETINT (ie.x, win_x); + XSETINT (ie.y, win_y); + + xfree (name); + kbd_buffer_store_event (&ie); +} /* Flush display of frame F. */ @@ -251,6 +4845,40 @@ x_flush (struct frame *f) unblock_input (); } +#ifdef HAVE_XDBE +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 +} +#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,13 +4922,131 @@ 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; + + 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) +{ + unsigned long opaque_region[] = {0, 0, + (configure + ? configure->xconfigure.width + : FRAME_PIXEL_WIDTH (f)), + (configure + ? configure->xconfigure.height + : FRAME_PIXEL_HEIGHT (f))}; +#ifdef HAVE_GTK3 + GObjectClass *object_class; + GtkWidgetClass *class; +#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); +#else + else if (FRAME_TOOLTIP_P (f)) + 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); + else + { + /* This causes child frames to not update correctly for an + unknown reason. (bug#55779) */ + if (!FRAME_PARENT_FRAME (f)) + { + object_class = G_OBJECT_GET_CLASS (FRAME_GTK_OUTER_WIDGET (f)); + class = GTK_WIDGET_CLASS (object_class); + + if (class->style_updated) + class->style_updated (FRAME_GTK_OUTER_WIDGET (f)); + } + } +#endif + unblock_input (); +} -#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) + +#if defined USE_CAIRO || defined HAVE_XRENDER +static int +x_gc_free_ext_data_private (XExtData *extension) +{ + xfree (extension->private_data); + + return 0; +} static struct x_gc_ext_data * x_gc_get_ext_data (struct frame *f, GC gc, int create_if_not_found_p) @@ -321,6 +5067,7 @@ x_gc_get_ext_data (struct frame *f, GC gc, int create_if_not_found_p) ext_data = xzalloc (sizeof (*ext_data)); ext_data->number = dpyinfo->ext_codes->extension; ext_data->private_data = xzalloc (sizeof (struct x_gc_ext_data)); + ext_data->free_private = x_gc_free_ext_data_private; XAddToExtensionList (head, ext_data); } } @@ -334,6 +5081,436 @@ 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 + +/* Convert XI2 button state IN to a standard X button modifier + mask, and place it in OUT. */ +static void +xi_convert_button_state (XIButtonState *in, unsigned int *out) +{ + int i; + + if (in->mask_len) + { + for (i = 1; i <= 8; ++i) + { + if (XIMaskIsSet (in->mask, i)) + *out |= (Button1Mask << (i - 1)); + } + } +} + +/* Return the modifier state in XEV as a standard X modifier mask. */ + +#ifdef USE_GTK +static +#endif +unsigned int +xi_convert_event_state (XIDeviceEvent *xev) +{ + unsigned int mods, buttons; + + mods = xev->mods.effective; + buttons = 0; + + xi_convert_button_state (&xev->buttons, &buttons); + + return mods | buttons; +} + +/* 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 (); +} + +#ifdef HAVE_XINPUT2_1 +struct xi_known_valuator +{ + /* The current value of this valuator. */ + double current_value; + + /* The number of the valuator. */ + int number; + + /* The next valuator whose value we already know. */ + struct xi_known_valuator *next; +}; +#endif + +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; + struct xi_known_valuator *values, *tem; + int actual_valuator_count; + XIScrollClassInfo *info; + XIValuatorClassInfo *val_info; +#endif + int c; +#ifdef HAVE_XINPUT2_2 + XITouchClassInfo *touch_info; +#endif + +#ifdef HAVE_XINPUT2_1 + USE_SAFE_ALLOCA; +#endif + + 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); + values = NULL; +#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; + } + + case XIValuatorClass: + { + val_info = (XIValuatorClassInfo *) device->classes[c]; + tem = SAFE_ALLOCA (sizeof *tem); + + tem->next = values; + tem->number = val_info->number; + tem->current_value = val_info->value; + + values = tem; + 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; + + /* Now look through all the valuators whose values are already known + and populate our client-side records with their current + values. */ + + for (tem = values; values; values = values->next) + { + for (c = 0; c < xi_device->scroll_valuator_count; ++c) + { + if (xi_device->valuators[c].number == tem->number) + { + xi_device->valuators[c].invalid_p = false; + xi_device->valuators[c].current_value = tem->current_value; + xi_device->valuators[c].pending_enter_reset = true; + } + } + } + + SAFE_FREE (); +#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; + } + } + } + + *valuator_return = NULL; + 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 +5562,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 +5594,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 +5679,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 +5837,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 +5854,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 +5905,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 +5991,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 +6037,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 +6047,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_fill_rectangle (struct frame *f, GC gc, int x, int y, int width, int height) +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, + bool respect_alpha_background) { #ifdef USE_CAIRO Display *dpy = FRAME_X_DISPLAY (f); @@ -814,7 +6127,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 +6135,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 +6275,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 +6293,24 @@ 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)) - x_clear_area (f, 0, 0, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f)); +#ifndef USE_GTK + if (f->alpha_background != 1.0 +#ifdef HAVE_XDBE + || FRAME_X_DOUBLE_BUFFERED_P (f) +#endif + ) +#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 +6321,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 +6348,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 +6381,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); @@ -1049,8 +6485,6 @@ x_set_frame_alpha (struct frame *f) opac = alpha * OPAQUE; - x_catch_errors (dpy); - /* If there is a parent from the window manager, put the property there also, to work around broken window managers that fail to do that. Do this unconditionally as this function is called on reparent when @@ -1059,40 +6493,23 @@ x_set_frame_alpha (struct frame *f) if (!FRAME_PARENT_FRAME (f)) { parent = x_find_topmost_parent (f); + if (parent != None) - XChangeProperty (dpy, parent, dpyinfo->Xatom_net_wm_window_opacity, - XA_CARDINAL, 32, PropModeReplace, - (unsigned char *) &opac, 1); + { + x_ignore_errors_for_next_request (dpyinfo); + XChangeProperty (dpy, parent, + dpyinfo->Xatom_net_wm_window_opacity, + XA_CARDINAL, 32, PropModeReplace, + (unsigned char *) &opac, 1); + x_stop_ignoring_errors (dpyinfo); + } } - /* return unless necessary */ - { - unsigned char *data; - Atom actual; - int rc, format; - unsigned long n, left; - - rc = XGetWindowProperty (dpy, win, dpyinfo->Xatom_net_wm_window_opacity, - 0, 1, False, XA_CARDINAL, - &actual, &format, &n, &left, - &data); - - if (rc == Success && actual != None) - { - unsigned long value = *(unsigned long *)data; - XFree (data); - if (value == opac) - { - x_uncatch_errors (); - return; - } - } - } - + x_ignore_errors_for_next_request (dpyinfo); XChangeProperty (dpy, win, dpyinfo->Xatom_net_wm_window_opacity, XA_CARDINAL, 32, PropModeReplace, (unsigned char *) &opac, 1); - x_uncatch_errors (); + x_stop_ignoring_errors (dpyinfo); } /*********************************************************************** @@ -1125,7 +6542,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 +6575,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 +6589,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,20 +6603,22 @@ 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); } } /* Show the frame back buffer. If frame is double-buffered, atomically publish to the user's screen graphics updates made since the last call to show_back_buffer. */ + +#ifdef HAVE_XDBE static void show_back_buffer (struct frame *f) { block_input (); + if (FRAME_X_DOUBLE_BUFFERED_P (f)) { -#ifdef HAVE_XDBE #ifdef USE_CAIRO cairo_t *cr = FRAME_CR_CONTEXT (f); if (cr) @@ -1210,13 +6629,12 @@ show_back_buffer (struct frame *f) swap_info.swap_window = FRAME_X_WINDOW (f); swap_info.swap_action = XdbeCopied; XdbeSwapBuffers (FRAME_X_DISPLAY (f), &swap_info, 1); -#else - eassert (!"should have back-buffer only with XDBE"); -#endif } FRAME_X_NEED_BUFFER_FLIP (f) = false; + unblock_input (); } +#endif /* Updates back buffer and flushes changes to display. Called from minibuf read code. Note that we display the back buffer even if @@ -1224,9 +6642,20 @@ show_back_buffer (struct frame *f) static void x_flip_and_flush (struct frame *f) { + /* Flipping buffers requires a working connection to the X server, + which isn't always present if `inhibit-redisplay' is t, since + this can be called from the IO error handler. */ + if (!NILP (Vinhibit_redisplay) + /* This has to work for tooltip frames, however, and redisplay + cannot happen when they are being flushed anyway. (bug#55519) */ + && !FRAME_TOOLTIP_P (f)) + return; + block_input (); +#ifdef HAVE_XDBE if (FRAME_X_NEED_BUFFER_FLIP (f)) - show_back_buffer (f); + show_back_buffer (f); +#endif x_flush (f); unblock_input (); } @@ -1262,20 +6691,85 @@ 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)) + +#ifdef HAVE_XDBE + if (!buffer_flipping_blocked_p () + && FRAME_X_NEED_BUFFER_FLIP (f)) show_back_buffer (f); +#endif + +#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 (); } +#ifdef HAVE_XDBE static void XTbuffer_flipping_unblocked_hook (struct frame *f) { if (FRAME_X_NEED_BUFFER_FLIP (f)) show_back_buffer (f); } +#endif /** * x_clear_under_internal_border: @@ -1311,10 +6805,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 +6875,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 @@ -1398,7 +6892,8 @@ x_after_update_window_line (struct window *w, struct glyph_row *desired_row) } static void -x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fringe_bitmap_params *p) +x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, + struct draw_fringe_bitmap_params *p) { struct frame *f = XFRAME (WINDOW_FRAME (w)); Display *display = FRAME_X_DISPLAY (f); @@ -1415,14 +6910,21 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring mono-displays, the fill style may have been changed to FillSolid in x_draw_glyph_string_background. */ if (face->stipple) - XSetFillStyle (display, face->gc, FillOpaqueStippled); - else - XSetForeground (display, face->gc, face->background); - - x_fill_rectangle (f, face->gc, p->bx, p->by, p->nx, p->ny); + { + XSetFillStyle (display, face->gc, FillOpaqueStippled); + x_fill_rectangle (f, face->gc, p->bx, p->by, p->nx, p->ny, + true); + XSetFillStyle (display, face->gc, FillSolid); - if (!face->stipple) - XSetForeground (display, face->gc, face->foreground); + row->stipple_p = true; + } + else + { + XSetBackground (display, face->gc, face->background); + x_clear_rectangle (f, face->gc, p->bx, p->by, p->nx, p->ny, + true); + XSetForeground (display, face->gc, face->foreground); + } } #ifdef USE_CAIRO @@ -1458,15 +6960,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 +7001,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 +7017,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 +7080,119 @@ static void x_scroll_bar_clear (struct frame *); static void x_check_font (struct frame *, struct font *); #endif +/* If SEND_EVENT, make sure that TIME is larger than the current last + user time. We don't sanitize timestamps from events sent by the X + server itself because some Lisp might have set the user time to a + ridiculously large value, and this way a more reasonable timestamp + can be obtained upon the next event. */ + +static void +x_display_set_last_user_time (struct x_display_info *dpyinfo, Time time, + bool send_event) +{ +#ifndef USE_GTK + struct frame *focus_frame = dpyinfo->x_focus_frame; +#endif + +#ifdef ENABLE_CHECKING + eassert (time <= X_ULONG_MAX); +#endif + + if (!send_event || time > dpyinfo->last_user_time) + dpyinfo->last_user_time = time; + +#ifndef USE_GTK + 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 +} + +/* Not needed on GTK because GTK handles reporting the user time + itself. */ + +#ifndef USE_GTK +static void +x_update_frame_user_time_window (struct frame *f) +{ + struct x_output *output; + struct x_display_info *dpyinfo; + XSetWindowAttributes attrs; + + output = FRAME_X_OUTPUT (f); + dpyinfo = FRAME_DISPLAY_INFO (f); + + if (!NILP (Vx_no_window_manager) + || !x_wm_supports (f, dpyinfo->Xatom_net_wm_user_time)) + { + if (output->user_time_window != None + && 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); + } + else + XDeleteProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f), + dpyinfo->Xatom_net_wm_user_time); + + output->user_time_window = None; + return; + } + + 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) + { + 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); + } + } +} +#endif + +void +x_set_last_user_time_from_lisp (struct x_display_info *dpyinfo, + Time time) +{ + x_display_set_last_user_time (dpyinfo, time, true); +} + /* Set S->gc to a suitable GC for drawing glyph string S in cursor face. */ @@ -1556,7 +7233,10 @@ x_set_cursor_gc (struct glyph_string *s) IF_DEBUG (x_check_font (s->f, s->font)); xgcv.graphics_exposures = False; - mask = GCForeground | GCBackground | GCGraphicsExposures; + xgcv.line_width = 1; + mask = (GCForeground | GCBackground + | GCGraphicsExposures + | GCLineWidth); if (FRAME_DISPLAY_INFO (s->f)->scratch_cursor_gc) XChangeGC (display, FRAME_DISPLAY_INFO (s->f)->scratch_cursor_gc, @@ -1575,22 +7255,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 @@ -1604,7 +7268,11 @@ x_set_mouse_face_gc (struct glyph_string *s) xgcv.background = s->face->background; xgcv.foreground = s->face->foreground; xgcv.graphics_exposures = False; - mask = GCForeground | GCBackground | GCGraphicsExposures; + xgcv.line_width = 1; + + mask = (GCForeground | GCBackground + | GCGraphicsExposures + | GCLineWidth); if (FRAME_DISPLAY_INFO (s->f)->scratch_cursor_gc) XChangeGC (display, FRAME_DISPLAY_INFO (s->f)->scratch_cursor_gc, @@ -1748,14 +7416,34 @@ 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); + x_clear_rectangle (s->f, s->gc, x, y, w, h, s->hl != DRAW_CURSOR); +} + +#ifndef USE_CAIRO + +static void +x_clear_point (struct frame *f, GC gc, int x, int y, + bool respect_alpha_background) +{ 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); + Display *dpy; + + dpy = FRAME_X_DISPLAY (f); + + if (f->alpha_background != 1.0 + && respect_alpha_background) + { + x_clear_rectangle (f, gc, x, y, 1, 1, true); + return; + } + + XGetGCValues (dpy, gc, GCBackground | GCForeground, &xgcv); + XSetForeground (dpy, gc, xgcv.background); + XDrawPoint (dpy, FRAME_X_DRAWABLE (f), gc, x, y); + XSetForeground (dpy, gc, xgcv.foreground); } +#endif /* 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 @@ -1779,9 +7467,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 +7565,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 @@ -2084,6 +7774,10 @@ x_draw_glyphless_glyph_string_foreground (struct glyph_string *s) glyph->ascent + glyph->descent - 1); x += glyph->pixel_width; } + + /* Defend against hypothetical bad code elsewhere that uses + s->char2b after this function returns. */ + s->char2b = NULL; } #ifdef USE_X_TOOLKIT @@ -2299,8 +7993,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 +8019,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,63 +8080,180 @@ 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); } +static unsigned int +x_hash_string_ignore_case (const char *string) +{ + unsigned int i; + + i = 3323198485ul; + for (; *string; ++string) + { + i ^= c_tolower (*string); + i *= 0x5bd1e995; + i ^= i >> 15; + } + return i; +} + /* 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. */ + If too many entries are placed in the cache, the least recently + used entries are removed. */ -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) { + unsigned short r, g, b; + Display *dpy; + Colormap cmap; + struct x_display_info *dpyinfo; + struct color_name_cache_entry *cache_entry, *last; + struct color_name_cache_entry *next, *color_entry; + unsigned int hash, idx; + int rc, i; + /* Don't pass #RGB strings directly to XParseColor, because that follows the X convention of zero-extending each channel value: #f00 means #f00000. We want the convention of scaling channel values, so #f00 means #ff0000, just as it does for HTML, SVG, and CSS. */ - unsigned short r, g, b; if (parse_color_spec (color_name, &r, &g, &b)) { color->red = r; color->green = g; color->blue = b; + return 1; } - Display *dpy = FRAME_X_DISPLAY (f); - Colormap cmap = FRAME_X_COLORMAP (f); - struct color_name_cache_entry *cache_entry; - for (cache_entry = FRAME_DISPLAY_INFO (f)->color_names; cache_entry; - cache_entry = cache_entry->next) + /* Some X servers send BadValue on empty color names. */ + if (!strlen (color_name)) + return 0; + + cmap = FRAME_X_COLORMAP (f); + dpy = FRAME_X_DISPLAY (f); + dpyinfo = FRAME_DISPLAY_INFO (f); + + hash = x_hash_string_ignore_case (color_name); + idx = hash % dpyinfo->color_names_size; + + last = NULL; + + for (cache_entry = dpyinfo->color_names[idx]; + cache_entry; cache_entry = cache_entry->next) { - if (!xstrcasecmp(cache_entry->name, color_name)) + if (!xstrcasecmp (cache_entry->name, color_name)) { - *color = cache_entry->rgb; - return 1; + /* Move recently used entries to the start of the color + cache. */ + + if (last) + { + last->next = cache_entry->next; + cache_entry->next = dpyinfo->color_names[idx]; + + dpyinfo->color_names[idx] = cache_entry; + } + + if (cache_entry->valid) + *color = cache_entry->rgb; + + return cache_entry->valid; } + + last = cache_entry; } - if (XParseColor (dpy, cmap, color_name, color) == 0) - /* No caching of negative results, currently. */ - return 0; + block_input (); + rc = XParseColor (dpy, cmap, color_name, color); + unblock_input (); cache_entry = xzalloc (sizeof *cache_entry); - cache_entry->rgb = *color; + dpyinfo->color_names_length[idx] += 1; + + if (rc) + cache_entry->rgb = *color; + + cache_entry->valid = rc; cache_entry->name = xstrdup (color_name); - cache_entry->next = FRAME_DISPLAY_INFO (f)->color_names; - FRAME_DISPLAY_INFO (f)->color_names = cache_entry; - return 1; + cache_entry->next = dpyinfo->color_names[idx]; + + dpyinfo->color_names[idx] = cache_entry; + + /* Don't let the color cache become too big. */ + if (dpyinfo->color_names_length[idx] > (x_color_cache_bucket_size > 0 + ? x_color_cache_bucket_size : 128)) + { + i = 0; + + for (last = dpyinfo->color_names[idx]; last; last = last->next) + { + if (++i == (x_color_cache_bucket_size > 0 + ? x_color_cache_bucket_size : 128)) + { + next = last->next; + last->next = NULL; + + for (color_entry = next; color_entry; color_entry = last) + { + last = color_entry->next; + + xfree (color_entry->name); + xfree (color_entry); + + dpyinfo->color_names_length[idx] -= 1; + } + + return rc; + } + } + } + + return rc; } @@ -2455,40 +8265,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 +8441,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; @@ -2624,7 +8506,7 @@ x_alloc_lighter_color (struct frame *f, Display *display, Colormap cmap, 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; + double dimness = 1 - (double) bright / HIGHLIGHT_COLOR_DARK_BOOST_LIMIT; /* The additive adjustment. */ int min_delta = delta * dimness * factor / 2; @@ -2750,20 +8632,62 @@ x_setup_relief_colors (struct glyph_string *s) } } +#ifndef USE_CAIRO +static void +x_fill_triangle (struct frame *f, GC gc, XPoint point1, + XPoint point2, XPoint point3) +{ + XPoint abc[3]; + + abc[0] = point1; + abc[1] = point2; + abc[2] = point3; + + XFillPolygon (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), + gc, abc, 3, Convex, CoordModeOrigin); +} + +static XPoint +x_make_point (int x, int y) +{ + XPoint pt; + + pt.x = x; + pt.y = y; + + return pt; +} + +static bool +x_inside_rect_p (XRectangle *rects, int nrects, int x, int y) +{ + int i; + + for (i = 0; i < nrects; ++i) + { + if (x >= rects[i].x && y >= rects[i].y + && x < rects[i].x + rects[i].width + && y < rects[i].y + rects[i].height) + return true; + } + + return false; +} +#endif /* 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, + TOP_Y, RIGHT_X, and BOTTOM_Y. VWIDTH and HWIDTH are respectively + the thickness of the vertical relief (left and right) and + horizontal relief (top and bottom) 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) { #ifdef USE_CAIRO @@ -2787,7 +8711,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 +8720,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 +8730,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 +8739,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 +8747,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, @@ -2839,90 +8763,118 @@ x_draw_relief_rect (struct frame *f, x_reset_clip_rectangles (f, top_left_gc); x_reset_clip_rectangles (f, bottom_right_gc); #else - Display *dpy = FRAME_X_DISPLAY (f); - Drawable drawable = FRAME_X_DRAWABLE (f); - int i; - GC gc; - - if (raised_p) - gc = f->output_data.x->white_relief.gc; - else - gc = f->output_data.x->black_relief.gc; - XSetClipRectangles (dpy, gc, 0, 0, clip_rect, 1, Unsorted); + GC gc, white_gc, black_gc, normal_gc; + Drawable drawable; + Display *dpy; /* This code is more complicated than it has to be, because of two minor hacks to make the boxes look nicer: (i) if width > 1, draw the outermost line using the black relief. (ii) Omit the four corner pixels. */ - /* Top. */ - if (top_p) - { - if (hwidth == 1) - XDrawLine (dpy, drawable, gc, - left_x + left_p, top_y, - right_x + !right_p, top_y); - - for (i = 1; i < hwidth; ++i) - XDrawLine (dpy, drawable, gc, - left_x + i * left_p, top_y + i, - right_x + 1 - i * right_p, top_y + i); - } + white_gc = f->output_data.x->white_relief.gc; + black_gc = f->output_data.x->black_relief.gc; + normal_gc = f->output_data.x->normal_gc; - /* Left. */ - if (left_p) - { - if (vwidth == 1) - XDrawLine (dpy, drawable, gc, left_x, top_y + 1, left_x, bottom_y); + drawable = FRAME_X_DRAWABLE (f); + dpy = FRAME_X_DISPLAY (f); - for (i = 1; i < vwidth; ++i) - XDrawLine (dpy, drawable, gc, - left_x + i, top_y + (i + 1) * top_p, - left_x + i, bottom_y + 1 - (i + 1) * bot_p); - } + x_set_clip_rectangles (f, white_gc, clip_rect, 1); + x_set_clip_rectangles (f, black_gc, clip_rect, 1); - XSetClipMask (dpy, gc, None); if (raised_p) - gc = f->output_data.x->black_relief.gc; + gc = white_gc; else - gc = f->output_data.x->white_relief.gc; - XSetClipRectangles (dpy, gc, 0, 0, clip_rect, 1, Unsorted); + gc = black_gc; - /* Outermost top line. */ - if (top_p && hwidth > 1) - XDrawLine (dpy, drawable, gc, - left_x + left_p, top_y, - right_x + !right_p, top_y); + /* Draw lines. */ - /* Outermost left line. */ - if (left_p && vwidth > 1) - XDrawLine (dpy, drawable, gc, left_x, top_y + 1, left_x, bottom_y); + if (top_p) + x_fill_rectangle (f, gc, left_x, top_y, + right_x - left_x + 1, hwidth, + false); + + if (left_p) + x_fill_rectangle (f, gc, left_x, top_y, vwidth, + bottom_y - top_y + 1, false); + + if (raised_p) + gc = black_gc; + else + gc = white_gc; - /* Bottom. */ if (bot_p) + x_fill_rectangle (f, gc, left_x, bottom_y - hwidth + 1, + right_x - left_x + 1, hwidth, false); + + if (right_p) + x_fill_rectangle (f, gc, right_x - vwidth + 1, top_y, + vwidth, bottom_y - top_y + 1, false); + + /* Draw corners. */ + + if (bot_p && left_p) + x_fill_triangle (f, raised_p ? white_gc : black_gc, + x_make_point (left_x, bottom_y - hwidth), + x_make_point (left_x + vwidth, bottom_y - hwidth), + x_make_point (left_x, bottom_y)); + + if (top_p && right_p) + x_fill_triangle (f, raised_p ? white_gc : black_gc, + x_make_point (right_x - vwidth, top_y), + x_make_point (right_x, top_y), + x_make_point (right_x - vwidth, top_y + hwidth)); + + /* Draw outer line. */ + + if (top_p && left_p && bot_p && right_p + && hwidth > 1 && vwidth > 1) + x_draw_rectangle (f, black_gc, left_x, top_y, + right_x - left_x, bottom_y - top_y); + else { - if (hwidth >= 1) - XDrawLine (dpy, drawable, gc, - left_x + left_p, bottom_y, - right_x + !right_p, bottom_y); + if (top_p && hwidth > 1) + XDrawLine (dpy, drawable, black_gc, left_x, top_y, + right_x + 1, top_y); - for (i = 1; i < hwidth; ++i) - XDrawLine (dpy, drawable, gc, - left_x + i * left_p, bottom_y - i, - right_x + 1 - i * right_p, bottom_y - i); + if (bot_p && hwidth > 1) + XDrawLine (dpy, drawable, black_gc, left_x, bottom_y, + right_x + 1, bottom_y); + + if (left_p && vwidth > 1) + XDrawLine (dpy, drawable, black_gc, left_x, top_y, + left_x, bottom_y + 1); + + if (right_p && vwidth > 1) + XDrawLine (dpy, drawable, black_gc, right_x, top_y, + right_x, bottom_y + 1); } - /* Right. */ - if (right_p) + /* Erase corners. */ + + if (hwidth > 1 && vwidth > 1) { - for (i = 0; i < vwidth; ++i) - XDrawLine (dpy, drawable, gc, - right_x - i, top_y + (i + 1) * top_p, - right_x - i, bottom_y + 1 - (i + 1) * bot_p); - } + if (left_p && top_p && x_inside_rect_p (clip_rect, 1, + left_x, top_y)) + /* This should respect `alpha-background' since it's being + cleared with the background color of the frame. */ + x_clear_point (f, normal_gc, left_x, top_y, true); - x_reset_clip_rectangles (f, gc); + if (left_p && bot_p && x_inside_rect_p (clip_rect, 1, + left_x, bottom_y)) + x_clear_point (f, normal_gc, left_x, bottom_y, true); + + if (right_p && top_p && x_inside_rect_p (clip_rect, 1, + right_x, top_y)) + x_clear_point (f, normal_gc, right_x, top_y, true); + + if (right_p && bot_p && x_inside_rect_p (clip_rect, 1, + right_x, bottom_y)) + x_clear_point (f, normal_gc, right_x, bottom_y, true); + } + x_reset_clip_rectangles (f, white_gc); + x_reset_clip_rectangles (f, black_gc); #endif } @@ -2948,21 +8900,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 +9002,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 +9333,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 @@ -3426,14 +9383,16 @@ x_draw_image_glyph_string (struct glyph_string *s) || s->img->pixmap == 0 || s->width != s->background_width) { + if (s->stippled_p) + s->row->stipple_p = true; + #ifndef USE_CAIRO if (s->img->mask) { /* 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 +9417,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,15 +9564,17 @@ 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); + + s->row->stipple_p = true; } else { 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); } @@ -3610,15 +9594,20 @@ x_draw_stretch_glyph_string (struct glyph_string *s) background_width -= text_left_x - x; x = text_left_x; } + + if (!s->row->stipple_p) + s->row->stipple_p = s->stippled_p; + if (background_width > 0) - x_draw_glyph_string_bg_rect (s, x, s->y, background_width, s->height); + x_draw_glyph_string_bg_rect (s, x, s->y, + background_width, s->height); } s->background_filled_p = true; } static void -x_get_scale_factor(Display *disp, int *scale_x, int *scale_y) +x_get_scale_factor (Display *disp, int *scale_x, int *scale_y) { const int base_res = 96; struct x_display_info * dpyinfo = x_display_info_for_display (disp); @@ -3645,7 +9634,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 +9647,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 +9657,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 +9807,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 +9848,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,12 +9876,13 @@ 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) || BASE_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)); + = !(NILP (val) || BASE_EQ (val, Qunbound)); /* Get the underline thickness. Default is 1 pixel. */ if (font && font->underline_thickness > 0) @@ -3877,7 +9890,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 +9912,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 + explicitly 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 +9929,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 +9938,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 +9951,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 +9959,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 +9981,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 +9989,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; @@ -4032,6 +10049,14 @@ x_draw_glyph_string (struct glyph_string *s) /* Reset clipping. */ x_reset_clip_rectangles (s->f, s->gc); s->num_clips = 0; + + /* Set the stippled flag that tells redisplay whether or not a + stipple was actually draw. */ + + if (s->first_glyph->type != STRETCH_GLYPH + && s->first_glyph->type != IMAGE_GLYPH + && !s->row->stipple_p) + s->row->stipple_p = s->stippled_p; } /* Shift display to make room for inserted glyphs. */ @@ -4061,13 +10086,15 @@ x_delete_glyphs (struct frame *f, int n) /* Like XClearArea, but check that WIDTH and HEIGHT are reasonable. If they are <= 0, this is probably an error. */ -MAYBE_UNUSED static void +#if defined USE_GTK || !defined USE_CAIRO +static void x_clear_area1 (Display *dpy, Window window, int x, int y, int width, int height, int exposures) { eassert (width > 0 && height > 0); XClearArea (dpy, window, x, y, width, height, exposures); } +#endif void x_clear_area (struct frame *f, int x, int y, int width, int height) @@ -4078,20 +10105,52 @@ 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 (f->alpha_background != 1.0 +#ifdef HAVE_XDBE + || FRAME_X_DOUBLE_BUFFERED_P (f) +#endif + ) +#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 +10197,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 +10210,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 +10259,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 +10278,15 @@ x_hide_hourglass (struct frame *f) static void XTflash (struct frame *f) { - block_input (); + GC gc; + XGCValues values; + fd_set fds; + int fd, rc; - { -#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,115 +10294,100 @@ 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. */ + rc = 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 (rc >= 0 && FD_ISSET (fd, &fds)) + break; } - } - unblock_input (); -} + /* 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); -static void -XTtoggle_invisible_pointer (struct frame *f, bool invisible) -{ - block_input (); - FRAME_DISPLAY_INFO (f)->toggle_visible_pointer (f, invisible); unblock_input (); } - /* Make audible bell. */ static void @@ -4417,6 +10466,107 @@ 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 + +#ifdef USE_CAIRO_XCB_SURFACE + /* 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); +#endif + #ifdef USE_CAIRO if (FRAME_CR_CONTEXT (f)) { @@ -4436,6 +10586,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 @@ -4479,6 +10641,10 @@ x_scroll_run (struct window *w, struct run *run) static void x_frame_highlight (struct frame *f) { + struct x_display_info *dpyinfo; + + dpyinfo = FRAME_DISPLAY_INFO (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 @@ -4488,10 +10654,10 @@ x_frame_highlight (struct frame *f) the window-manager in use, tho something more is at play since I've been using that same window-manager binary for ever. Let's not crash just because of this (bug#9310). */ - x_catch_errors (FRAME_X_DISPLAY (f)); + x_ignore_errors_for_next_request (dpyinfo); XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), f->output_data.x->border_pixel); - x_uncatch_errors (); + x_stop_ignoring_errors (dpyinfo); unblock_input (); gui_update_cursor (f, true); x_set_frame_alpha (f); @@ -4500,17 +10666,23 @@ x_frame_highlight (struct frame *f) static void x_frame_unhighlight (struct frame *f) { + struct x_display_info *dpyinfo; + + dpyinfo = FRAME_DISPLAY_INFO (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). */ - x_catch_errors (FRAME_X_DISPLAY (f)); + x_ignore_errors_for_next_request (dpyinfo); XSetWindowBorderPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), f->output_data.x->border_tile); - x_uncatch_errors (); + x_stop_ignoring_errors (dpyinfo); unblock_input (); + gui_update_cursor (f, true); x_set_frame_alpha (f); } @@ -4525,6 +10697,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 +10718,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); @@ -4544,12 +10741,128 @@ x_new_focus_frame (struct x_display_info *dpyinfo, struct frame *frame) x_frame_rehighlight (dpyinfo); } +/* True if the display in DPYINFO supports a version of Xfixes + sufficient for pointer blanking. */ +#ifdef HAVE_XFIXES +static bool +x_probe_xfixes_extension (struct x_display_info *dpyinfo) +{ + return (dpyinfo->xfixes_supported_p + && dpyinfo->xfixes_major >= 4); +} +#endif /* HAVE_XFIXES */ + +/* Toggle mouse pointer visibility on frame F using the XFixes + extension. */ +#ifdef HAVE_XFIXES +static void +xfixes_toggle_visible_pointer (struct frame *f, bool invisible) + +{ + if (invisible) + XFixesHideCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); + else + XFixesShowCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); + f->pointer_invisible = invisible; +} +#endif /* HAVE_XFIXES */ + +/* Create invisible cursor on the X display referred by DPYINFO. */ +static Cursor +make_invisible_cursor (struct x_display_info *dpyinfo) +{ + Display *dpy = dpyinfo->display; + static char const no_data[] = { 0 }; + Pixmap pix; + XColor col; + Cursor c; + + c = None; + + x_catch_errors (dpy); + pix = XCreateBitmapFromData (dpy, dpyinfo->root_window, no_data, 1, 1); + if (!x_had_errors_p (dpy) && pix != None) + { + Cursor pixc; + col.pixel = 0; + col.red = col.green = col.blue = 0; + col.flags = DoRed | DoGreen | DoBlue; + pixc = XCreatePixmapCursor (dpy, pix, pix, &col, &col, 0, 0); + if (! x_had_errors_p (dpy) && pixc != None) + c = pixc; + XFreePixmap (dpy, pix); + } + + x_uncatch_errors (); + + return c; +} + +/* Toggle mouse pointer visibility on frame F by using an invisible + cursor. */ +static void +x_toggle_visible_pointer (struct frame *f, bool invisible) +{ + struct x_display_info *dpyinfo; + + dpyinfo = FRAME_DISPLAY_INFO (f); + + /* We could have gotten a BadAlloc error while creating the + invisible cursor. Try to create it again, but if that fails, + just give up. */ + if (dpyinfo->invisible_cursor == None) + dpyinfo->invisible_cursor = make_invisible_cursor (dpyinfo); + +#ifndef HAVE_XFIXES + if (dpyinfo->invisible_cursor == None) + invisible = false; +#else + /* But if Xfixes is available, try using it instead. */ + if (dpyinfo->invisible_cursor == None) + { + if (x_probe_xfixes_extension (dpyinfo)) + { + dpyinfo->fixes_pointer_blanking = true; + xfixes_toggle_visible_pointer (f, invisible); + + return; + } + else + invisible = false; + } +#endif + + if (invisible) + XDefineCursor (dpyinfo->display, FRAME_X_WINDOW (f), + dpyinfo->invisible_cursor); + else + XDefineCursor (dpyinfo->display, FRAME_X_WINDOW (f), + f->output_data.x->current_cursor); + + f->pointer_invisible = invisible; +} + +static void +XTtoggle_invisible_pointer (struct frame *f, bool invisible) +{ + block_input (); +#ifdef HAVE_XFIXES + if (FRAME_DISPLAY_INFO (f)->fixes_pointer_blanking + && x_probe_xfixes_extension (FRAME_DISPLAY_INFO (f))) + xfixes_toggle_visible_pointer (f, invisible); + else +#endif + x_toggle_visible_pointer (f, invisible); + unblock_input (); +} + /* 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 (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 +10878,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 +10905,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 +10938,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); @@ -4635,6 +10978,67 @@ x_window_to_frame (struct x_display_info *dpyinfo, int wdesc) return 0; } +/* Like x_any_window_to_frame but only try to find tooltip frames. + + If wdesc is a toolkit tooltip without an associated frame, set + UNRELATED_TOOLTIP_P to true. Otherwise, set it to false. */ +static struct frame * +x_tooltip_window_to_frame (struct x_display_info *dpyinfo, + Window wdesc, bool *unrelated_tooltip_p) +{ + Lisp_Object tail, frame; + struct frame *f; +#ifdef USE_GTK + GtkWidget *widget; + GdkWindow *tooltip_window; +#endif + + *unrelated_tooltip_p = false; + + FOR_EACH_FRAME (tail, frame) + { + f = XFRAME (frame); + + if (FRAME_X_P (f) && FRAME_TOOLTIP_P (f) + && FRAME_DISPLAY_INFO (f) == dpyinfo + && FRAME_X_WINDOW (f) == wdesc) + return f; + +#ifdef USE_GTK + if (!FRAME_X_P (f)) + continue; + + if (FRAME_X_OUTPUT (f)->ttip_window) + widget = GTK_WIDGET (FRAME_X_OUTPUT (f)->ttip_window); + else + widget = NULL; + + if (widget) + tooltip_window = gtk_widget_get_window (widget); + else + tooltip_window = NULL; + +#ifdef HAVE_GTK3 + if (tooltip_window + && (gdk_x11_window_get_xid (tooltip_window) == wdesc)) + { + *unrelated_tooltip_p = true; + break; + } +#else + if (tooltip_window + && (GDK_WINDOW_XID (tooltip_window) == wdesc)) + { + *unrelated_tooltip_p = true; + break; + } +#endif +#endif + } + + return NULL; +} + #if defined (USE_X_TOOLKIT) || defined (USE_GTK) /* Like x_window_to_frame but also compares the window with the widget's @@ -4650,6 +11054,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 +11104,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 +11182,756 @@ 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); +} + +static void +x_next_event_from_any_display (XEvent *event) +{ + struct x_display_info *dpyinfo; + fd_set fds, rfds; + int fd, maxfd, rc; + + rc = -1; + FD_ZERO (&rfds); + + while (true) + { + FD_ZERO (&fds); + maxfd = -1; + + for (dpyinfo = x_display_list; dpyinfo; + dpyinfo = dpyinfo->next) + { + fd = ConnectionNumber (dpyinfo->display); + + if ((rc < 0 || FD_ISSET (fd, &rfds)) + && XPending (dpyinfo->display)) + { + XNextEvent (dpyinfo->display, event); + return; + } + + if (fd > maxfd) + maxfd = fd; + + eassert (fd < FD_SETSIZE); + FD_SET (fd, &fds); + } + + eassert (maxfd >= 0); + + /* Continue to read input even if pselect fails, because if an + error occurs XPending will call the IO error handler, which + then brings us out of this loop. */ + rc = pselect (maxfd + 1, &fds, NULL, NULL, NULL, NULL); + + if (rc >= 0) + rfds = fds; + } +} #endif /* USE_X_TOOLKIT || USE_GTK */ +static void +x_handle_pending_selection_requests_1 (struct x_selection_request_event *tem) +{ + specpdl_ref count; + struct selection_input_event se; + + count = SPECPDL_INDEX (); + se = tem->se; + + record_unwind_protect_ptr (xfree, tem); + x_handle_selection_event (&se); + unbind_to (count, Qnil); +} + +/* Handle all pending selection request events from modal event + loops. */ +void +x_handle_pending_selection_requests (void) +{ + struct x_selection_request_event *tem; + + while (pending_selection_requests) + { + tem = pending_selection_requests; + pending_selection_requests = tem->next; + + x_handle_pending_selection_requests_1 (tem); + } +} + +static void +x_push_selection_request (struct selection_input_event *se) +{ + struct x_selection_request_event *tem; + + tem = xmalloc (sizeof *tem); + tem->next = pending_selection_requests; + tem->se = *se; + pending_selection_requests = tem; +} + +bool +x_detect_pending_selection_requests (void) +{ + return !!pending_selection_requests; +} + +static void +x_clear_dnd_action (void) +{ + x_dnd_action_symbol = Qnil; +} + +/* Delete action descriptions from F after drag-and-drop. */ +static void +x_dnd_delete_action_list (Lisp_Object frame) +{ + struct frame *f; + + /* 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. This can be called with FRAME no + longer alive (or its display dead). */ + + f = XFRAME (frame); + + if (!FRAME_LIVE_P (f) || !FRAME_DISPLAY_INFO (f)->display) + return; + + 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 (); +} + +static void +x_dnd_lose_ownership (Lisp_Object timestamp_and_frame) +{ + struct frame *f; + + f = XFRAME (XCDR (timestamp_and_frame)); + + if (FRAME_LIVE_P (f)) + Fx_disown_selection_internal (QXdndSelection, + XCAR (timestamp_and_frame), + XCDR (timestamp_and_frame)); +} + +/* Clean up an existing drag-and-drop operation in preparation for its + sudden termination. */ + +static void +x_dnd_process_quit (struct frame *f, Time timestamp) +{ + xm_drop_start_message dmsg; + + 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 = 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, x_dnd_motif_operations, + XM_DROP_ACTION_DROP_CANCEL); + dmsg.x = 0; + dmsg.y = 0; + dmsg.index_atom = x_dnd_motif_atom; + dmsg.source_window = FRAME_X_WINDOW (f); + + x_dnd_send_xm_leave_for_drop (FRAME_DISPLAY_INFO (f), f, + x_dnd_last_seen_window, + 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_dnd_waiting_for_finish = false; + x_dnd_return_frame_object = NULL; + x_dnd_movement_frame = NULL; +} + +/* This function is defined far away from the rest of the XDND code so + it can utilize `x_any_window_to_frame'. */ + +/* Implementors beware! On most other platforms (where drag-and-drop + data is not provided via selections, but some kind of serialization + mechanism), it is usually much easier to implement a suitable + primitive instead of copying the C code here, and then to build + `x-begin-drag' on top of that, by making it a wrapper function in + Lisp that converts the list of targets and value of `XdndSelection' + to serialized data. Also be sure to update the data types used in + dnd.el. + + For examples of how to do this, see `haiku-drag-message' and + `x-begin-drag' in haikuselect.c and lisp/term/haiku-win.el, and + `ns-begin-drag' and `x-begin-drag' in nsselect.m and + lisp/term/ns-win.el. */ + +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, Atom *target_atoms, + int ntargets, Lisp_Object selection_target_list, + bool follow_tooltip) +{ +#ifndef USE_GTK + XEvent next_event; + int finish; +#endif + XWindowAttributes root_window_attrs; + struct input_event hold_quit; + char *atom_name, *ask_actions; + Lisp_Object action, ltimestamp, val; + specpdl_ref ref, count, base; + ptrdiff_t i, end, fill; + XTextProperty prop; + Lisp_Object frame_object, x, y, frame, local_value; + bool signals_were_pending, need_sync; +#ifdef HAVE_XKB + XkbStateRec keyboard_state; +#endif +#ifndef USE_GTK + struct x_display_info *event_display; +#endif + unsigned int additional_mask; + + base = SPECPDL_INDEX (); + + /* Bind this here to avoid juggling bindings and SAFE_FREE in + Fx_begin_drag. */ + specbind (Qx_dnd_targets_list, selection_target_list); + + if (!FRAME_VISIBLE_P (f)) + error ("Frame must be visible"); + + XSETFRAME (frame, f); + local_value = assq_no_quit (QXdndSelection, + FRAME_TERMINAL (f)->Vselection_alist); + + if (x_dnd_in_progress || x_dnd_waiting_for_finish) + error ("A drag-and-drop session is already in progress"); + + DEFER_SELECTIONS; + + /* If local_value is nil, then we lost ownership of XdndSelection. + Signal a more informative error than args-out-of-range. */ + if (NILP (local_value)) + error ("No local value for XdndSelection"); + + if (popup_activated ()) + error ("Trying to drag-and-drop from within a menu-entry"); + + x_set_dnd_targets (target_atoms, ntargets); + record_unwind_protect_void (x_free_dnd_targets); + record_unwind_protect_void (x_clear_dnd_action); + + ltimestamp = x_timestamp_for_selection (FRAME_DISPLAY_INFO (f), + QXdndSelection); + + if (NILP (ltimestamp)) + error ("No local value for XdndSelection"); + + if (BIGNUMP (ltimestamp)) + x_dnd_selection_timestamp = bignum_to_intmax (ltimestamp); + else + x_dnd_selection_timestamp = XFIXNUM (ltimestamp); + + /* Release ownership of XdndSelection after this function returns. + VirtualBox uses the owner of XdndSelection to determine whether + or not mouse motion is part of a drag-and-drop operation. */ + + if (!x_dnd_preserve_selection_data) + record_unwind_protect (x_dnd_lose_ownership, + Fcons (ltimestamp, frame)); + + x_dnd_motif_operations + = xm_side_effect_from_action (FRAME_DISPLAY_INFO (f), xaction); + + x_dnd_first_motif_operation = XM_DRAG_NOOP; + + if (n_ask_actions) + { + x_dnd_motif_operations + = xm_operations_from_actions (FRAME_DISPLAY_INFO (f), + ask_action_list, + n_ask_actions); + x_dnd_first_motif_operation + = xm_side_effect_from_action (FRAME_DISPLAY_INFO (f), + ask_action_list[0]); + + record_unwind_protect (x_dnd_delete_action_list, frame); + + ask_actions = NULL; + end = 0; + count = SPECPDL_INDEX (); + + 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; + + record_unwind_protect_ptr (xfree, ask_actions); + + /* This can potentially store a lot of data in window + properties, so check for allocation errors. */ + block_input (); + x_catch_errors (FRAME_X_DISPLAY (f)); + XSetTextProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + &prop, FRAME_DISPLAY_INFO (f)->Xatom_XdndActionDescription); + + 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); + x_check_errors (FRAME_X_DISPLAY (f), + "Can't set action descriptions: %s"); + x_uncatch_errors_after_check (); + unblock_input (); + + unbind_to (count, Qnil); + } + + record_unwind_protect_void (x_clear_dnd_variables); + + if (follow_tooltip) + { +#if defined HAVE_XRANDR || defined USE_GTK + x_dnd_monitors + = FRAME_DISPLAY_INFO (f)->last_monitor_attributes_list; + + if (NILP (x_dnd_monitors)) +#endif + x_dnd_monitors + = Fx_display_monitor_attributes_list (frame); + } + + x_dnd_update_tooltip = follow_tooltip; + + /* This shouldn't happen. */ + if (x_dnd_toplevels) + x_dnd_free_toplevels (true); + +#ifdef USE_GTK + /* Prevent GTK+ timeouts from being run, since they can call + handle_one_xevent behind our back. */ + suppress_xg_select (); + record_unwind_protect_void (release_xg_select); +#endif + + /* Set up a meaningless alias. */ + XSETCAR (x_dnd_selection_alias_cell, QSECONDARY); + XSETCDR (x_dnd_selection_alias_cell, QSECONDARY); + + /* Bind this here. The cell doesn't actually alias between + anything until `xm_setup_dnd_targets' is called. */ + specbind (Qx_selection_alias_alist, + Fcons (x_dnd_selection_alias_cell, + Vx_selection_alias_alist)); + + /* Initialize most of the state for the drag-and-drop operation. */ + x_dnd_in_progress = true; + x_dnd_recursion_depth = command_loop_level + minibuf_level; + 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_window_is_frame = false; + x_dnd_last_motif_style = XM_DRAG_STYLE_NONE; + x_dnd_mouse_rect_target = None; + x_dnd_action = None; + x_dnd_action_symbol = Qnil; + 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_waiting_for_status_window = None; + x_dnd_pending_send_position.type = 0; + x_dnd_xm_use_help = false; + x_dnd_motif_setup_p = false; + x_dnd_end_window = None; + x_dnd_run_unsupported_drop_function = false; + 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; + x_dnd_init_type_lists = false; + x_dnd_need_send_drop = false; +#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 (true); + x_dnd_use_toplevels = false; + } + else + record_unwind_protect_void (x_free_dnd_toplevels); + } + + if (!NILP (return_frame)) + x_dnd_return_frame = 1; + + if (EQ (return_frame, Qnow)) + x_dnd_return_frame = 2; + + /* Now select for SubstructureNotifyMask and PropertyChangeMask 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); + + additional_mask = SubstructureNotifyMask; + + if (x_dnd_use_toplevels) + additional_mask |= PropertyChangeMask; + + XSelectInput (FRAME_X_DISPLAY (f), + FRAME_DISPLAY_INFO (f)->root_window, + root_window_attrs.your_event_mask + | additional_mask); + + if (EQ (return_frame, Qnow)) + x_dnd_update_state (FRAME_DISPLAY_INFO (f), CurrentTime); + + while (x_dnd_in_progress || x_dnd_waiting_for_finish) + { + EVENT_INIT (hold_quit); + +#ifdef USE_GTK + current_finish = X_EVENT_NORMAL; + current_hold_quit = &hold_quit; + current_count = 0; + xg_pending_quit_event.kind = NO_EVENT; +#endif + + block_input (); + x_dnd_inside_handle_one_xevent = true; +#ifdef USE_GTK + gtk_main_iteration (); +#elif defined USE_X_TOOLKIT + XtAppNextEvent (Xt_app_con, &next_event); +#else + x_next_event_from_any_display (&next_event); +#endif + +#ifndef USE_GTK + event_display + = x_display_info_for_display (next_event.xany.display); + + if (event_display) + { +#ifdef HAVE_X_I18N +#ifdef HAVE_XINPUT2 + if (next_event.type != GenericEvent + || !event_display->supports_xi2 + || (next_event.xgeneric.extension + != event_display->xi2_opcode)) + { +#endif + if (!x_filter_event (event_display, &next_event)) + handle_one_xevent (event_display, + &next_event, &finish, &hold_quit); +#ifdef HAVE_XINPUT2 + } + else + handle_one_xevent (event_display, + &next_event, &finish, &hold_quit); +#endif +#else + handle_one_xevent (event_display, + &next_event, &finish, &hold_quit); +#endif + } +#else + /* Clear these before the read_socket_hook can be called. */ + current_count = -1; + current_hold_quit = NULL; +#endif + x_dnd_inside_handle_one_xevent = false; + + /* Clean up any event handlers that are now out of date. */ + x_clean_failable_requests (FRAME_DISPLAY_INFO (f)); + + /* The unblock_input below might try to read input, but + XTread_socket does nothing inside a drag-and-drop event + loop, so don't let it clear the pending_signals flag. */ + signals_were_pending = pending_signals; + unblock_input (); + pending_signals = signals_were_pending; + + /* Ignore mouse movement from displays that aren't the DND + display. */ +#ifndef USE_GTK + if (event_display == FRAME_DISPLAY_INFO (f)) + { +#endif + if (x_dnd_movement_frame + /* FIXME: how come this can end up with movement frames + from other displays on GTK builds? */ + && (FRAME_X_DISPLAY (x_dnd_movement_frame) + == FRAME_X_DISPLAY (f)) + /* If both those variables are false, then F is no + longer protected from deletion by Lisp code. This + can only happen during the final iteration of the DND + event loop. */ + && (x_dnd_in_progress || x_dnd_waiting_for_finish)) + { + 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_LIVE_P (XFRAME (frame_object)) + && !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) + { + x_dnd_process_quit (f, hold_quit.timestamp); +#ifdef USE_GTK + current_hold_quit = NULL; +#endif + /* Restore the old event mask. */ + x_restore_events_after_dnd (f, &root_window_attrs); + + /* Call kbd_buffer_store event, which calls + handle_interrupt and sets `last-event-frame' along + with various other things. */ + kbd_buffer_store_event (&hold_quit); + /* Now quit anyway. */ + quit (); + } + + if (pending_selection_requests + && (x_dnd_in_progress || x_dnd_waiting_for_finish)) + { + 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_pending_selection_requests (); + x_dnd_unwind_flag = false; + unbind_to (ref, Qnil); + } + + /* Sometimes C-g can be pressed inside a selection + converter, where quitting is inhibited. We want + to quit after the converter exits. */ + if (!NILP (Vquit_flag) && !NILP (Vinhibit_quit)) + { + x_dnd_process_quit (f, FRAME_DISPLAY_INFO (f)->last_user_time); +#ifdef USE_GTK + current_hold_quit = NULL; +#endif + x_restore_events_after_dnd (f, &root_window_attrs); + quit (); + } + + if (x_dnd_run_unsupported_drop_function + && x_dnd_waiting_for_finish) + { + x_dnd_run_unsupported_drop_function = false; + x_dnd_waiting_for_finish = false; + x_dnd_unwind_flag = true; + + ref = SPECPDL_INDEX (); + record_unwind_protect_ptr (x_dnd_cleanup_drag_and_drop, f); + + if (!NILP (Vx_dnd_unsupported_drop_function)) + val = call8 (Vx_dnd_unsupported_drop_function, + XCAR (XCDR (x_dnd_unsupported_drop_data)), + Fnth (make_fixnum (3), x_dnd_unsupported_drop_data), + Fnth (make_fixnum (4), x_dnd_unsupported_drop_data), + Fnth (make_fixnum (2), x_dnd_unsupported_drop_data), + make_uint (x_dnd_unsupported_drop_window), + frame, make_uint (x_dnd_unsupported_drop_time), + Fcopy_sequence (XCAR (x_dnd_unsupported_drop_data))); + else + val = Qnil; + + if (NILP (val)) + x_dnd_do_unsupported_drop (FRAME_DISPLAY_INFO (f), + frame, XCAR (x_dnd_unsupported_drop_data), + XCAR (XCDR (x_dnd_unsupported_drop_data)), + x_dnd_unsupported_drop_window, + XFIXNUM (Fnth (make_fixnum (3), + x_dnd_unsupported_drop_data)), + XFIXNUM (Fnth (make_fixnum (4), + x_dnd_unsupported_drop_data)), + x_dnd_unsupported_drop_time); + else if (SYMBOLP (val)) + x_dnd_action_symbol = val; + + x_dnd_unwind_flag = false; + unbind_to (ref, Qnil); + + /* Break out of the loop now, since DND has + completed. */ + break; + } + +#ifdef USE_GTK + if (xg_pending_quit_event.kind != NO_EVENT) + { + xg_pending_quit_event.kind = NO_EVENT; + current_hold_quit = NULL; + + x_dnd_process_quit (f, FRAME_DISPLAY_INFO (f)->last_user_time); + x_restore_events_after_dnd (f, &root_window_attrs); + quit (); + } +#else + } + else + { + if (x_dnd_movement_frame) + x_dnd_movement_frame = NULL; + + if (hold_quit.kind != NO_EVENT) + EVENT_INIT (hold_quit); + } +#endif + } + + x_dnd_waiting_for_finish = false; + +#ifdef USE_GTK + current_hold_quit = NULL; +#endif + x_dnd_movement_frame = NULL; + x_restore_events_after_dnd (f, &root_window_attrs); + + 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 unbind_to (base, action); + } + + x_dnd_return_frame_object = NULL; + FRAME_DISPLAY_INFO (f)->grabbed = 0; + + if (!NILP (x_dnd_action_symbol)) + return unbind_to (base, x_dnd_action_symbol); + + if (x_dnd_action != None) + { + block_input (); + x_catch_errors (FRAME_X_DISPLAY (f)); + atom_name = x_get_atom_name (FRAME_DISPLAY_INFO (f), + x_dnd_action, &need_sync); + + if (need_sync) + x_uncatch_errors (); + else + /* No protocol request actually happened, so avoid the extra + sync by calling x_uncatch_errors_after_check instead. */ + x_uncatch_errors_after_check (); + + if (atom_name) + { + action = intern (atom_name); + xfree (atom_name); + } + else + action = Qnil; + unblock_input (); + + return unbind_to (base, action); + } + + return unbind_to (base, 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 +11962,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 @@ -4805,8 +12002,8 @@ x_detect_focus_change (struct x_display_info *dpyinfo, struct frame *frame, really has focus, and these kinds of focus event don't correspond to real user input changes. GTK+ uses the same filtering. */ - if (event->xfocus.mode == NotifyGrab || - event->xfocus.mode == NotifyUngrab) + if (event->xfocus.mode == NotifyGrab + || event->xfocus.mode == NotifyUngrab) return; x_focus_changed (event->type, (event->xfocus.detail == NotifyPointer ? @@ -4826,12 +12023,21 @@ x_detect_focus_change (struct x_display_info *dpyinfo, struct frame *frame, } -#if !defined USE_X_TOOLKIT && !defined USE_GTK +#if (defined USE_LUCID && defined HAVE_XINPUT2) \ + || (!defined USE_X_TOOLKIT && !defined USE_GTK) /* Handle an event saying the mouse has moved out of an Emacs frame. */ void x_mouse_leave (struct x_display_info *dpyinfo) { + Mouse_HLInfo *hlinfo = &dpyinfo->mouse_highlight; + + if (hlinfo->mouse_face_mouse_frame) + { + clear_mouse_face (hlinfo); + hlinfo->mouse_face_mouse_frame = NULL; + } + x_new_focus_frame (dpyinfo, dpyinfo->x_focus_event_frame); } #endif @@ -4891,6 +12097,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 +12109,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 +12172,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; + KeyCode code = mods->modifiermap[(row * mods->max_keypermod) + col]; - case XK_Alt_L: - case XK_Alt_R: - found_alt_or_meta = true; - dpyinfo->alt_mod_mask |= (1 << row); - break; + /* Zeroes are used for filler. Skip them. */ + if (code == 0) + continue; - 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; + /* 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 +12248,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 +12293,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 +12361,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 +12392,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 +12413,20 @@ 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', `send_event', `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; @@ -5136,6 +12436,7 @@ x_note_mouse_movement (struct frame *frame, const XMotionEvent *event) dpyinfo = FRAME_DISPLAY_INFO (frame); dpyinfo->last_mouse_movement_time = event->time; + dpyinfo->last_mouse_movement_time_send_event = event->send_event; dpyinfo->last_mouse_motion_frame = frame; dpyinfo->last_mouse_motion_x = event->x; dpyinfo->last_mouse_motion_y = event->y; @@ -5143,6 +12444,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 +12459,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. */ @@ -5168,6 +12471,80 @@ x_note_mouse_movement (struct frame *frame, const XMotionEvent *event) return false; } +/* Get a sibling below WINDOW on DPY at PARENT_X and PARENT_Y. */ +static Window +x_get_window_below (Display *dpy, Window window, + int parent_x, int parent_y, + int *inner_x, int *inner_y) +{ + int rc, i, cx, cy; + XWindowAttributes attrs; + unsigned int nchildren; + Window root, parent, *children, value; + bool window_seen; + + /* TODO: rewrite to have less dependencies. */ + + children = NULL; + window_seen = false; + value = None; + + rc = XQueryTree (dpy, window, &root, &parent, + &children, &nchildren); + + if (rc) + { + if (children) + XFree (children); + + rc = XQueryTree (dpy, parent, &root, + &parent, &children, &nchildren); + } + + if (rc) + { + for (i = nchildren - 1; i >= 0; --i) + { + if (children[i] == window) + { + window_seen = true; + continue; + } + + if (!window_seen) + continue; + + rc = XGetWindowAttributes (dpy, children[i], &attrs); + + if (rc && attrs.map_state != IsViewable) + continue; + + if (rc && parent_x >= attrs.x + && parent_y >= attrs.y + && parent_x < attrs.x + attrs.width + && parent_y < attrs.y + attrs.height) + { + value = children[i]; + cx = parent_x - attrs.x; + cy = parent_y - attrs.y; + + break; + } + } + } + + if (children) + XFree (children); + + if (value) + { + *inner_x = cx; + *inner_y = cy; + } + + return value; +} + /* Return the current position of the mouse. *FP should be a frame which indicates which display to ask about. @@ -5193,8 +12570,9 @@ XTmouse_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 frame *f1, *maybe_tooltip; struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (*fp); + bool unrelated_tooltip; block_input (); @@ -5249,9 +12627,11 @@ XTmouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, Window first_win = 0; #endif int win_x, win_y; - int parent_x = 0, parent_y = 0; + int parent_x, parent_y; win = root; + parent_x = root_x; + parent_y = root_y; /* XTranslateCoordinates can get errors if the window structure is changing at the same time this function @@ -5259,7 +12639,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. */ @@ -5285,6 +12666,22 @@ XTmouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, root_x, root_y, &win_x, &win_y, /* Child of win. */ &child); + + /* If CHILD is a tooltip frame, look below it if + track-mouse is drag-source. */ + if (child != None + && (EQ (track_mouse, Qdrag_source) + || EQ (track_mouse, Qdropping))) + { + maybe_tooltip = x_tooltip_window_to_frame (dpyinfo, child, + &unrelated_tooltip); + + if (maybe_tooltip || unrelated_tooltip) + child = x_get_window_below (dpyinfo->display, child, + parent_x, parent_y, &win_x, + &win_y); + } + if (child == None || child == win) { #ifdef USE_GTK @@ -5347,8 +12744,20 @@ XTmouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, #endif /* USE_X_TOOLKIT */ } + /* Set last user time to avoid confusing some window managers + about the tooltip displayed during drag-and-drop. */ + + if ((EQ (track_mouse, Qdrag_source) + || EQ (track_mouse, Qdropping)) + && (dpyinfo->last_user_time + < dpyinfo->last_mouse_movement_time)) + x_display_set_last_user_time (dpyinfo, + dpyinfo->last_mouse_movement_time, + dpyinfo->last_mouse_movement_time_send_event); + 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 +12773,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 +12804,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 +12817,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 +12827,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 +12862,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 +13043,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 +13089,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 +13124,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 +13620,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 +13845,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 +14255,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 +14286,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 +14404,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 +14458,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 +14487,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 +14540,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 +14965,79 @@ 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 + int x, y, width, height; + + if (event->type == Expose) + { + x = event->xexpose.x; + y = event->xexpose.y; + width = event->xexpose.width; + height = event->xexpose.height; + } + else + { + x = event->xgraphicsexpose.x; + y = event->xgraphicsexpose.y; + width = event->xgraphicsexpose.width; + height = event->xgraphicsexpose.height; + } + 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, x, y, width, 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); + + This code is no longer required since the normal GC now uses the + regular line width. */ + /* 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 (); } @@ -7411,8 +15053,14 @@ x_scroll_bar_expose (struct scroll_bar *bar, const XEvent *event) static void x_scroll_bar_handle_click (struct scroll_bar *bar, const XEvent *event, - struct input_event *emacs_event) + struct input_event *emacs_event, + Lisp_Object device) { + int left_range, x, top_range, y; +#ifndef USE_TOOLKIT_SCROLL_BARS + int new_start, new_end; +#endif + if (! WINDOWP (bar->window)) emacs_abort (); @@ -7430,11 +15078,15 @@ x_scroll_bar_handle_click (struct scroll_bar *bar, emacs_event->frame_or_window = bar->window; emacs_event->arg = Qnil; emacs_event->timestamp = event->xbutton.time; + + if (!NILP (device)) + emacs_event->device = device; + if (bar->horizontal) { - int left_range - = HORIZONTAL_SCROLL_BAR_LEFT_RANGE (f, bar->width); - int x = event->xbutton.x - HORIZONTAL_SCROLL_BAR_LEFT_BORDER; + + left_range = HORIZONTAL_SCROLL_BAR_LEFT_RANGE (f, bar->width); + x = event->xbutton.x - HORIZONTAL_SCROLL_BAR_LEFT_BORDER; if (x < 0) x = 0; if (x > left_range) x = left_range; @@ -7450,8 +15102,8 @@ x_scroll_bar_handle_click (struct scroll_bar *bar, /* If the user has released the handle, set it to its final position. */ if (event->type == ButtonRelease && bar->dragging != -1) { - int new_start = - bar->dragging; - int new_end = new_start + bar->end - bar->start; + new_start = - bar->dragging; + new_end = new_start + bar->end - bar->start; x_scroll_bar_set_handle (bar, new_start, new_end, false); bar->dragging = -1; @@ -7463,9 +15115,9 @@ x_scroll_bar_handle_click (struct scroll_bar *bar, } else { - int top_range + top_range = VERTICAL_SCROLL_BAR_TOP_RANGE (f, bar->height); - int y = event->xbutton.y - VERTICAL_SCROLL_BAR_TOP_BORDER; + y = event->xbutton.y - VERTICAL_SCROLL_BAR_TOP_BORDER; if (y < 0) y = 0; if (y > top_range) y = top_range; @@ -7481,8 +15133,8 @@ x_scroll_bar_handle_click (struct scroll_bar *bar, /* If the user has released the handle, set it to its final position. */ if (event->type == ButtonRelease && bar->dragging != -1) { - int new_start = y - bar->dragging; - int new_end = new_start + bar->end - bar->start; + new_start = y - bar->dragging; + new_end = new_start + bar->end - bar->start; x_scroll_bar_set_handle (bar, new_start, new_end, false); bar->dragging = -1; @@ -7509,6 +15161,7 @@ x_scroll_bar_note_movement (struct scroll_bar *bar, struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); dpyinfo->last_mouse_movement_time = event->time; + dpyinfo->last_mouse_movement_time_send_event = event->send_event; dpyinfo->last_mouse_scroll_bar = bar; f->mouse_moved = true; @@ -7527,6 +15180,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 +15348,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 +15365,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 +15420,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 +15437,71 @@ 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 (); + + /* Clear `xg_pending_quit_event' so we don't end up reacting to quit + events sent outside the main event loop (i.e. those sent from + inside a popup menu event loop). */ + + if (popup_activated ()) + xg_pending_quit_event.kind = NO_EVENT; + + 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 +15528,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 +15593,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,28 +15614,52 @@ 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 F if it has undrawn content. */ + +#ifdef HAVE_XDBE 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_GARBAGED_P (f) + && !buffer_flipping_blocked_p () + && FRAME_X_NEED_BUFFER_FLIP (f)) + show_back_buffer (f); unblock_input (); } +#endif + +#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 @@ -7873,7 +15676,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 +15693,598 @@ mouse_or_wdesc_frame (struct x_display_info *dpyinfo, int wdesc) } } +static void +x_dnd_compute_tip_xy (int *root_x, int *root_y, Lisp_Object attributes) +{ + Lisp_Object monitor, geometry; + int min_x, min_y, max_x, max_y; + int width, height; + + width = FRAME_PIXEL_WIDTH (XFRAME (tip_frame)); + height = FRAME_PIXEL_HEIGHT (XFRAME (tip_frame)); + + max_y = -1; + + /* Try to determine the monitor where the mouse pointer is and + its geometry. See bug#22549. */ + while (CONSP (attributes)) + { + monitor = XCAR (attributes); + geometry = assq_no_quit (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 (x_dnd_frame)); + max_y = x_display_pixel_height (FRAME_DISPLAY_INFO (x_dnd_frame)); + } + + if (*root_y + XFIXNUM (tip_dy) <= min_y) + *root_y = min_y; /* Can happen for negative dy */ + else if (*root_y + XFIXNUM (tip_dy) + height <= max_y) + /* It fits below the pointer */ + *root_y += XFIXNUM (tip_dy); + else if (height + XFIXNUM (tip_dy) + min_y <= *root_y) + /* It fits above the pointer. */ + *root_y -= height + XFIXNUM (tip_dy); + else + /* Put it on the top. */ + *root_y = min_y; + + if (*root_x + XFIXNUM (tip_dx) <= min_x) + *root_x = 0; /* Can happen for negative dx */ + else if (*root_x + XFIXNUM (tip_dx) + width <= max_x) + /* It fits to the right of the pointer. */ + *root_x += XFIXNUM (tip_dx); + else if (width + XFIXNUM (tip_dx) + min_x <= *root_x) + /* It fits to the left of the pointer. */ + *root_x -= width + XFIXNUM (tip_dx); + else + /* Put it left justified on the screen -- it ought to fit that way. */ + *root_x = min_x; +} + +static void +x_dnd_update_tooltip_position (int root_x, int root_y) +{ + struct frame *tip_f; + + if (!x_dnd_in_progress || !x_dnd_update_tooltip) + return; + + if (!FRAMEP (tip_frame)) + return; + + tip_f = XFRAME (tip_frame); + + if (!FRAME_LIVE_P (tip_f) + || !FRAME_VISIBLE_P (tip_f) + || (FRAME_X_DISPLAY (tip_f) + != FRAME_X_DISPLAY (x_dnd_frame))) + return; + + if (tip_window != None + && FIXNUMP (tip_dx) && FIXNUMP (tip_dy)) + { + x_dnd_compute_tip_xy (&root_x, &root_y, + x_dnd_monitors); + + XMoveWindow (FRAME_X_DISPLAY (x_dnd_frame), + tip_window, root_x, root_y); + } +} + +static void +x_dnd_update_tooltip_now (void) +{ + int root_x, root_y; + Window root, child; + int win_x, win_y; + unsigned int mask; + Bool rc; + struct x_display_info *dpyinfo; + + if (!x_dnd_in_progress || !x_dnd_update_tooltip) + return; + + dpyinfo = FRAME_DISPLAY_INFO (x_dnd_frame); + + rc = XQueryPointer (dpyinfo->display, + dpyinfo->root_window, + &root, &child, &root_x, + &root_y, &win_x, &win_y, + &mask); + + if (rc) + x_dnd_update_tooltip_position (root_x, root_y); +} + +/* 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; + bool was_frame; + + 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, + &was_frame); + + 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_disable_motif_drag + && 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_disable_motif_drag + && 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; + x_dnd_last_window_is_frame = was_frame; + + 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) + && !x_dnd_disable_motif_drag) + { + 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 = x_dnd_motif_atom; + + 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_window_is_frame && target != None) + x_dnd_note_self_position (dpyinfo, target, root_x, root_y); + else 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 + && !x_dnd_disable_motif_drag) + { + 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, x_dnd_motif_operations, + (!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); + } + + x_dnd_update_tooltip_position (root_x, root_y); + } + /* 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, x_dnd_motif_operations, + XM_DROP_ACTION_DROP_CANCEL); + dsmsg.x = 0; + dsmsg.y = 0; + dsmsg.index_atom = x_dnd_motif_atom; + 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; + } +} + +int +x_display_pixel_height (struct x_display_info *dpyinfo) +{ + if (dpyinfo->screen_height) + return dpyinfo->screen_height; + + return HeightOfScreen (dpyinfo->screen); +} + +int +x_display_pixel_width (struct x_display_info *dpyinfo) +{ + if (dpyinfo->screen_width) + return dpyinfo->screen_width; + + return WidthOfScreen (dpyinfo->screen); +} + +/* Handle events from each display until CELL's car becomes non-nil, + or TIMEOUT elapses. */ +void +x_wait_for_cell_change (Lisp_Object cell, struct timespec timeout) +{ + struct x_display_info *dpyinfo; + fd_set fds; + int fd, maxfd; +#ifndef USE_GTK + int finish, rc; + XEvent event; + fd_set rfds; +#endif + struct input_event hold_quit; + struct timespec current, at; + + at = timespec_add (current_timespec (), timeout); + +#ifndef USE_GTK + FD_ZERO (&rfds); + rc = -1; +#endif + + while (true) + { + FD_ZERO (&fds); + maxfd = -1; + + for (dpyinfo = x_display_list; dpyinfo; + dpyinfo = dpyinfo->next) + { + fd = ConnectionNumber (dpyinfo->display); + +#ifndef USE_GTK + if ((rc < 0 || FD_ISSET (fd, &rfds)) + /* If pselect failed, the erroring display's IO error + handler will eventually be called. */ + && XPending (dpyinfo->display)) + { + while (XPending (dpyinfo->display)) + { + EVENT_INIT (hold_quit); + + XNextEvent (dpyinfo->display, &event); + handle_one_xevent (dpyinfo, &event, + &finish, &hold_quit); + + if (!NILP (XCAR (cell))) + return; + + if (finish == X_EVENT_GOTO_OUT) + break; + + /* Make us quit now. */ + if (hold_quit.kind != NO_EVENT) + kbd_buffer_store_event (&hold_quit); + } + } +#endif + + if (fd > maxfd) + maxfd = fd; + + eassert (fd < FD_SETSIZE); + FD_SET (fd, &fds); + } + + /* Prevent events from being lost (from GTK's point of view) by + using GDK to run the event loop. */ +#ifdef USE_GTK + while (gtk_events_pending ()) + { + EVENT_INIT (hold_quit); + current_count = 0; + current_hold_quit = &hold_quit; + current_finish = X_EVENT_NORMAL; + + gtk_main_iteration (); + + current_count = -1; + current_hold_quit = NULL; + + /* Make us quit now. */ + if (hold_quit.kind != NO_EVENT) + kbd_buffer_store_event (&hold_quit); + + if (!NILP (XCAR (cell))) + return; + + if (current_finish == X_EVENT_GOTO_OUT) + break; + } +#endif + + eassert (maxfd >= 0); + + current = current_timespec (); + + if (timespec_cmp (at, current) < 0 + || !NILP (XCAR (cell))) + return; + + timeout = timespec_sub (at, current); + +#ifndef USE_GTK + rc = pselect (maxfd + 1, &fds, NULL, NULL, &timeout, NULL); + + if (rc >= 0) + rfds = fds; +#else + pselect (maxfd + 1, &fds, NULL, NULL, &timeout, NULL); +#endif + } +} + +#ifdef USE_GTK +static void +x_monitors_changed_cb (GdkScreen *gscr, gpointer user_data) +{ + struct x_display_info *dpyinfo; + struct input_event ie; + Lisp_Object current_monitors, terminal; + GdkDisplay *gdpy; + Display *dpy; + + gdpy = gdk_screen_get_display (gscr); + dpy = gdk_x11_display_get_xdisplay (gdpy); + dpyinfo = x_display_info_for_display (dpy); + + if (!dpyinfo) + return; + + XSETTERMINAL (terminal, dpyinfo->terminal); + + current_monitors + = Fx_display_monitor_attributes_list (terminal); + + if (NILP (Fequal (current_monitors, + dpyinfo->last_monitor_attributes_list))) + { + EVENT_INIT (ie); + ie.kind = MONITORS_CHANGED_EVENT; + ie.arg = terminal; + + kbd_buffer_store_event (&ie); + + if (x_dnd_in_progress && x_dnd_update_tooltip) + x_dnd_monitors = current_monitors; + + x_dnd_update_tooltip_now (); + } + + dpyinfo->last_monitor_attributes_list = current_monitors; +} +#endif + +/* Extract the root window coordinates from the client message EVENT + if it is a message that we already understand. Return false if the + event was not understood. */ +static bool +x_coords_from_dnd_message (struct x_display_info *dpyinfo, + XEvent *event, int *x_out, int *y_out) +{ + xm_drag_motion_message dmsg; + xm_drag_motion_reply dreply; + xm_drop_start_message smsg; + xm_drop_start_reply reply; + unsigned long kde_data; + + if (event->type != ClientMessage) + return false; + + if (event->xclient.message_type == dpyinfo->Xatom_XdndPosition) + { + if (event->xclient.format != 32) + return false; + + *x_out = (((unsigned long) event->xclient.data.l[2]) >> 16 + & 0xffff); + *y_out = (event->xclient.data.l[2] & 0xffff); + + return true; + } + + if ((event->xclient.message_type + == dpyinfo->Xatom_MOTIF_DRAG_AND_DROP_MESSAGE) + && event->xclient.format == 8) + { + if (!xm_read_drag_motion_message (event, &dmsg)) + { + *x_out = dmsg.x; + *y_out = dmsg.y; + + return true; + } + else if (!xm_read_drag_motion_reply (event, &dreply)) + { + *x_out = dreply.better_x; + *y_out = dreply.better_y; + + return true; + } + else if (!xm_read_drop_start_message (event, &smsg)) + { + *x_out = smsg.x; + *y_out = smsg.y; + + return true; + } + else if (!xm_read_drop_start_reply (event, &reply)) + { + *x_out = reply.better_x; + *y_out = reply.better_y; + + return true; + } + } + + if (((event->xclient.message_type + == dpyinfo->Xatom_DndProtocol) + || (event->xclient.message_type + == dpyinfo->Xatom_DND_PROTOCOL)) + && event->xclient.format == 32 + /* Check that the version of the old KDE protocol is new + enough to include coordinates. */ + && event->xclient.data.l[4]) + { + kde_data = (unsigned long) event->xclient.data.l[3]; + + *x_out = (kde_data & 0xffff); + *y_out = (kde_data >> 16 & 0xffff); + + return true; + } + + return false; +} + /* Handles the XEvent EVENT on display DPYINFO. *FINISH is X_EVENT_GOTO_OUT if caller should stop reading events. @@ -7900,7 +16296,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 +16308,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,7 +16316,18 @@ handle_one_xevent (struct x_display_info *dpyinfo, static XComposeStatus compose_status; XEvent configureEvent; XEvent next_event; - + Lisp_Object coding; +#if defined USE_X_TOOLKIT && defined HAVE_XINPUT2 + /* Some XInput 2 events are important for Motif and Lucid 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 + int dx, dy; USE_SAFE_ALLOCA; *finish = X_EVENT_NORMAL; @@ -7926,7 +16336,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 +16359,172 @@ handle_one_xevent (struct x_display_info *dpyinfo, { case ClientMessage: { + int rc; + + if (((x_dnd_in_progress + && FRAME_DISPLAY_INFO (x_dnd_frame) == dpyinfo) + || (x_dnd_waiting_for_finish + && FRAME_DISPLAY_INFO (x_dnd_finish_frame) == dpyinfo)) + && event->xclient.message_type == dpyinfo->Xatom_XdndStatus) + { + Window target; + unsigned long r1, r2; + + target = event->xclient.data.l[0]; + + if (x_dnd_last_protocol_version != -1 + && x_dnd_in_progress + && target == x_dnd_last_seen_window + /* The XDND documentation is not very clearly worded. + But this should be the correct behavior, since + "kDNDStatusSendHereFlag" in the reference + implementation is 2, and means the mouse rect + should be ignored. */ + && !(event->xclient.data.l[1] & 2)) + { + r1 = event->xclient.data.l[2]; + r2 = event->xclient.data.l[3]; + + x_dnd_mouse_rect_target = target; + x_dnd_mouse_rect.x = (r1 & 0xffff0000) >> 16; + x_dnd_mouse_rect.y = (r1 & 0xffff); + x_dnd_mouse_rect.width = (r2 & 0xffff0000) >> 16; + x_dnd_mouse_rect.height = (r2 & 0xffff); + } + else + x_dnd_mouse_rect_target = None; + + if (x_dnd_last_protocol_version != -1 + && (x_dnd_in_progress + && 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; + } + + /* Send any pending XdndPosition message. */ + if (x_dnd_waiting_for_status_window == target) + { + if (x_dnd_pending_send_position.type != 0) + { + x_ignore_errors_for_next_request (dpyinfo); + XSendEvent (dpyinfo->display, target, + False, NoEventMask, + &x_dnd_pending_send_position); + x_stop_ignoring_errors (dpyinfo); + x_dnd_pending_send_position.type = 0; + + /* Since we sent another XdndPosition message, we + have to wait for another one in reply, so don't + reset `x_dnd_waiting_for_status_window' + here. */ + } + else + x_dnd_waiting_for_status_window = None; + + /* Send any pending drop if warranted. */ + if (x_dnd_waiting_for_finish && x_dnd_need_send_drop + && x_dnd_waiting_for_status_window == None) + { + if (event->xclient.data.l[1] & 1) + { + if (x_dnd_send_drop_proto >= 2) + x_dnd_action = event->xclient.data.l[4]; + else + x_dnd_action = dpyinfo->Xatom_XdndActionCopy; + } + else + x_dnd_action = None; + + x_dnd_waiting_for_finish + = x_dnd_send_drop (x_dnd_finish_frame, + target, x_dnd_selection_timestamp, + x_dnd_send_drop_proto); + } + } + + goto done; + } + + if (event->xclient.message_type == dpyinfo->Xatom_XdndFinished + && (x_dnd_waiting_for_finish && !x_dnd_waiting_for_motif_finish) + /* Also check that the display is correct, since + `x_dnd_pending_finish_target' could still be valid on + another X server. */ + && dpyinfo->display == x_dnd_finish_display + && 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) + && x_dnd_waiting_for_finish + && x_dnd_waiting_for_motif_finish == 1 + && dpyinfo == x_dnd_waiting_for_motif_finish_display) + { + 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 + && XM_DRAG_OPERATION_IS_LINK (operation)) + { + 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_symbol = QXdndActionMove; + break; + + case XM_DRAG_COPY: + x_dnd_action_symbol = QXdndActionCopy; + break; + + /* This means XM_DRAG_OPERATION_IS_LINK (operation). */ + default: + x_dnd_action_symbol = QXdndActionLink; + break; + } + + x_dnd_waiting_for_motif_finish = 2; + goto done; + } + } + if (event->xclient.message_type == dpyinfo->Xatom_wm_protocols && event->xclient.format == 32) { @@ -8016,15 +16606,99 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (event->xclient.data.l[0] == dpyinfo->Xatom_wm_delete_window) { - f = any; + f = x_top_window_to_frame (dpyinfo, + event->xclient.window); + if (!f) goto OTHER; /* May be a dialog that is to be removed */ inev.ie.kind = DELETE_WINDOW_EVENT; + inev.ie.timestamp = event->xclient.data.l[1]; XSETFRAME (inev.ie.frame_or_window, f); goto done; } + + if (event->xclient.data.l[0] == dpyinfo->Xatom_net_wm_ping + /* 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, make sure the client message's window is not + the root window if DND is in progress. */ + && (!(x_dnd_in_progress + || x_dnd_waiting_for_finish) + || event->xclient.window != dpyinfo->root_window) + && event->xclient.format == 32) + { + XEvent send_event = *event; + + send_event.xclient.window = dpyinfo->root_window; + XSendEvent (dpyinfo->display, dpyinfo->root_window, False, + 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); + window = gtk_widget_get_window (widget); + eassert (window); + + /* This could be a (former) child frame for which + frame synchronization was disabled. Enable it + now. */ + gdk_x11_window_set_frame_sync_enabled (window, TRUE); + + if (widget && !FRAME_X_OUTPUT (f)->xg_sync_end_pending_p) + { + 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; } @@ -8052,9 +16726,13 @@ handle_one_xevent (struct x_display_info *dpyinfo, { f = any; if (f) - _XEditResCheckMessages (f->output_data.x->widget, - NULL, (XEvent *) event, NULL); - goto done; + { + _XEditResCheckMessages (f->output_data.x->widget, + NULL, (XEvent *) event, NULL); + goto done; + } + + goto OTHER; } #endif /* X_TOOLKIT_EDITRES */ @@ -8070,7 +16748,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto OTHER; #ifndef USE_CAIRO Pixmap pixmap = (Pixmap) event->xclient.data.l[1]; + /* FIXME: why does this sometimes generate a BadMatch + error? */ + x_catch_errors (dpyinfo->display); x_kill_gs_process (pixmap, f); + x_uncatch_errors (); expose_frame (f, 0, 0, 0, 0); #endif /* !USE_CAIRO */ goto done; @@ -8109,38 +16791,56 @@ handle_one_xevent (struct x_display_info *dpyinfo, f = any; if (!f) goto OTHER; - if (x_handle_dnd_message (f, &event->xclient, dpyinfo, &inev.ie)) + + /* These values are always used initialized, but GCC doesn't + know that. */ + dx = 0; + dy = 0; + + rc = x_coords_from_dnd_message (dpyinfo, (XEvent *) event, + &dx, &dy); + + if (x_handle_dnd_message (f, &event->xclient, dpyinfo, &inev.ie, + rc, dx, dy)) *finish = X_EVENT_DROP; } 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)) +#if defined USE_X_TOOLKIT || defined USE_GTK + if (!x_window_to_frame (dpyinfo, event->xselection.requestor)) goto OTHER; -#endif /* not USE_X_TOOLKIT */ +#endif /* not USE_X_TOOLKIT and not USE_GTK */ x_handle_selection_notify (&event->xselection); 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)) +#if defined USE_X_TOOLKIT || defined USE_GTK + if (!x_window_to_frame (dpyinfo, event->xselectionclear.window)) goto OTHER; -#endif /* USE_X_TOOLKIT */ +#endif /* not USE_X_TOOLKIT and not USE_GTK */ { const XSelectionClearEvent *eventp = &event->xselectionclear; + if (eventp->selection == dpyinfo->motif_drag_atom + && (eventp->time == CurrentTime + || dpyinfo->motif_drag_atom_time <= eventp->time)) + dpyinfo->motif_drag_atom = None; + inev.sie.kind = SELECTION_CLEAR_EVENT; SELECTION_EVENT_DPYINFO (&inev.sie) = dpyinfo; SELECTION_EVENT_SELECTION (&inev.sie) = eventp->selection; SELECTION_EVENT_TIME (&inev.sie) = eventp->time; + + if (x_use_pending_selection_requests) + { + x_push_selection_request (&inev.sie); + EVENT_INIT (inev.ie); + } } 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 +16855,97 @@ 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 or another modal dialog/menu is in + progress, handle SelectionRequest events immediately, by + pushing it onto the selecction queue. */ + + if (x_use_pending_selection_requests) + { + x_push_selection_request (&inev.sie); + EVENT_INIT (inev.ie); + } + + if (x_dnd_waiting_for_finish + && x_dnd_waiting_for_motif_finish == 2 + && dpyinfo == x_dnd_waiting_for_motif_finish_display + && eventp->selection == x_dnd_motif_atom + && (eventp->target == dpyinfo->Xatom_XmTRANSFER_SUCCESS + || eventp->target == dpyinfo->Xatom_XmTRANSFER_FAILURE)) + { + x_dnd_waiting_for_finish = false; + + /* If the transfer failed, then return nil from + `x-begin-drag'. */ + if (eventp->target == dpyinfo->Xatom_XmTRANSFER_FAILURE) + x_dnd_action = None; + } } 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 +16988,127 @@ handle_one_xevent (struct x_display_info *dpyinfo, } } + if (f && FRAME_X_OUTPUT (f)->alpha_identical_p + && (event->xproperty.atom + == dpyinfo->Xatom_net_wm_window_opacity)) + { +#ifndef USE_XCB + int rc, actual_format; + Atom actual; + unsigned char *tmp_data; + unsigned long n, left, opacity; + + tmp_data = NULL; +#else + xcb_get_property_cookie_t opacity_cookie; + xcb_get_property_reply_t *opacity_reply; + xcb_generic_error_t *error; + bool rc; + uint32_t value; +#endif + + if (event->xproperty.state == PropertyDelete) + { + f->alpha[0] = 1.0; + f->alpha[1] = 1.0; + + store_frame_param (f, Qalpha, Qnil); + } + else + { +#ifndef USE_XCB + rc = XGetWindowProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f), + dpyinfo->Xatom_net_wm_window_opacity, + 0, 1, False, AnyPropertyType, &actual, + &actual_format, &n, &left, &tmp_data); + + if (rc == Success && actual_format == 32 + && (actual == XA_CARDINAL + /* Some broken programs set the opacity property + to those types, but window managers accept + them anyway. */ + || actual == XA_ATOM + || actual == XA_WINDOW) && n) + { + opacity = *(unsigned long *) tmp_data & OPAQUE; + f->alpha[0] = (double) opacity / (double) OPAQUE; + f->alpha[1] = (double) opacity / (double) OPAQUE; + + store_frame_param (f, Qalpha, make_float (f->alpha[0])); + } + else + { + f->alpha[0] = 1.0; + f->alpha[1] = 1.0; + + store_frame_param (f, Qalpha, Qnil); + } +#else + opacity_cookie + = xcb_get_property (dpyinfo->xcb_connection, 0, + (xcb_window_t) FRAME_OUTER_WINDOW (f), + (xcb_atom_t) dpyinfo->Xatom_net_wm_window_opacity, + XCB_ATOM_CARDINAL, 0, 1); + opacity_reply + = xcb_get_property_reply (dpyinfo->xcb_connection, + opacity_cookie, &error); + + if (!opacity_reply) + free (error), rc = false; + else + rc = (opacity_reply->format == 32 + && (opacity_reply->type == XCB_ATOM_CARDINAL + || opacity_reply->type == XCB_ATOM_ATOM + || opacity_reply->type == XCB_ATOM_WINDOW) + && (xcb_get_property_value_length (opacity_reply) >= 4)); + + if (rc) + { + value = *(uint32_t *) xcb_get_property_value (opacity_reply); + + f->alpha[0] = (double) value / (double) OPAQUE; + f->alpha[1] = (double) value / (double) OPAQUE; + store_frame_param (f, Qalpha, make_float (f->alpha[0])); + } + else + { + f->alpha[0] = 1.0; + f->alpha[1] = 1.0; + + store_frame_param (f, Qalpha, Qnil); + } + + if (opacity_reply) + free (opacity_reply); +#endif + } + +#ifndef USE_XCB + if (tmp_data) + XFree (tmp_data); +#endif + } + + 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 (true); + + if (x_dnd_compute_toplevels (dpyinfo)) + { + x_dnd_free_toplevels (true); + 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; @@ -8214,8 +17119,26 @@ handle_one_xevent (struct x_display_info *dpyinfo, { /* Maybe we shouldn't set this for child frames ?? */ f->output_data.x->parent_desc = event->xreparent.parent; + if (!FRAME_PARENT_FRAME (f)) - x_real_positions (f, &f->left_pos, &f->top_pos); + { + x_real_positions (f, &f->left_pos, &f->top_pos); + + /* Perhaps reparented due to a WM restart. Reset this. */ + FRAME_DISPLAY_INFO (f)->wm_type = X_WMTYPE_UNKNOWN; + FRAME_DISPLAY_INFO (f)->net_supported_window = 0; + +#ifndef USE_GTK + /* The window manager could have restarted and the new + window manager might not support user time windows, + so update what is used accordingly. + + Note that this doesn't handle changes between + non-reparenting window managers. */ + if (FRAME_X_OUTPUT (f)->has_been_visible) + x_update_frame_user_time_window (f); +#endif + } else { Window root; @@ -8228,16 +17151,24 @@ handle_one_xevent (struct x_display_info *dpyinfo, unblock_input (); } - /* Perhaps reparented due to a WM restart. Reset this. */ - FRAME_DISPLAY_INFO (f)->wm_type = X_WMTYPE_UNKNOWN; - FRAME_DISPLAY_INFO (f)->net_supported_window = 0; - x_set_frame_alpha (f); } goto OTHER; 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)) @@ -8255,8 +17186,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, SET_FRAME_ICONIFIED (f, false); } +#ifdef HAVE_XDBE if (FRAME_X_DOUBLE_BUFFERED_P (f)) - font_drop_xrender_surfaces (f); + x_drop_xrender_surfaces (f); +#endif f->output_data.x->has_been_visible = true; SET_FRAME_GARBAGED (f); unblock_input (); @@ -8281,6 +17214,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (!FRAME_GARBAGED_P (f)) { +#ifdef USE_X_TOOLKIT + if (f->output_data.x->edit_widget) + /* The widget's expose proc will be run in this + case. */ + goto OTHER; +#endif #ifdef USE_GTK /* This seems to be needed for GTK 2.6 and later, see https://debbugs.gnu.org/cgi/bugreport.cgi?bug=15398. */ @@ -8295,8 +17234,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, #endif } +#ifdef HAVE_XDBE if (!FRAME_GARBAGED_P (f)) show_back_buffer (f); +#endif } else { @@ -8344,8 +17285,20 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifdef USE_GTK x_clear_under_internal_border (f); #endif +#ifdef HAVE_XDBE show_back_buffer (f); +#endif } +#ifndef USE_TOOLKIT_SCROLL_BARS + struct scroll_bar *bar + = x_window_to_scroll_bar (dpyinfo->display, + /* Hopefully this is just a window, + not the back buffer. */ + event->xgraphicsexpose.drawable, 2); + + if (bar) + x_scroll_bar_expose (bar, event); +#endif #ifdef USE_X_TOOLKIT else goto OTHER; @@ -8355,9 +17308,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) { @@ -8371,6 +17341,34 @@ handle_one_xevent (struct x_display_info *dpyinfo, { bool visible = FRAME_VISIBLE_P (f); +#ifdef USE_LUCID + /* Bloodcurdling hack alert: The Lucid menu bar widget's + redisplay procedure is not called when a tip frame over + menu items is unmapped. Redisplay the menu manually... */ + if (FRAME_TOOLTIP_P (f) && popup_activated ()) + { + Widget w; + Lisp_Object tail, frame; + struct frame *f1; + + FOR_EACH_FRAME (tail, frame) + { + if (!FRAME_X_P (XFRAME (frame))) + continue; + + f1 = XFRAME (frame); + + if (FRAME_LIVE_P (f1)) + { + w = FRAME_X_OUTPUT (f1)->menubar_widget; + + if (w && !DoesSaveUnders (FRAME_DISPLAY_INFO (f1)->screen)) + xlwmenu_redisplay (w); + } + } + } +#endif /* USE_LUCID */ + /* While a frame is unmapped, display generation is disabled; you don't want to spend time updating a display that won't ever be seen. */ @@ -8398,6 +17396,29 @@ 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 + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) + 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 +17427,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 +17468,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 +17487,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 +17498,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto OTHER; case KeyPress: - - x_display_set_last_user_time (dpyinfo, event->xkey.time); + x_display_set_last_user_time (dpyinfo, event->xkey.time, + event->xkey.send_event); 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 +17558,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,20 +17612,41 @@ 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 (dpyinfo->xkb_desc) + { + XkbDescRec *rec = dpyinfo->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; - copy_bufptr = alloca (copy_bufsiz); + copy_bufptr = SAFE_ALLOCA (copy_bufsiz); nbytes = XmbLookupString (FRAME_XIC (f), &xkey, (char *) copy_bufptr, copy_bufsiz, &keysym, @@ -8598,13 +17665,56 @@ handle_one_xevent (struct x_display_info *dpyinfo, emacs_abort (); } else - nbytes = XLookupString (&xkey, (char *) copy_bufptr, - copy_bufsiz, &keysym, - &compose_status); -#else - nbytes = XLookupString (&xkey, (char *) copy_bufptr, - copy_bufsiz, &keysym, - &compose_status); +#endif + { +#ifdef HAVE_XKB + int overflow; + unsigned int consumed; + + if (dpyinfo->xkb_desc) + { + if (!XkbTranslateKeyCode (dpyinfo->xkb_desc, + xkey.keycode, xkey.state, + &consumed, &keysym)) + goto done_keysym; + + overflow = 0; + + nbytes = XkbTranslateKeySym (dpyinfo->display, &keysym, + xkey.state & ~consumed, + (char *) copy_bufptr, + copy_bufsiz, &overflow); + + if (overflow) + { + copy_bufptr = SAFE_ALLOCA ((copy_bufsiz += overflow) + * sizeof *copy_bufptr); + overflow = 0; + nbytes = XkbTranslateKeySym (dpyinfo->display, &keysym, + xkey.state & ~consumed, + (char *) copy_bufptr, + copy_bufsiz, &overflow); + + if (overflow) + nbytes = 0; + } + + if (nbytes) + coding = Qnil; + } + else +#endif + nbytes = XLookupString (&xkey, (char *) copy_bufptr, + copy_bufsiz, &keysym, + &compose_status); + } + +#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, @@ -8615,19 +17725,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 +17761,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 +17782,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 +17975,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 @@ -8829,23 +17985,56 @@ handle_one_xevent (struct x_display_info *dpyinfo, #endif case EnterNotify: - x_display_set_last_user_time (dpyinfo, event->xcrossing.time); - x_detect_focus_change (dpyinfo, any, event, &inev.ie); + x_display_set_last_user_time (dpyinfo, event->xcrossing.time, + event->xcrossing.send_event); + + 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; if (f && x_mouse_click_focus_ignore_position) - ignore_next_mouse_click_timeout = event->xmotion.time + 200; + { + ignore_next_mouse_click_timeout = (event->xmotion.time + + x_mouse_click_focus_ignore_time); + mouse_click_timeout_display = 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; @@ -8882,10 +18071,42 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto OTHER; case LeaveNotify: - x_display_set_last_user_time (dpyinfo, event->xcrossing.time); - x_detect_focus_change (dpyinfo, any, event, &inev.ie); + x_display_set_last_user_time (dpyinfo, event->xcrossing.time, + event->xcrossing.send_event); + +#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 && !defined USE_MOTIF + /* 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. (But don't ignore this on Motif, since we + want to clear the mouse face when a popup is active.) */ + if (dpyinfo->supports_xi2) + f = NULL; +#endif if (f) { if (f == hlinfo->mouse_face_mouse_frame) @@ -8900,13 +18121,20 @@ handle_one_xevent (struct x_display_info *dpyinfo, 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) + if (any_help_event_p + /* But never if `mouse-drag-and-drop-region' is in + progress, since that results in the tooltip being + dismissed when the mouse moves on top. */ + && !((EQ (track_mouse, Qdrag_source) + || EQ (track_mouse, Qdropping)) + && gui_mouse_grabbed (dpyinfo))) 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, &event->xmotion); + x_note_mouse_movement (dpyinfo->last_mouse_glyph_frame, + &event->xmotion, Qnil); #endif goto OTHER; @@ -8916,7 +18144,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 +18157,243 @@ handle_one_xevent (struct x_display_info *dpyinfo, f = mouse_or_wdesc_frame (dpyinfo, event->xmotion.window); + if (x_dnd_in_progress + /* Handle these events normally if the recursion + level is higher than when the drag-and-drop + operation was initiated. This is so that mouse + input works while we're in the debugger for, say, + `x-dnd-movement-function`. */ + && (command_loop_level + minibuf_level + <= x_dnd_recursion_depth) + && 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; + XRectangle *r; + bool was_frame; + + /* Always clear mouse face. */ + clear_mouse_face (hlinfo); + hlinfo->mouse_face_hidden = true; + + /* 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); + + r = &dpyinfo->last_mouse_glyph; + + /* Also remember the mouse glyph and set + mouse_moved. */ + if (f != dpyinfo->last_mouse_glyph_frame + || event->xmotion.x < r->x + || event->xmotion.x >= r->x + r->width + || event->xmotion.y < r->y + || event->xmotion.y >= r->y + r->height) + { + f->mouse_moved = true; + f->last_mouse_device = Qnil; + dpyinfo->last_mouse_scroll_bar = NULL; + + remember_mouse_glyph (f, event->xmotion.x, + event->xmotion.y, r); + dpyinfo->last_mouse_glyph_frame = f; + } + } + + if (event->xmotion.same_screen) + target = x_dnd_get_target_window (dpyinfo, + event->xmotion.x_root, + event->xmotion.y_root, + &target_proto, + &motif_style, &toplevel, + &was_frame); + else + target = x_dnd_fill_empty_target (&target_proto, &motif_style, + &toplevel, &was_frame); + + 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_disable_motif_drag + && 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_disable_motif_drag + && 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, x_dnd_motif_operations, + 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; + x_dnd_last_window_is_frame = was_frame; + + 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) + && !x_dnd_disable_motif_drag) + { + 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 = x_dnd_motif_atom; + + 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_window_is_frame && target != None) + x_dnd_note_self_position (dpyinfo, target, + event->xbutton.x_root, + event->xbutton.y_root); + else 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 + && !x_dnd_disable_motif_drag) + { + 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, x_dnd_motif_operations, + (!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); + } + + x_dnd_update_tooltip_position (event->xmotion.x_root, + event->xmotion.y_root); + + 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 +18413,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 +18446,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 @@ -9011,6 +18483,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, So if this ConfigureNotify is immediately followed by another for the same window, use the info from the latest update, and consider the events all handled. */ + /* Opaque resize may be trickier; ConfigureNotify events are mixed with Expose events for multiple windows. */ configureEvent = *event; @@ -9032,15 +18505,142 @@ handle_one_xevent (struct x_display_info *dpyinfo, configureEvent = next_event; } + /* If we get a ConfigureNotify for the root window, this means + the dimensions of the screen it's on changed. */ + + if (configureEvent.xconfigure.window == dpyinfo->root_window) + { +#ifdef HAVE_XRANDR + /* This function is OK to call even if the X server doesn't + support RandR. */ + XRRUpdateConfiguration (&configureEvent); +#elif !defined USE_GTK + /* Catch screen size changes even if RandR is not available + on the client. GTK does this internally. */ + + if (configureEvent.xconfigure.width != dpyinfo->screen_width + || configureEvent.xconfigure.height != dpyinfo->screen_height) + { + inev.ie.kind = MONITORS_CHANGED_EVENT; + XSETTERMINAL (inev.ie.arg, dpyinfo->terminal); + + /* Store this event now since inev.ie.type could be set to + MOVE_FRAME_EVENT later. */ + kbd_buffer_store_event (&inev.ie); + inev.ie.kind = NO_EVENT; + } +#endif + + dpyinfo->screen_width = configureEvent.xconfigure.width; + dpyinfo->screen_height = configureEvent.xconfigure.height; + } + + 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 (); +#ifdef HAVE_XDBE if (f && FRAME_X_DOUBLE_BUFFERED_P (f)) - font_drop_xrender_surfaces (f); + x_drop_xrender_surfaces (f); +#endif unblock_input (); #if defined USE_CAIRO && !defined USE_GTK if (f) @@ -9050,6 +18650,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 +18672,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 +18680,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 @@ -9093,15 +18696,14 @@ handle_one_xevent (struct x_display_info *dpyinfo, #endif x_net_wm_state (f, configureEvent.xconfigure.window); -#ifdef USE_X_TOOLKIT +#if defined USE_X_TOOLKIT || defined USE_GTK /* Tip frames are pure X window, set size for them. */ if (FRAME_TOOLTIP_P (f)) { if (FRAME_PIXEL_HEIGHT (f) != configureEvent.xconfigure.height || FRAME_PIXEL_WIDTH (f) != configureEvent.xconfigure.width) - { - SET_FRAME_GARBAGED (f); - } + SET_FRAME_GARBAGED (f); + FRAME_PIXEL_HEIGHT (f) = configureEvent.xconfigure.height; FRAME_PIXEL_WIDTH (f) = configureEvent.xconfigure.width; } @@ -9125,6 +18727,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 +18779,231 @@ 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 + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) + 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, + event->xbutton.send_event); + +#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 + /* Handle these events normally if the recursion + level is higher than when the drag-and-drop + operation was initiated. This is so that mouse + input works while we're in the debugger for, say, + `x-dnd-movement-function`. */ + && (command_loop_level + minibuf_level + <= x_dnd_recursion_depth) + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) + { + f = mouse_or_wdesc_frame (dpyinfo, event->xbutton.window); + + if (event->type == ButtonPress) + { + x_display_set_last_user_time (dpyinfo, event->xbutton.time, + event->xbutton.send_event); + + dpyinfo->grabbed |= (1 << event->xbutton.button); + 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 << event->xbutton.button); + + 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; + } + + if (event->xbutton.type == ButtonRelease) + { + for (int i = 1; i < 8; ++i) + { + if (i != event->xbutton.button + && event->xbutton.state & (Button1Mask << (i - 1))) + dnd_grab = true; + } + + if (!dnd_grab) + { + x_dnd_end_window = x_dnd_last_seen_window; + x_dnd_in_progress = false; + + if (x_dnd_update_tooltip + && FRAMEP (tip_frame) + && FRAME_LIVE_P (XFRAME (tip_frame)) + && (FRAME_X_DISPLAY (XFRAME (tip_frame)) + == FRAME_X_DISPLAY (x_dnd_frame))) + Fx_hide_tip (); + + x_dnd_finish_frame = x_dnd_frame; + + if (x_dnd_last_seen_window != None + && x_dnd_last_window_is_frame) + { + x_dnd_waiting_for_finish = false; + x_dnd_note_self_drop (dpyinfo, + x_dnd_last_seen_window, + event->xbutton.x_root, + event->xbutton.y_root, + event->xbutton.time); + } + else 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_do_drop (x_dnd_last_seen_window, + x_dnd_last_protocol_version); + x_dnd_finish_display = dpyinfo->display; + } + 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) + && !x_dnd_disable_motif_protocol + && 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, x_dnd_motif_operations, + (!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 = x_dnd_motif_atom; + 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_display = dpyinfo; + x_dnd_waiting_for_motif_finish = 1; + x_dnd_finish_display = dpyinfo->display; + } + } + else + 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_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_last_window_is_frame = false; + x_dnd_frame = NULL; + } + } + + goto OTHER; + } + + if (x_dnd_in_progress + && (command_loop_level + minibuf_level + <= x_dnd_recursion_depth)) + 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 +19028,37 @@ 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 < 8 + && f) + { + if (ignore_next_mouse_click_timeout + && dpyinfo == mouse_click_timeout_display) + { + 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 +19090,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 @@ -9267,7 +19106,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (! popup_activated ()) #endif { - if (ignore_next_mouse_click_timeout) + if (ignore_next_mouse_click_timeout + && dpyinfo == mouse_click_timeout_display) { if (event->type == ButtonPress && event->xbutton.time > ignore_next_mouse_click_timeout) @@ -9299,12 +19139,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, scroll bars. */ if (bar && event->xbutton.state & ControlMask) { - x_scroll_bar_handle_click (bar, event, &inev.ie); + x_scroll_bar_handle_click (bar, event, &inev.ie, Qnil); *finish = X_EVENT_DROP; } #else /* not USE_TOOLKIT_SCROLL_BARS */ if (bar) - x_scroll_bar_handle_click (bar, event, &inev.ie); + x_scroll_bar_handle_click (bar, event, &inev.ie, Qnil); #endif /* not USE_TOOLKIT_SCROLL_BARS */ } @@ -9330,11 +19170,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 +19188,25 @@ 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 + Widget widget; + + widget = XtWindowToWidget (dpyinfo->display, + event->xbutton.window); + + if (widget && XmIsCascadeButton (widget) + && XtIsSensitive (widget)) + { +#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 +19215,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, break; case CirculateNotify: + if (x_dnd_in_progress + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) + x_dnd_update_state (dpyinfo, dpyinfo->last_user_time); goto OTHER; case CirculateRequest: @@ -9390,17 +19245,2996 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto OTHER; case DestroyNotify: + if (event->xdestroywindow.window + == dpyinfo->net_supported_window) + dpyinfo->net_supported_window = None; + 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; + ev.send_event = enter->send_event; + + x_display_set_last_user_time (dpyinfo, enter->time, + enter->send_event); + +#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 = (enter->time + + x_mouse_click_focus_ignore_time); + mouse_click_timeout_display = 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, &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; + ev.send_event = leave->send_event; +#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 + || leave->mode == XINotifyUngrab)) + 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, leave->time, + leave->send_event); + +#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); + + /* Also do this again here, since the test for `any' + above may not have found a frame, as that usually + just looks up a top window on Xt builds. */ + +#ifdef HAVE_XINPUT2_1 + if (leave->detail != XINotifyInferior && f) + xi_reset_scroll_valuators_for_device_id (dpyinfo, + leave->deviceid, false); +#endif + + 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 + /* But never if `mouse-drag-and-drop-region' is + in progress, since that results in the + tooltip being dismissed when the mouse moves + on top. */ + && !((EQ (track_mouse, Qdrag_source) + || EQ (track_mouse, Qdropping)) + && gui_mouse_grabbed (dpyinfo))) + 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; + bool other_valuators_found = 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; + unsigned 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; + struct scroll_bar *bar; + + bar = NULL; + + /* 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 (!val) + { + other_valuators_found = true; + continue; + } + + 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 + bar = x_window_to_scroll_bar (dpyinfo->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) + { + if (!bar) + bar = x_window_to_scroll_bar (dpyinfo->display, xev->event, 2); + + /* If this is a scroll bar, compute the + actual position directly to avoid an + extra roundtrip. */ + + if (bar) + { + real_x = lrint (xev->event_x + bar->left); + real_y = lrint (xev->event_y + bar->top); + } + else + 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) + { + unsigned int state; + + state = xi_convert_event_state (xev); + x_display_set_last_user_time (dpyinfo, xev->time, + xev->send_event); + + 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, + xev->send_event); + + +#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 XI_OTHER; +#endif + + /* If this happened during a drag-and-drop + operation, don't send an event. We only have + to set the user time. */ + if (x_dnd_in_progress + && (command_loop_level + minibuf_level + <= x_dnd_recursion_depth) + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) + goto XI_OTHER; + + 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 && !NILP (source->name)) + inev.ie.device = source->name; + + if (!other_valuators_found) + 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; + ev.send_event = xev->send_event; + +#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 = xi_convert_event_state (xev); + + 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 + /* Handle these events normally if the recursion + level is higher than when the drag-and-drop + operation was initiated. This is so that mouse + input works while we're in the debugger for, say, + `x-dnd-movement-function`. */ + && (command_loop_level + minibuf_level + <= x_dnd_recursion_depth) + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) + { + Window target, toplevel; + int target_proto, motif_style; + XRectangle *r; + bool was_frame; + + /* Always clear mouse face. */ + clear_mouse_face (hlinfo); + hlinfo->mouse_face_hidden = true; + + /* 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); + + r = &dpyinfo->last_mouse_glyph; + + /* Also remember the mouse glyph and set + mouse_moved. */ + if (f != dpyinfo->last_mouse_glyph_frame + || xev->event_x < r->x + || xev->event_x >= r->x + r->width + || xev->event_y < r->y + || xev->event_y >= r->y + r->height) + { + f->mouse_moved = true; + f->last_mouse_device = (source ? source->name + : Qnil); + dpyinfo->last_mouse_scroll_bar = NULL; + + remember_mouse_glyph (f, xev->event_x, + xev->event_y, r); + dpyinfo->last_mouse_glyph_frame = f; + } + } + + if (xev->root == dpyinfo->root_window) + target = x_dnd_get_target_window (dpyinfo, + xev->root_x, + xev->root_y, + &target_proto, + &motif_style, + &toplevel, + &was_frame); + else + target = x_dnd_fill_empty_target (&target_proto, + &motif_style, + &toplevel, + &was_frame); + + 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_disable_motif_drag + && 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 = xev->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_disable_motif_drag + && 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, x_dnd_motif_operations, + 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; + x_dnd_last_window_is_frame = was_frame; + + 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) + && !x_dnd_disable_motif_drag) + { + 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 = x_dnd_motif_atom; + + 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_window_is_frame && target != None) + x_dnd_note_self_position (dpyinfo, target, + xev->root_x, xev->root_y); + else if (x_dnd_last_protocol_version != -1 && target != None) + { + dnd_state = xi_convert_event_state (xev); + + 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 + && !x_dnd_disable_motif_drag) + { + 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, x_dnd_motif_operations, + (!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); + } + + x_dnd_update_tooltip_position (xev->root_x, xev->root_y); + + 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 (dpyinfo->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 + && (command_loop_level + minibuf_level + <= x_dnd_recursion_depth) + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) + { + f = mouse_or_wdesc_frame (dpyinfo, xev->event); + device = xi_device_from_id (dpyinfo, xev->deviceid); + + /* Don't track grab status for emulated pointer + events, because they are ignored by the regular + mouse click processing code. */ +#ifdef XIPointerEmulated + if (!(xev->flags & XIPointerEmulated)) + { +#endif + if (xev->evtype == XI_ButtonPress) + { + x_display_set_last_user_time (dpyinfo, xev->time, + xev->send_event); + + dpyinfo->grabbed |= (1 << xev->detail); + dpyinfo->last_mouse_frame = f; + + if (device) + device->grab |= (1 << xev->detail); + + 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); + } +#ifdef XIPointerEmulated + } +#endif + + if (xev->evtype == XI_ButtonPress + && x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) + { + dnd_state = xi_convert_event_state (xev); + + 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; + } + + if (xev->evtype == XI_ButtonRelease) + { + 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) + { + x_dnd_end_window = x_dnd_last_seen_window; + x_dnd_in_progress = false; + + /* If a tooltip that we're following is + displayed, hide it now. */ + + if (x_dnd_update_tooltip + && FRAMEP (tip_frame) + && FRAME_LIVE_P (XFRAME (tip_frame)) + && (FRAME_X_DISPLAY (XFRAME (tip_frame)) + == FRAME_X_DISPLAY (x_dnd_frame))) + Fx_hide_tip (); + + /* This doesn't have to be marked since it + is only accessed if + x_dnd_waiting_for_finish is true, which + is only possible inside the DND event + loop where that frame is on the + stack. */ + x_dnd_finish_frame = x_dnd_frame; + + if (x_dnd_last_seen_window != None + && x_dnd_last_window_is_frame) + { + x_dnd_waiting_for_finish = false; + x_dnd_note_self_drop (dpyinfo, x_dnd_last_seen_window, + xev->root_x, xev->root_y, xev->time); + } + else 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_do_drop (x_dnd_last_seen_window, + x_dnd_last_protocol_version); + x_dnd_finish_display = dpyinfo->display; + } + 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) + && !x_dnd_disable_motif_protocol + && 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, x_dnd_motif_operations, + (!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 = x_dnd_motif_atom; + 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_display = dpyinfo; + x_dnd_waiting_for_motif_finish = 1; + x_dnd_finish_display = dpyinfo->display; + } + } + else + 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_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_last_window_is_frame = false; + x_dnd_frame = NULL; + + goto XI_OTHER; + } + } + } + + if (x_dnd_in_progress + && (command_loop_level + minibuf_level + <= x_dnd_recursion_depth)) + 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 = xi_convert_event_state (xev); + copy.xbutton.button = xev->detail; + copy.xbutton.same_screen = True; + +#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 = xi_convert_event_state (xev); + copy->button.button = xev->detail; + + if (!copy->button.window) + emacs_abort (); + + g_object_ref (copy->button.window); + + if (popup_activated ()) + { + /* GTK+ popup menus don't respond to core buttons + after Button3, so don't dismiss popup menus upon + wheel movement here either. */ + if (xev->detail > 3) + *finish = X_EVENT_DROP; + + if (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, + xev->send_event); + + 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, xi_convert_event_state (xev), + 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 = xi_convert_event_state (xev); + 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 < 8 && 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, + source ? source->name : Qnil); +#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, + source ? source->name : Qnil); + *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 ()) + { +#ifdef USE_LUCID + /* This makes key navigation work inside menus. */ + use_copy = true; + 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.state = ((xev->mods.effective & ~(1 << 13 | 1 << 14)) + | (xev->group.effective << 13)); + xi_convert_button_state (&xev->buttons, ©.xkey.state); + + 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.keycode = xev->detail; + copy.xkey.same_screen = True; +#endif + goto XI_OTHER; + } +#endif + + x_display_set_last_user_time (dpyinfo, xev->time, + xev->send_event); + 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. */ + xi_convert_button_state (&xev->buttons, &xkey.state); + + 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 (dpyinfo->xkb_desc) + { + XkbDescRec *rec = dpyinfo->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.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 = SAFE_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 = SAFE_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; + } + } + + inev.ie.modifiers = x_x_to_emacs_modifiers (dpyinfo, 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 || defined USE_LUCID + { + 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. */ + xi_convert_button_state (&xev->buttons, &xkey.state); + + xkey.keycode = xev->detail; + xkey.same_screen = True; + +#ifdef USE_LUCID + if (!popup_activated ()) + { +#endif +#ifdef HAVE_X_I18N + if (x_filter_event (dpyinfo, (XEvent *) &xkey)) + *finish = X_EVENT_DROP; +#elif defined USE_GTK + f = x_any_window_to_frame (xkey->event); + + if (f && xg_filter_key (f, event)) + *finish = X_EVENT_DROP; +#endif +#ifdef USE_LUCID + } + else + { + /* FIXME: the Lucid menu bar pops down upon any key + release event, so we don't dispatch these events + at all, which doesn't seem to be the right + solution. + + use_copy = true; + copy.xkey = xkey; */ + } +#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 = SAFE_ALLOCA (sizeof *disabled * hev->num_info); + n_disabled = 0; + + for (i = 0; i < hev->num_info; ++i) + { + if (hev->info[i].flags & XIDeviceEnabled) + { + /* Handle all disabled devices now, to prevent + things happening out-of-order later. */ + 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; + + n_disabled = 0; + } + + 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 break_detachment; + } + } + + devices[ndevices++] = dpyinfo->devices[i]; + + break_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, + xev->send_event); + + 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; + + x_catch_errors (dpyinfo->display); + + 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; + } + + x_uncatch_errors (); + } +#ifndef HAVE_GTK3 + else if (x_input_grab_touch_events) + { + x_ignore_errors_for_next_request (dpyinfo); + XIAllowTouchEvents (dpyinfo->display, xev->deviceid, + xev->detail, xev->event, XIRejectTouch); + x_stop_ignoring_errors (dpyinfo); + } +#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, + xev->send_event); + + 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, + xev->send_event); + + 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, pev->time, + pev->send_event); + + 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_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)) + { +#ifndef USE_GTK + XEvent xevent; +#endif + 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 + + /* Somehow this really interferes with GTK's own processing + of ShapeNotify events. Not sure what GTK uses them for, + but we cannot skip any of them here. */ +#ifndef USE_GTK + 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; + } + } +#endif + + 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 + bounding 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 +#if defined HAVE_XRANDR && !defined USE_GTK + if (dpyinfo->xrandr_supported_p + && (event->type == (dpyinfo->xrandr_event_base + + RRScreenChangeNotify) + || event->type == (dpyinfo->xrandr_event_base + + RRNotify))) + { + union buffered_input_event *ev; + Time timestamp; + Lisp_Object current_monitors; + XRRScreenChangeNotifyEvent *notify; + + if (event->type == (dpyinfo->xrandr_event_base + + RRScreenChangeNotify)) + XRRUpdateConfiguration ((XEvent *) event); + + if (event->type == (dpyinfo->xrandr_event_base + + RRScreenChangeNotify)) + { + notify = ((XRRScreenChangeNotifyEvent *) event); + timestamp = notify->timestamp; + + /* Don't set screen dimensions if the notification is + for a different screen. */ + if (notify->root == dpyinfo->root_window) + { + dpyinfo->screen_width = notify->width; + dpyinfo->screen_height = notify->height; + dpyinfo->screen_mm_width = notify->mwidth; + dpyinfo->screen_mm_height = notify->mheight; + } + } + else + timestamp = 0; + + ev = (kbd_store_ptr == kbd_buffer + ? kbd_buffer + KBD_BUFFER_SIZE - 1 + : kbd_store_ptr - 1); + + if (kbd_store_ptr != kbd_fetch_ptr + && ev->ie.kind == MONITORS_CHANGED_EVENT + && XTERMINAL (ev->ie.arg) == dpyinfo->terminal) + /* Don't store a MONITORS_CHANGED_EVENT if there is + already an undelivered event on the queue. */ + goto OTHER; + + inev.ie.kind = MONITORS_CHANGED_EVENT; + inev.ie.timestamp = timestamp; + XSETTERMINAL (inev.ie.arg, dpyinfo->terminal); + + /* Also don't do anything if the monitor configuration + didn't really change. */ + + current_monitors + = Fx_display_monitor_attributes_list (inev.ie.arg); + + if (!NILP (Fequal (current_monitors, + dpyinfo->last_monitor_attributes_list))) + inev.ie.kind = NO_EVENT; + + dpyinfo->last_monitor_attributes_list = current_monitors; + + if (x_dnd_in_progress && x_dnd_update_tooltip) + x_dnd_monitors = current_monitors; + + if (inev.ie.kind != NO_EVENT) + x_dnd_update_tooltip_now (); + } +#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_X_TOOLKIT && 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 +22245,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 +22275,33 @@ 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 (); + /* Sometimes event processing draws to either F or ANY outside + redisplay. To ensure that these changes become visible, draw + them here. */ + +#ifdef HAVE_XDBE + if (f) + flush_dirty_back_buffer_on (f); + + if (any && any != f) + flush_dirty_back_buffer_on (any); +#endif + SAFE_FREE (); 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 +22314,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 +22330,25 @@ 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. + + When x_dnd_unwind_flag is true, the above doesn't apply, since + the surrounding code takes special precautions to keep it safe. + + That doesn't matter for events from displays other than the + display of the drag-and-drop operation, though. */ + if (!x_dnd_unwind_flag + && ((x_dnd_in_progress + && dpyinfo->display == FRAME_X_DISPLAY (x_dnd_frame)) + || (x_dnd_waiting_for_finish + && dpyinfo->display == x_dnd_finish_display))) + return 0; + + x_clean_failable_requests (dpyinfo); + block_input (); /* For debugging, this gives a way to fake an I/O error. */ @@ -9498,8 +22368,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 +22414,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 @@ -9707,6 +22602,9 @@ x_draw_bar_cursor (struct window *w, struct glyph_row *row, int width, enum text else xgcv.background = xgcv.foreground = f->output_data.x->cursor_pixel; xgcv.graphics_exposures = False; + xgcv.line_width = 1; + + mask |= GCLineWidth; if (gc) XChangeGC (dpy, gc, mask, &xgcv); @@ -9734,8 +22632,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 +22654,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 +22690,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 +22738,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 +22791,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. */ @@ -9956,70 +22863,137 @@ x_text_icon (struct frame *f, const char *icon_name) return false; } -#define X_ERROR_MESSAGE_SIZE 200 - -/* If non-nil, this should be a string. - It means catch X errors and store the error message in this string. - The reason we use a stack is that x_catch_error/x_uncatch_error can - be called from a signal handler. -*/ +struct x_error_message_stack +{ + /* Pointer to the error message of any error that was generated, or + NULL. */ + char *string; -struct x_error_message_stack { - char string[X_ERROR_MESSAGE_SIZE]; + /* The display this error handler applies to. */ Display *dpy; + + /* A function to call upon an error if non-NULL. */ x_special_error_handler handler; + + /* Some data to pass to that handler function. */ void *handler_data; + + /* The previous handler in this stack. */ struct x_error_message_stack *prev; + + /* The first request that this error handler applies to. Keeping + track of this allows us to avoid an XSync yet still have errors + for previously made requests be handled correctly. */ + unsigned long first_request; }; + +/* Stack of X error message handlers. Whenever an error is generated + on a display, look in this stack for an appropriate error handler, + set its `string' to the error message and call its `handler' with + `handler_data'. If no handler applies to the error, don't catch + it, and let it crash Emacs instead. + + This used to be a pointer to a string in which any error would be + placed before 2006. */ static struct x_error_message_stack *x_error_message; -/* An X error handler which stores the error message in - *x_error_message. This is called from x_error_handler if - x_catch_errors is in effect. */ +/* The amount of items (depth) in that stack. */ +int x_error_message_count; + +static struct x_error_message_stack * +x_find_error_handler (Display *dpy, XErrorEvent *event) +{ + struct x_error_message_stack *stack; + + stack = x_error_message; + + while (stack) + { + if (X_COMPARE_SERIALS (event->serial, >=, + stack->first_request) + && dpy == stack->dpy) + return stack; + + stack = stack->prev; + } + + return NULL; +} + +void +x_unwind_errors_to (int depth) +{ + while (x_error_message_count > depth) + /* This is safe to call because we check whether or not + x_error_message->dpy is still alive before calling XSync. */ + x_uncatch_errors (); +} + +#define X_ERROR_MESSAGE_SIZE 200 + +/* An X error handler which stores the error message in the first + applicable handler in the x_error_message stack. This is called + from *x_error_handler if an x_catch_errors for DISPLAY is in + effect. */ static void -x_error_catcher (Display *display, XErrorEvent *event) +x_error_catcher (Display *display, XErrorEvent *event, + struct x_error_message_stack *stack) { + char buf[X_ERROR_MESSAGE_SIZE]; + XGetErrorText (display, event->error_code, - x_error_message->string, - X_ERROR_MESSAGE_SIZE); - if (x_error_message->handler) - x_error_message->handler (display, event, x_error_message->string, - x_error_message->handler_data); + buf, X_ERROR_MESSAGE_SIZE); + + if (stack->string) + xfree (stack->string); + + stack->string = xstrdup (buf); + + if (stack->handler) + stack->handler (display, event, stack->string, + stack->handler_data); } -/* Begin trapping X errors for display DPY. Actually we trap X errors - for all displays, but DPY should be the display you are actually - operating on. +/* Begin trapping X errors for display DPY. - After calling this function, X protocol errors no longer cause - Emacs to exit; instead, they are recorded in the string - stored in *x_error_message. + After calling this function, X protocol errors generated on DPY no + longer cause Emacs to exit; instead, they are recorded in an error + handler pushed onto the stack `x_error_message'. Calling x_check_errors signals an Emacs error if an X error has occurred since the last call to x_catch_errors or x_check_errors. - Calling x_uncatch_errors resumes the normal error handling. - Calling x_uncatch_errors_after_check is similar, but skips an XSync - to the server, and should be used only immediately after - x_had_errors_p or x_check_errors. */ + Calling x_uncatch_errors resumes the normal error handling, + skipping an XSync if the last request made is known to have been + processed. Calling x_uncatch_errors_after_check is similar, but + always skips an XSync to the server, and should be used only + immediately after x_had_errors_p or x_check_errors, or when it is + known that no requests have been made since the last x_catch_errors + call for DPY. + + There is no need to use this mechanism for ignoring errors from + single asynchronous requests, such as sending a ClientMessage to a + window that might no longer exist. Use + x_ignore_errors_for_next_request (paired with + x_stop_ignoring_errors) instead. */ void x_catch_errors_with_handler (Display *dpy, x_special_error_handler handler, void *handler_data) { - struct x_error_message_stack *data = xmalloc (sizeof *data); - - /* Make sure any errors from previous requests have been dealt with. */ - XSync (dpy, False); + struct x_error_message_stack *data; + data = xzalloc (sizeof *data); data->dpy = dpy; - data->string[0] = 0; data->handler = handler; data->handler_data = handler_data; data->prev = x_error_message; + data->first_request = XNextRequest (dpy); x_error_message = data; + + ++x_error_message_count; } void @@ -10028,6 +23002,135 @@ x_catch_errors (Display *dpy) x_catch_errors_with_handler (dpy, NULL, NULL); } +/* Return if errors for REQUEST should be ignored even if there is no + error handler applied. */ +static struct x_failable_request * +x_request_can_fail (struct x_display_info *dpyinfo, + unsigned long request) +{ + struct x_failable_request *failable_requests; + + for (failable_requests = dpyinfo->failable_requests; + failable_requests < dpyinfo->next_failable_request; + failable_requests++) + { + if (X_COMPARE_SERIALS (request, >=, + failable_requests->start) + && (!failable_requests->end + || X_COMPARE_SERIALS (request, <=, + failable_requests->end))) + return failable_requests; + } + + return NULL; +} + +/* Remove outdated request serials from + dpyinfo->failable_requests. */ +static void +x_clean_failable_requests (struct x_display_info *dpyinfo) +{ + struct x_failable_request *first, *last; + + last = dpyinfo->next_failable_request; + + for (first = dpyinfo->failable_requests; first < last; first++) + { + if (X_COMPARE_SERIALS (first->start, >, + LastKnownRequestProcessed (dpyinfo->display)) + || !first->end + || X_COMPARE_SERIALS (first->end, >, + LastKnownRequestProcessed (dpyinfo->display))) + break; + } + + if (first != last) + memmove (&dpyinfo->failable_requests, first, + sizeof *first * (last - first)); + + dpyinfo->next_failable_request = (dpyinfo->failable_requests + + (last - first)); +} + +void +x_ignore_errors_for_next_request (struct x_display_info *dpyinfo) +{ + struct x_failable_request *request, *max; + unsigned long next_request; +#ifdef HAVE_GTK3 + GdkDisplay *gdpy; + + /* GTK 3 tends to override our own error handler inside certain + callbacks, which this can be called from. Instead of trying to + restore our own, add a trap for the following requests with + GDK as well. */ + + gdpy = gdk_x11_lookup_xdisplay (dpyinfo->display); + + if (gdpy) + gdk_x11_display_error_trap_push (gdpy); +#endif + + if ((dpyinfo->next_failable_request + != dpyinfo->failable_requests) + && (dpyinfo->next_failable_request - 1)->end == 0) + /* A new sequence should never be started before an old one + finishes. Use `x_catch_errors' to nest error handlers. */ + emacs_abort (); + + request = dpyinfo->next_failable_request; + max = dpyinfo->failable_requests + N_FAILABLE_REQUESTS; + next_request = XNextRequest (dpyinfo->display); + + if (request >= max) + { + /* There is no point in making this extra sync if all requests + are known to have been fully processed. */ + if ((LastKnownRequestProcessed (dpyinfo->display) + != next_request - 1)) + XSync (dpyinfo->display, False); + + x_clean_failable_requests (dpyinfo); + request = dpyinfo->next_failable_request; + } + + if (request >= max) + /* A request should always be made immediately after calling this + function. */ + emacs_abort (); + + request->start = next_request; + request->end = 0; + + dpyinfo->next_failable_request++; +} + +void +x_stop_ignoring_errors (struct x_display_info *dpyinfo) +{ + struct x_failable_request *range; +#ifdef HAVE_GTK3 + GdkDisplay *gdpy; +#endif + + range = dpyinfo->next_failable_request - 1; + range->end = XNextRequest (dpyinfo->display) - 1; + + /* Abort if no request was made since + `x_ignore_errors_for_next_request'. */ + + if (X_COMPARE_SERIALS (range->end, <, + range->start)) + emacs_abort (); + +#ifdef HAVE_GTK3 + gdpy = gdk_x11_lookup_xdisplay (dpyinfo->display); + + if (gdpy) + gdk_x11_display_error_trap_pop_ignored (gdpy); +#endif +} + /* Undo the last x_catch_errors call. DPY should be the display that was passed to x_catch_errors. @@ -10043,17 +23146,20 @@ x_uncatch_errors_after_check (void) block_input (); tmp = x_error_message; x_error_message = x_error_message->prev; + --x_error_message_count; + if (tmp->string) + xfree (tmp->string); xfree (tmp); unblock_input (); } -/* Undo the last x_catch_errors call. - DPY should be the display that was passed to x_catch_errors. */ +/* Undo the last x_catch_errors call. */ void x_uncatch_errors (void) { struct x_error_message_stack *tmp; + struct x_display_info *dpyinfo; /* In rare situations when running Emacs run in daemon mode, shutting down an emacsclient via delete-frame can cause @@ -10064,13 +23170,29 @@ x_uncatch_errors (void) block_input (); + dpyinfo = x_display_info_for_display (x_error_message->dpy); + /* The display may have been closed before this function is called. Check if it is still open before calling XSync. */ - if (x_display_info_for_display (x_error_message->dpy) != 0) - XSync (x_error_message->dpy, False); + if (dpyinfo != 0 + /* There is no point in making this extra sync if all requests + are known to have been fully processed. */ + && (LastKnownRequestProcessed (x_error_message->dpy) + != XNextRequest (x_error_message->dpy) - 1) + /* Likewise if no request was made since the trap was + installed. */ + && (NextRequest (x_error_message->dpy) + > x_error_message->first_request)) + { + XSync (x_error_message->dpy, False); + x_clean_failable_requests (dpyinfo); + } tmp = x_error_message; x_error_message = x_error_message->prev; + --x_error_message_count; + if (tmp->string) + xfree (tmp->string); xfree (tmp); unblock_input (); } @@ -10082,36 +23204,79 @@ x_uncatch_errors (void) void x_check_errors (Display *dpy, const char *format) { - /* Make sure to catch any errors incurred so far. */ - XSync (dpy, False); + struct x_display_info *dpyinfo; + char *string; + + /* This shouldn't happen, since x_check_errors should be called + immediately inside an x_catch_errors block. */ + if (dpy != x_error_message->dpy) + emacs_abort (); + + /* There is no point in making this extra sync if all requests + are known to have been fully processed. */ + if ((LastKnownRequestProcessed (dpy) + != XNextRequest (dpy) - 1) + && (NextRequest (dpy) + > x_error_message->first_request)) + XSync (dpy, False); + + dpyinfo = x_display_info_for_display (dpy); - if (x_error_message->string[0]) + /* Clean the array of failable requests, since a sync happened. */ + if (dpyinfo) + x_clean_failable_requests (dpyinfo); + + if (x_error_message->string) { - char string[X_ERROR_MESSAGE_SIZE]; - memcpy (string, x_error_message->string, X_ERROR_MESSAGE_SIZE); - x_uncatch_errors (); + string = alloca (strlen (x_error_message->string) + 1); + strcpy (string, x_error_message->string); + error (format, string); } } -/* Nonzero if we had any X protocol errors - since we did x_catch_errors on DPY. */ +/* Nonzero if any X protocol errors were generated since the last call + to x_catch_errors on DPY. */ bool x_had_errors_p (Display *dpy) { + struct x_display_info *dpyinfo; + + /* This shouldn't happen, since x_check_errors should be called + immediately inside an x_catch_errors block. */ + if (dpy != x_error_message->dpy) + emacs_abort (); + /* Make sure to catch any errors incurred so far. */ - XSync (dpy, False); + if ((LastKnownRequestProcessed (dpy) + != XNextRequest (dpy) - 1) + && (NextRequest (dpy) + > x_error_message->first_request)) + XSync (dpy, False); + + dpyinfo = x_display_info_for_display (dpy); + + /* Clean the array of failable requests, since a sync happened. */ + if (dpyinfo) + x_clean_failable_requests (dpyinfo); - return x_error_message->string[0] != 0; + return !!x_error_message->string; } -/* Forget about any errors we have had, since we did x_catch_errors on DPY. */ +/* Forget about any errors we have had, since we did x_catch_errors on + DPY. */ void x_clear_errors (Display *dpy) { - x_error_message->string[0] = 0; + /* This shouldn't happen, since x_check_errors should be called + immediately inside an x_catch_errors block. */ + if (dpy != x_error_message->dpy) + emacs_abort (); + + xfree (x_error_message->string); + x_error_message->string = NULL; } #if false @@ -10129,9 +23294,12 @@ x_fully_uncatch_errors (void) #if false static unsigned int x_wire_count; -x_trace_wire (void) + +static int +x_trace_wire (Display *dpy) { - fprintf (stderr, "Lib call: %d\n", ++x_wire_count); + fprintf (stderr, "Lib call: %u\n", ++x_wire_count); + return 0; } #endif @@ -10147,19 +23315,106 @@ static char *error_msg; /* Handle the loss of connection to display DPY. ERROR_MESSAGE is the text of an error message that lead to the connection loss. */ -static AVOID +static void x_connection_closed (Display *dpy, const char *error_message, bool ioerror) { - struct x_display_info *dpyinfo = x_display_info_for_display (dpy); + struct x_display_info *dpyinfo; Lisp_Object frame, tail; - ptrdiff_t idx = SPECPDL_INDEX (); + specpdl_ref idx = SPECPDL_INDEX (); + Emacs_XIOErrorHandler io_error_handler; + xm_drop_start_message dmsg; + struct frame *f; + Lisp_Object minibuf_frame, tmp; + struct x_failable_request *failable; + struct x_error_message_stack *stack; + static Display *current_display; + + /* Prevent recursive calls of this function for the same display. + This is because destroying a frame might still cause an IO error + in some cases. (bug#56528) */ + if (current_display == dpy) + return; + + current_display = dpy; + dpyinfo = x_display_info_for_display (dpy); error_msg = alloca (strlen (error_message) + 1); strcpy (error_msg, error_message); /* Inhibit redisplay while frames are being deleted. */ specbind (Qinhibit_redisplay, Qt); + /* If drag-and-drop is in progress, cancel drag-and-drop. If DND + frame's display is DPY, don't reset event masks or try to send + responses to other programs because the display is going + away. */ + + if (x_dnd_in_progress || x_dnd_waiting_for_finish) + { + if (!ioerror) + { + /* Handle display disconnect errors here because this function + is not reentrant at this particular spot. */ + io_error_handler = XSetIOErrorHandler (x_dnd_io_error_handler); + + if (!!sigsetjmp (x_dnd_disconnect_handler, 1) + && x_dnd_in_progress + && dpy == (x_dnd_waiting_for_finish + ? x_dnd_finish_display + : FRAME_X_DISPLAY (x_dnd_frame))) + { + /* Clean up drag and drop if the drag frame's display isn't + the one being disconnected. */ + f = x_dnd_frame; + + 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, x_dnd_motif_operations, + XM_DROP_ACTION_DROP_CANCEL); + dmsg.x = 0; + dmsg.y = 0; + dmsg.index_atom = x_dnd_motif_atom; + dmsg.source_window = FRAME_X_WINDOW (f); + + x_dnd_send_xm_leave_for_drop (FRAME_DISPLAY_INFO (f), f, + x_dnd_last_seen_window, 0); + xm_send_drop_message (FRAME_DISPLAY_INFO (f), FRAME_X_WINDOW (f), + x_dnd_last_seen_window, &dmsg); + } + } + + XSetIOErrorHandler (io_error_handler); + } + + dpyinfo = x_display_info_for_display (dpy); + + x_dnd_last_seen_window = None; + x_dnd_last_seen_toplevel = None; + x_dnd_in_progress = false; + x_dnd_waiting_for_finish = false; + + if (x_dnd_use_toplevels) + x_dnd_free_toplevels (!ioerror); + + x_dnd_return_frame_object = NULL; + x_dnd_movement_frame = NULL; + x_dnd_frame = NULL; + } + if (dpyinfo) { /* Protect display from being closed when we delete the last @@ -10170,13 +23425,24 @@ x_connection_closed (Display *dpy, const char *error_message, bool ioerror) dpyinfo->display = 0; } + /* delete_frame can still try to read async input (even though we + tell pass `noelisp'), because looking up the `delete-before' + parameter calls Fassq which then calls maybe_quit. So block + input while deleting frames. */ + block_input (); + /* First delete frames whose mini-buffers are on frames that are on the dead display. */ FOR_EACH_FRAME (tail, frame) { - Lisp_Object minibuf_frame; + /* Tooltip frames don't have these, so avoid crashing. */ + + if (FRAME_TOOLTIP_P (XFRAME (frame))) + continue; + minibuf_frame = WINDOW_FRAME (XWINDOW (FRAME_MINIBUF_WINDOW (XFRAME (frame)))); + if (FRAME_X_P (XFRAME (frame)) && FRAME_X_P (XFRAME (minibuf_frame)) && ! EQ (frame, minibuf_frame) @@ -10227,19 +23493,51 @@ For details, see etc/PROBLEMS.\n", /* We have just closed all frames on this display. */ emacs_abort (); - { - Lisp_Object tmp; - XSETTERMINAL (tmp, dpyinfo->terminal); - Fdelete_terminal (tmp, Qnoelisp); - } - } + /* This was the last terminal remaining, so print the error + message and associated error handlers and kill Emacs. */ + if (dpyinfo->terminal == terminal_list + && !terminal_list->next_terminal) + { + fprintf (stderr, "%s\n", error_msg); - if (terminal_list == 0) - { - fprintf (stderr, "%s\n", error_msg); - Fkill_emacs (make_fixnum (70)); + if (!ioerror && dpyinfo) + { + /* Dump the list of error handlers for debugging + purposes. */ + + fprintf (stderr, "X error handlers currently installed:\n"); + + for (failable = dpyinfo->failable_requests; + failable < dpyinfo->next_failable_request; + ++failable) + { + if (failable->end) + fprintf (stderr, "Ignoring errors between %lu to %lu\n", + failable->start, failable->end); + else + fprintf (stderr, "Ignoring errors from %lu onwards\n", + failable->start); + } + + for (stack = x_error_message; stack; stack = stack->prev) + fprintf (stderr, "Trapping errors from %lu\n", + stack->first_request); + } + } + + XSETTERMINAL (tmp, dpyinfo->terminal); + Fdelete_terminal (tmp, Qnoelisp); } + unblock_input (); + + /* Sometimes another terminal is still alive, but deleting this + terminal caused all frames to vanish. In that case, simply kill + Emacs, since the next redisplay will abort as there is no more + selected frame. (bug#56528) */ + if (terminal_list == 0 || NILP (selected_frame)) + Fkill_emacs (make_fixnum (70), Qnil); + totally_unblock_input (); unbind_to (idx, Qnil); @@ -10248,6 +23546,7 @@ For details, see etc/PROBLEMS.\n", /* Here, we absolutely have to use a non-local exit (e.g. signal, throw, longjmp), because returning from this function would get us back into Xlib's code which will directly call `exit'. */ + current_display = NULL; error ("%s", error_msg); } @@ -10259,16 +23558,59 @@ static void x_error_quitter (Display *, XErrorEvent *); static int x_error_handler (Display *display, XErrorEvent *event) { + struct x_error_message_stack *stack; + struct x_display_info *dpyinfo; + struct x_failable_request *fail, *last; + #if defined USE_GTK && defined HAVE_GTK3 - if ((event->error_code == BadMatch || event->error_code == BadWindow) + if ((event->error_code == BadMatch + || event->error_code == BadWindow) && event->request_code == X_SetInputFocus) + return 0; +#endif + + dpyinfo = x_display_info_for_display (display); + + if (dpyinfo) { - return 0; + fail = x_request_can_fail (dpyinfo, event->serial); + + if (fail) + { + /* Now that this request sequence has been fully handled, + remove it from the list of requests that can fail. */ + + if (event->serial == fail->end) + { + last = dpyinfo->next_failable_request; + memmove (&dpyinfo->failable_requests, fail, + sizeof *fail * (last - fail)); + dpyinfo->next_failable_request = (dpyinfo->failable_requests + + (last - fail)); + } + + return 0; + } } + + /* 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 + /* Handle errors from some specific XI2 requests here to avoid a + sync in handle_one_xevent. */ + if (dpyinfo && dpyinfo->supports_xi2 + && event->request_code == dpyinfo->xi2_opcode + && (event->minor_code == X_XIGrabDevice + || event->minor_code == X_XIUngrabDevice + || event->minor_code == X_XIAllowEvents)) + return 0; #endif - if (x_error_message) - x_error_catcher (display, event); + stack = x_find_error_handler (display, event); + + if (stack) + x_error_catcher (display, event, stack); else x_error_quitter (display, event); return 0; @@ -10283,7 +23625,8 @@ x_error_handler (Display *display, XErrorEvent *event) static void NO_INLINE x_error_quitter (Display *display, XErrorEvent *event) { - char buf[256], buf1[356]; + char buf[256], buf1[400 + INT_STRLEN_BOUND (int) + + INT_STRLEN_BOUND (unsigned long)]; /* Ignore BadName errors. They can happen because of fonts or colors that are not defined. */ @@ -10295,8 +23638,9 @@ x_error_quitter (Display *display, XErrorEvent *event) original error handler. */ XGetErrorText (display, event->error_code, buf, sizeof (buf)); - sprintf (buf1, "X protocol error: %s on protocol request %d", - buf, event->request_code); + sprintf (buf1, "X protocol error: %s on protocol request %d\n" + "Serial no: %lu\n", buf, event->request_code, + event->serial); x_connection_closed (display, buf1, false); } @@ -10305,7 +23649,7 @@ x_error_quitter (Display *display, XErrorEvent *event) It kills all frames on the display that we lost touch with. If that was the only one, it prints an error message and kills Emacs. */ -static _Noreturn ATTRIBUTE_COLD int +static int NO_INLINE x_io_error_quitter (Display *display) { char buf[256]; @@ -10313,7 +23657,10 @@ x_io_error_quitter (Display *display) snprintf (buf, sizeof buf, "Connection lost to X server '%s'", DisplayString (display)); x_connection_closed (display, buf, true); + + return 0; } + /* Changing the font of the frame. */ @@ -10440,14 +23787,14 @@ xim_open_dpy (struct x_display_info *dpyinfo, char *resource_name) if (xim) { -#ifdef HAVE_X11R6 +#ifdef HAVE_X11R6_XIM XIMCallback destroy; #endif /* Get supported styles and XIM values. */ XGetIMValues (xim, XNQueryInputStyle, &dpyinfo->xim_styles, NULL); -#ifdef HAVE_X11R6 +#ifdef HAVE_X11R6_XIM destroy.callback = xim_destroy_callback; destroy.client_data = (XPointer)dpyinfo; XSetIMValues (xim, XNDestroyCallback, &destroy, NULL); @@ -10474,6 +23821,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 +23882,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 +23911,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 +24026,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 @@ -10758,10 +24109,45 @@ x_set_offset (struct frame *f, register int xoff, register int yoff, int change_ && FRAME_X_OUTPUT (f)->move_offset_top == 0)))) x_check_expected_move (f, modified_left, modified_top); } + /* Instead, just wait for the last ConfigureWindow request to + complete. No window manager is involved when moving child + frames. */ + else + XSync (FRAME_X_DISPLAY (f), False); unblock_input (); } +static Window +x_get_wm_check_window (struct x_display_info *dpyinfo) +{ + Window result; + unsigned char *tmp_data = NULL; + int rc, actual_format; + unsigned long actual_size, bytes_remaining; + Atom actual_type; + + rc = XGetWindowProperty (dpyinfo->display, dpyinfo->root_window, + dpyinfo->Xatom_net_supporting_wm_check, + 0, 1, False, XA_WINDOW, &actual_type, + &actual_format, &actual_size, + &bytes_remaining, &tmp_data); + + if (rc != Success || actual_type != XA_WINDOW + || actual_format != 32 || actual_size != 1) + { + if (tmp_data) + XFree (tmp_data); + + return None; + } + + result = *(Window *) tmp_data; + XFree (tmp_data); + + return result; +} + /* Return true if _NET_SUPPORTING_WM_CHECK window exists and _NET_SUPPORTED on the root window for frame F contains ATOMNAME. This is how a WM check shall be done according to the Window Manager @@ -10769,47 +24155,53 @@ x_set_offset (struct frame *f, register int xoff, register int yoff, int change_ https://freedesktop.org/wiki/Specifications/wm-spec/. */ bool -x_wm_supports (struct frame *f, Atom want_atom) +x_wm_supports_1 (struct x_display_info *dpyinfo, Atom want_atom) { Atom actual_type; unsigned long actual_size, bytes_remaining; int i, rc, actual_format; bool ret; Window wmcheck_window; - struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); Window target_window = dpyinfo->root_window; int max_len = 65536; - Display *dpy = FRAME_X_DISPLAY (f); + Display *dpy = dpyinfo->display; unsigned char *tmp_data = NULL; Atom target_type = XA_WINDOW; + /* The user says there's no window manager, so take him up on + it. */ + if (!NILP (Vx_no_window_manager)) + return false; + block_input (); x_catch_errors (dpy); - rc = XGetWindowProperty (dpy, target_window, - dpyinfo->Xatom_net_supporting_wm_check, - 0, max_len, False, target_type, - &actual_type, &actual_format, &actual_size, - &bytes_remaining, &tmp_data); - if (rc != Success || actual_type != XA_WINDOW || x_had_errors_p (dpy)) - { - if (tmp_data) XFree (tmp_data); - x_uncatch_errors (); - unblock_input (); - return false; - } + wmcheck_window = dpyinfo->net_supported_window; - wmcheck_window = *(Window *) tmp_data; - XFree (tmp_data); + if (wmcheck_window == None) + wmcheck_window = x_get_wm_check_window (dpyinfo); - /* Check if window exists. */ - XSelectInput (dpy, wmcheck_window, StructureNotifyMask); - if (x_had_errors_p (dpy)) + if (!x_special_window_exists_p (dpyinfo, wmcheck_window)) { - x_uncatch_errors_after_check (); - unblock_input (); - return false; + if (dpyinfo->net_supported_window != None) + { + dpyinfo->net_supported_window = None; + wmcheck_window = x_get_wm_check_window (dpyinfo); + + if (!x_special_window_exists_p (dpyinfo, wmcheck_window)) + { + x_uncatch_errors (); + unblock_input (); + return false; + } + } + else + { + x_uncatch_errors (); + unblock_input (); + return false; + } } if (dpyinfo->net_supported_window != wmcheck_window) @@ -10853,22 +24245,36 @@ x_wm_supports (struct frame *f, Atom want_atom) return ret; } +bool +x_wm_supports (struct frame *f, Atom want_atom) +{ + return x_wm_supports_1 (FRAME_DISPLAY_INFO (f), + want_atom); +} + static void set_wm_state (Lisp_Object frame, bool add, Atom atom, Atom value) { - struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (XFRAME (frame)); + struct x_display_info *dpyinfo; + XEvent msg; + + dpyinfo = FRAME_DISPLAY_INFO (XFRAME (frame)); + msg.xclient.type = ClientMessage; + msg.xclient.window = FRAME_OUTER_WINDOW (XFRAME (frame)); + msg.xclient.message_type = dpyinfo->Xatom_net_wm_state; + msg.xclient.format = 32; + + msg.xclient.data.l[0] = add ? 1 : 0; + msg.xclient.data.l[1] = atom; + msg.xclient.data.l[2] = value; + msg.xclient.data.l[3] = 1; /* Source indication. */ + msg.xclient.data.l[4] = 0; - x_send_client_event (frame, make_fixnum (0), frame, - dpyinfo->Xatom_net_wm_state, - make_fixnum (32), - /* 1 = add, 0 = remove */ - Fcons - (make_fixnum (add), - Fcons - (INT_TO_INTEGER (atom), - (value != 0 - ? list1 (INT_TO_INTEGER (value)) - : Qnil)))); + block_input (); + XSendEvent (dpyinfo->display, dpyinfo->root_window, + False, (SubstructureRedirectMask + | SubstructureNotifyMask), &msg); + unblock_input (); } void @@ -10883,6 +24289,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 +24401,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; @@ -10995,18 +24414,24 @@ x_get_current_wm_state (struct frame *f, #ifdef USE_XCB xcb_get_property_cookie_t prop_cookie; xcb_get_property_reply_t *prop; - xcb_atom_t *reply_data UNINIT; + typedef xcb_atom_t reply_data_object; #else Display *dpy = FRAME_X_DISPLAY (f); unsigned long bytes_remaining; int rc, actual_format; Atom actual_type; unsigned char *tmp_data = NULL; - Atom *reply_data UNINIT; + typedef Atom reply_data_object; #endif + reply_data_object *reply_data; +# if defined GCC_LINT || defined lint + reply_data_object reply_data_dummy; + reply_data = &reply_data_dummy; +# endif *sticky = false; *size_state = FULLSCREEN_NONE; + *shaded = false; block_input (); @@ -11068,6 +24493,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 +24517,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 +24657,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 +24681,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; } @@ -11348,7 +24778,7 @@ x_check_expected_move (struct frame *f, int expected_left, int expected_top) int adjusted_left; int adjusted_top; - FRAME_DISPLAY_INFO (f)->wm_type = X_WMTYPE_A; + FRAME_DISPLAY_INFO (f)->wm_type = X_WMTYPE_A; FRAME_X_OUTPUT (f)->move_offset_left = expected_left - current_left; FRAME_X_OUTPUT (f)->move_offset_top = expected_top - current_top; @@ -11365,7 +24795,6 @@ x_check_expected_move (struct frame *f, int expected_left, int expected_top) else /* It's a "Type B" window manager. We don't have to adjust the frame's position. */ - FRAME_DISPLAY_INFO (f)->wm_type = X_WMTYPE_B; } @@ -11379,11 +24808,17 @@ x_check_expected_move (struct frame *f, int expected_left, int expected_top) static void x_sync_with_move (struct frame *f, int left, int top, bool fuzzy) { - int count = 0; + sigset_t emptyset; + int count, current_left, current_top; + struct timespec fallback; + + sigemptyset (&emptyset); + count = 0; while (count++ < 50) { - int current_left = 0, current_top = 0; + current_left = 0; + current_top = 0; /* In theory, this call to XSync only needs to happen once, but in practice, it doesn't seem to work, hence the need for the surrounding @@ -11408,9 +24843,15 @@ x_sync_with_move (struct frame *f, int left, int top, bool fuzzy) /* As a last resort, just wait 0.5 seconds and hope that XGetGeometry will then return up-to-date position info. */ - wait_reading_process_output (0, 500000000, 0, false, Qnil, NULL, 0); -} + fallback = dtotimespec (0.5); + /* This will hang if input is blocked, so use pselect to wait + instead. */ + if (input_blocked_p ()) + pselect (0, NULL, NULL, NULL, &fallback, &emptyset); + else + wait_reading_process_output (0, 500000000, 0, false, Qnil, NULL, 0); +} /* Wait for an event on frame F matching EVENTTYPE. */ void @@ -11567,9 +25008,25 @@ 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_ignore_errors_for_next_request (FRAME_DISPLAY_INFO (f)); + XIWarpPointer (FRAME_X_DISPLAY (f), deviceid, None, + FRAME_X_WINDOW (f), 0, 0, 0, 0, pix_x, pix_y); + x_stop_ignoring_errors (FRAME_DISPLAY_INFO (f)); + } + } + else +#endif + XWarpPointer (FRAME_X_DISPLAY (f), None, FRAME_X_WINDOW (f), + 0, 0, 0, 0, pix_x, pix_y); unblock_input (); } @@ -11597,6 +25054,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 @@ -11625,20 +25089,32 @@ xembed_request_focus (struct frame *f) static void x_ewmh_activate_frame (struct frame *f) { - /* See Window Manager Specification/Extended Window Manager Hints at - https://freedesktop.org/wiki/Specifications/wm-spec/ */ - - struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + XEvent msg; + struct x_display_info *dpyinfo; - if (FRAME_VISIBLE_P (f) && x_wm_supports (f, dpyinfo->Xatom_net_active_window)) - { - Lisp_Object frame; - XSETFRAME (frame, f); - x_send_client_event (frame, make_fixnum (0), frame, - dpyinfo->Xatom_net_active_window, - make_fixnum (32), - list2 (make_fixnum (1), - INT_TO_INTEGER (dpyinfo->last_user_time))); + dpyinfo = FRAME_DISPLAY_INFO (f); + + if (FRAME_VISIBLE_P (f) + && x_wm_supports (f, dpyinfo->Xatom_net_active_window)) + { + /* See the documentation at + https://specifications.freedesktop.org/wm-spec/wm-spec-latest.html + for more details on the format of this message. */ + msg.xclient.type = ClientMessage; + msg.xclient.window = FRAME_OUTER_WINDOW (f); + msg.xclient.message_type = dpyinfo->Xatom_net_active_window; + msg.xclient.format = 32; + msg.xclient.data.l[0] = 1; + msg.xclient.data.l[1] = dpyinfo->last_user_time; + msg.xclient.data.l[2] = (!dpyinfo->x_focus_frame + ? None + : FRAME_OUTER_WINDOW (dpyinfo->x_focus_frame)); + msg.xclient.data.l[3] = 0; + msg.xclient.data.l[4] = 0; + + XSendEvent (dpyinfo->display, dpyinfo->root_window, + False, (SubstructureRedirectMask + | SubstructureNotifyMask), &msg); } } @@ -11658,7 +25134,7 @@ x_get_focus_frame (struct frame *f) /* In certain situations, when the window manager follows a click-to-focus policy, there seems to be no way around calling - XSetInputFocus to give another frame the input focus . + XSetInputFocus to give another frame the input focus. In an ideal world, XSetInputFocus should generally be avoided so that applications don't interfere with the window manager's focus @@ -11668,28 +25144,26 @@ x_get_focus_frame (struct frame *f) static void x_focus_frame (struct frame *f, bool noactivate) { - Display *dpy = FRAME_X_DISPLAY (f); + struct x_display_info *dpyinfo; - block_input (); - x_catch_errors (dpy); + dpyinfo = FRAME_DISPLAY_INFO (f); if (FRAME_X_EMBEDDED_P (f)) - { - /* For Xembedded frames, normally the embedder forwards key - events. See XEmbed Protocol Specification at - https://freedesktop.org/wiki/Specifications/xembed-spec/ */ - xembed_request_focus (f); - } + /* For Xembedded frames, normally the embedder forwards key + events. See XEmbed Protocol Specification at + https://freedesktop.org/wiki/Specifications/xembed-spec/ */ + xembed_request_focus (f); else { - XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + /* Ignore any BadMatch error this request might result in. */ + x_ignore_errors_for_next_request (dpyinfo); + XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), RevertToParent, CurrentTime); + x_stop_ignoring_errors (dpyinfo); + if (!noactivate) x_ewmh_activate_frame (f); } - - x_uncatch_errors (); - unblock_input (); } @@ -11732,9 +25206,14 @@ xembed_send_message (struct frame *f, Time t, enum xembed_message msg, event.xclient.data.l[3] = data1; event.xclient.data.l[4] = data2; + /* XXX: the XEmbed spec tells us to trap errors around this request, + but I don't understand why: there is no way for clients to + survive the death of the parent anyway. */ + + x_ignore_errors_for_next_request (FRAME_DISPLAY_INFO (f)); XSendEvent (FRAME_X_DISPLAY (f), FRAME_X_OUTPUT (f)->parent_desc, False, NoEventMask, &event); - XSync (FRAME_X_DISPLAY (f), False); + x_stop_ignoring_errors (FRAME_DISPLAY_INFO (f)); } /* Change of visibility. */ @@ -11750,6 +25229,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 +25258,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 +25273,25 @@ 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); + x_update_frame_user_time_window (f); + + /* It's been a while since I wrote that code... I don't + remember if it can leave `user_time_window' unset or not. */ + if (output->user_time_window != None) + { + 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 +25315,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)); @@ -11969,6 +25482,18 @@ x_make_frame_visible_invisible (struct frame *f, bool visible) x_make_frame_invisible (f); } +Cursor +x_create_font_cursor (struct x_display_info *dpyinfo, int glyph) +{ + if (glyph <= 65535) + return XCreateFontCursor (dpyinfo->display, glyph); + + /* x-pointer-invisible cannot fit in CARD16, and thus cannot be any + existing cursor. */ + return make_invisible_cursor (dpyinfo); +} + + /* Change window state from mapped to iconified. */ void @@ -12056,9 +25581,13 @@ x_iconify_frame (struct frame *f) msg.xclient.message_type = FRAME_DISPLAY_INFO (f)->Xatom_wm_change_state; msg.xclient.format = 32; msg.xclient.data.l[0] = IconicState; + 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 (! XSendEvent (FRAME_X_DISPLAY (f), - DefaultRootWindow (FRAME_X_DISPLAY (f)), + FRAME_DISPLAY_INFO (f)->root_window, False, SubstructureRedirectMask | SubstructureNotifyMask, &msg)) @@ -12108,7 +25637,7 @@ x_free_frame_resources (struct frame *f) /* Always exit with visible pointer to avoid weird issue with Xfixes (Bug#17609). */ if (f->pointer_invisible) - FRAME_DISPLAY_INFO (f)->toggle_visible_pointer (f, 0); + XTtoggle_invisible_pointer (f, 0); /* We must free faces before destroying windows because some font-driver (e.g. xft) access a window while finishing a @@ -12156,15 +25685,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 +25780,19 @@ 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->motif_drag_atom_owner) + { + dpyinfo->motif_drag_atom_owner = NULL; + dpyinfo->motif_drag_atom = None; + } if (f == dpyinfo->x_focus_frame) dpyinfo->x_focus_frame = 0; @@ -12266,9 +25819,216 @@ x_destroy_window (struct frame *f) if (dpyinfo->display != 0) x_free_frame_resources (f); + xfree (f->output_data.x->saved_menu_event); + +#ifdef HAVE_X_I18N + if (f->output_data.x->preedit_chars) + xfree (f->output_data.x->preedit_chars); +#endif + +#ifdef HAVE_XINPUT2 +#ifdef HAVE_XINPUT2_1 + if (f->output_data.x->xi_masks) + XFree (f->output_data.x->xi_masks); +#else + /* This is allocated by us under very old versions of libXi; see + `setup_xi_event_mask'. */ + if (f->output_data.x->xi_masks) + xfree (f->output_data.x->xi_masks); +#endif +#endif + + xfree (f->output_data.x); + f->output_data.x = NULL; + dpyinfo->reference_count--; } +/* Intern NAME in DPYINFO, but check to see if the atom was already + interned when the X connection was opened, and use that instead. + + If PREDEFINED_ONLY, return None if the atom was not interned during + connection setup or is predefined. */ +Atom +x_intern_cached_atom (struct x_display_info *dpyinfo, + const char *name, bool predefined_only) +{ + int i; + char *ptr; + Atom *atom; + + /* Special atoms that depend on the screen number. */ + char xsettings_atom_name[sizeof "_XSETTINGS_S%d" - 2 + + INT_STRLEN_BOUND (int)]; + char cm_atom_name[sizeof "_NET_WM_CM_S%d" - 2 + + INT_STRLEN_BOUND (int)]; + + sprintf (xsettings_atom_name, "_XSETTINGS_S%d", + XScreenNumberOfScreen (dpyinfo->screen)); + sprintf (cm_atom_name, "_NET_WM_CM_S%d", + XScreenNumberOfScreen (dpyinfo->screen)); + + if (!strcmp (name, xsettings_atom_name)) + return dpyinfo->Xatom_xsettings_sel; + + if (!strcmp (name, cm_atom_name)) + return dpyinfo->Xatom_NET_WM_CM_Sn; + + /* Now do some common predefined atoms. */ + if (!strcmp (name, "PRIMARY")) + return XA_PRIMARY; + + if (!strcmp (name, "SECONDARY")) + return XA_SECONDARY; + + if (!strcmp (name, "STRING")) + return XA_STRING; + + if (!strcmp (name, "INTEGER")) + return XA_INTEGER; + + if (!strcmp (name, "ATOM")) + return XA_ATOM; + + if (!strcmp (name, "WINDOW")) + return XA_WINDOW; + + if (!strcmp (name, "DRAWABLE")) + return XA_DRAWABLE; + + if (!strcmp (name, "BITMAP")) + return XA_BITMAP; + + if (!strcmp (name, "CARDINAL")) + return XA_CARDINAL; + + if (!strcmp (name, "COLORMAP")) + return XA_COLORMAP; + + if (!strcmp (name, "CURSOR")) + return XA_CURSOR; + + if (!strcmp (name, "FONT")) + return XA_FONT; + + if (dpyinfo->motif_drag_atom != None + && !strcmp (name, dpyinfo->motif_drag_atom_name)) + return dpyinfo->motif_drag_atom; + + for (i = 0; i < ARRAYELTS (x_atom_refs); ++i) + { + ptr = (char *) dpyinfo; + + if (!strcmp (x_atom_refs[i].name, name)) + { + atom = (Atom *) (ptr + x_atom_refs[i].offset); + + return *atom; + } + } + + if (predefined_only) + return None; + + return XInternAtom (dpyinfo->display, name, False); +} + +/* Get the name of ATOM, but try not to make a request to the X + server. Whether or not a request to the X server happened is + placed in NEED_SYNC. */ +char * +x_get_atom_name (struct x_display_info *dpyinfo, Atom atom, + bool *need_sync) +{ + char *dpyinfo_pointer, *name, *value, *buffer; + int i; + Atom ref_atom; + + dpyinfo_pointer = (char *) dpyinfo; + value = NULL; + + if (need_sync) + *need_sync = false; + + buffer = alloca (45 + INT_STRLEN_BOUND (int)); + + switch (atom) + { + case XA_PRIMARY: + return xstrdup ("PRIMARY"); + + case XA_SECONDARY: + return xstrdup ("SECONDARY"); + + case XA_INTEGER: + return xstrdup ("INTEGER"); + + case XA_ATOM: + return xstrdup ("ATOM"); + + case XA_CARDINAL: + return xstrdup ("CARDINAL"); + + case XA_WINDOW: + return xstrdup ("WINDOW"); + + case XA_DRAWABLE: + return xstrdup ("DRAWABLE"); + + case XA_BITMAP: + return xstrdup ("BITMAP"); + + case XA_COLORMAP: + return xstrdup ("COLORMAP"); + + case XA_FONT: + return xstrdup ("FONT"); + + default: + if (dpyinfo->motif_drag_atom + && atom == dpyinfo->motif_drag_atom) + return xstrdup (dpyinfo->motif_drag_atom_name); + + if (atom == dpyinfo->Xatom_xsettings_sel) + { + sprintf (buffer, "_XSETTINGS_S%d", + XScreenNumberOfScreen (dpyinfo->screen)); + return xstrdup (buffer); + } + + if (atom == dpyinfo->Xatom_NET_WM_CM_Sn) + { + sprintf (buffer, "_NET_WM_CM_S%d", + XScreenNumberOfScreen (dpyinfo->screen)); + return xstrdup (buffer); + } + + for (i = 0; i < ARRAYELTS (x_atom_refs); ++i) + { + ref_atom = *(Atom *) (dpyinfo_pointer + + x_atom_refs[i].offset); + + if (atom == ref_atom) + return xstrdup (x_atom_refs[i].name); + } + + name = XGetAtomName (dpyinfo->display, atom); + + if (need_sync) + *need_sync = true; + + if (name) + { + value = xstrdup (name); + XFree (name); + } + + break; + } + + return value; +} + /* Setting window manager hints. */ @@ -12279,12 +26039,15 @@ x_destroy_window (struct frame *f) flag (this is useful when FLAGS is 0). The GTK version is in gtkutils.c. */ -#ifndef USE_GTK void x_wm_set_size_hint (struct frame *f, long flags, bool user_position) { +#ifndef USE_GTK XSizeHints size_hints; Window window = FRAME_OUTER_WINDOW (f); +#ifdef USE_X_TOOLKIT + WMShellWidget shell; +#endif if (!window) return; @@ -12292,7 +26055,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 @@ -12380,8 +26199,10 @@ x_wm_set_size_hint (struct frame *f, long flags, bool user_position) #endif /* PWinGravity */ XSetWMNormalHints (FRAME_X_DISPLAY (f), window, &size_hints); +#else + xg_wm_set_size_hint (f, flags, user_position); +#endif /* USE_GTK */ } -#endif /* not USE_GTK */ /* Used for IconicState or NormalState */ @@ -12634,96 +26455,6 @@ my_log_handler (const gchar *log_domain, GLogLevelFlags log_level, } #endif -/* Create invisible cursor on X display referred by DPYINFO. */ - -static Cursor -make_invisible_cursor (struct x_display_info *dpyinfo) -{ - Display *dpy = dpyinfo->display; - static char const no_data[] = { 0 }; - Pixmap pix; - XColor col; - Cursor c = 0; - - x_catch_errors (dpy); - pix = XCreateBitmapFromData (dpy, dpyinfo->root_window, no_data, 1, 1); - if (! x_had_errors_p (dpy) && pix != None) - { - Cursor pixc; - col.pixel = 0; - col.red = col.green = col.blue = 0; - col.flags = DoRed | DoGreen | DoBlue; - pixc = XCreatePixmapCursor (dpy, pix, pix, &col, &col, 0, 0); - if (! x_had_errors_p (dpy) && pixc != None) - c = pixc; - XFreePixmap (dpy, pix); - } - - x_uncatch_errors (); - - return c; -} - -/* True if DPY supports Xfixes extension >= 4. */ - -static bool -x_probe_xfixes_extension (Display *dpy) -{ -#ifdef HAVE_XFIXES - int major, minor; - return XFixesQueryVersion (dpy, &major, &minor) && major >= 4; -#else - return false; -#endif /* HAVE_XFIXES */ -} - -/* Toggle mouse pointer visibility on frame F by using Xfixes functions. */ - -static void -xfixes_toggle_visible_pointer (struct frame *f, bool invisible) -{ -#ifdef HAVE_XFIXES - if (invisible) - XFixesHideCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); - else - XFixesShowCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); - f->pointer_invisible = invisible; -#else - emacs_abort (); -#endif /* HAVE_XFIXES */ -} - -/* Toggle mouse pointer visibility on frame F by using invisible cursor. */ - -static void -x_toggle_visible_pointer (struct frame *f, bool invisible) -{ - eassert (FRAME_DISPLAY_INFO (f)->invisible_cursor != 0); - if (invisible) - XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), - FRAME_DISPLAY_INFO (f)->invisible_cursor); - else - XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), - f->output_data.x->current_cursor); - f->pointer_invisible = invisible; -} - -/* Setup pointer blanking, prefer Xfixes if available. */ - -static void -x_setup_pointer_blanking (struct x_display_info *dpyinfo) -{ - /* FIXME: the brave tester should set EMACS_XFIXES because we're suspecting - X server bug, see https://debbugs.gnu.org/cgi/bugreport.cgi?bug=17609. */ - if (egetenv ("EMACS_XFIXES") && x_probe_xfixes_extension (dpyinfo->display)) - dpyinfo->toggle_visible_pointer = xfixes_toggle_visible_pointer; - else - { - dpyinfo->toggle_visible_pointer = x_toggle_visible_pointer; - dpyinfo->invisible_cursor = make_invisible_cursor (dpyinfo); - } -} - /* Current X display connection identifier. Incremented for each next connection established. */ static unsigned x_display_id; @@ -12742,6 +26473,12 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) #ifdef USE_XCB xcb_connection_t *xcb_conn; #endif + static char const cm_atom_fmt[] = "_NET_WM_CM_S%d"; + char cm_atom_sprintf[sizeof cm_atom_fmt - 2 + INT_STRLEN_BOUND (int)]; +#ifdef USE_GTK + GdkDisplay *gdpy; + GdkScreen *gscr; +#endif block_input (); @@ -12903,11 +26640,18 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) } #endif + /* Select for structure events on the root window, since this allows + us to record changes to the size of the screen. */ + + XSelectInput (dpy, DefaultRootWindow (dpy), StructureNotifyMask); + /* We have definitely succeeded. Record the new connection. */ dpyinfo = xzalloc (sizeof *dpyinfo); terminal = x_create_terminal (dpyinfo); + dpyinfo->next_failable_request = dpyinfo->failable_requests; + { struct x_display_info *share; @@ -12921,7 +26665,8 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) { terminal->kboard = allocate_kboard (Qx); - if (!EQ (XSYMBOL (Qvendor_specific_keysyms)->u.s.function, Qunbound)) + if (!BASE_EQ (XSYMBOL (Qvendor_specific_keysyms)->u.s.function, + Qunbound)) { char *vendor = ServerVendor (dpy); @@ -12934,7 +26679,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. @@ -12961,11 +26706,17 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo->smallest_font_height = 1; dpyinfo->smallest_char_width = 1; + dpyinfo->color_names_size = 256; + dpyinfo->color_names = xzalloc (dpyinfo->color_names_size + * sizeof *dpyinfo->color_names); + dpyinfo->color_names_length = xzalloc (dpyinfo->color_names_size + * sizeof *dpyinfo->color_names_length); + /* Set the name of the terminal. */ terminal->name = xlispstrdup (display_name); #if false - XSetAfterFunction (x_current_display, x_trace_wire); + XSetAfterFunction (dpyinfo->display, x_trace_wire); #endif Lisp_Object system_name = Fsystem_name (); @@ -12987,8 +26738,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 +26762,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 +26815,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 +26878,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 +26932,266 @@ 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; + +#ifndef HAVE_GTK3 + { + AUTO_STRING (disableInputExtension, "disableInputExtension"); + AUTO_STRING (DisableInputExtension, "DisableInputExtension"); + + Lisp_Object value = gui_display_get_resource (dpyinfo, + disableInputExtension, + DisableInputExtension, + Qnil, Qnil); + + if (STRINGP (value) + && (!strcmp (SSDATA (value), "on") + || !strcmp (SSDATA (value), "true"))) + goto skip_xi_setup; + } +#endif + +#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 (); + + /* But don't delude ourselves into thinking that we can use + features provided by a version of the input extension that + libXi itself doesn't support. */ + + if (minor > original_minor) + minor = original_minor; +#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; +#ifndef HAVE_GTK3 + skip_xi_setup: +#endif + ; +#endif + +#if defined HAVE_XRANDR || defined USE_GTK + Lisp_Object term; + + XSETTERMINAL (term, terminal); +#endif + +#ifdef HAVE_XRANDR + dpyinfo->xrandr_supported_p + = XRRQueryExtension (dpy, &dpyinfo->xrandr_event_base, + &dpyinfo->xrandr_error_base); + +#ifndef USE_GTK + dpyinfo->last_monitor_attributes_list = Qnil; +#endif + + if (dpyinfo->xrandr_supported_p) + { + XRRQueryVersion (dpy, &dpyinfo->xrandr_major_version, + &dpyinfo->xrandr_minor_version); + +#ifndef USE_GTK + if (dpyinfo->xrandr_major_version == 1 + && dpyinfo->xrandr_minor_version >= 2) + { + XRRSelectInput (dpyinfo->display, + dpyinfo->root_window, + (RRScreenChangeNotifyMask + | RRCrtcChangeNotifyMask + | RROutputChangeNotifyMask + /* Emacs doesn't actually need this, but GTK + selects for it when the display is + initialized. */ + | RROutputPropertyNotifyMask)); + + dpyinfo->last_monitor_attributes_list + = Fx_display_monitor_attributes_list (term); + } +#endif + } +#endif + +#ifdef USE_GTK + dpyinfo->last_monitor_attributes_list + = Fx_display_monitor_attributes_list (term); + + gdpy = gdk_x11_lookup_xdisplay (dpyinfo->display); + gscr = gdk_display_get_default_screen (gdpy); + + g_signal_connect (G_OBJECT (gscr), "monitors-changed", + G_CALLBACK (x_monitors_changed_cb), + NULL); +#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 +27208,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) @@ -13103,84 +27228,14 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo->resx = (mm < 1) ? 100 : pixels * 25.4 / mm; } - { - static const struct - { - const char *name; - int offset; - } atom_refs[] = { -#define ATOM_REFS_INIT(string, member) \ - { string, offsetof (struct x_display_info, member) }, - ATOM_REFS_INIT ("WM_PROTOCOLS", Xatom_wm_protocols) - ATOM_REFS_INIT ("WM_TAKE_FOCUS", Xatom_wm_take_focus) - 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_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 ("Editres", Xatom_editres) - ATOM_REFS_INIT ("CLIPBOARD", Xatom_CLIPBOARD) - ATOM_REFS_INIT ("TIMESTAMP", Xatom_TIMESTAMP) - ATOM_REFS_INIT ("TEXT", Xatom_TEXT) - ATOM_REFS_INIT ("COMPOUND_TEXT", Xatom_COMPOUND_TEXT) - ATOM_REFS_INIT ("UTF8_STRING", Xatom_UTF8_STRING) - ATOM_REFS_INIT ("DELETE", Xatom_DELETE) - ATOM_REFS_INIT ("MULTIPLE", Xatom_MULTIPLE) - ATOM_REFS_INIT ("INCR", Xatom_INCR) - ATOM_REFS_INIT ("_EMACS_TMP_", Xatom_EMACS_TMP) - 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) - /* For properties of font. */ - ATOM_REFS_INIT ("PIXEL_SIZE", Xatom_PIXEL_SIZE) - ATOM_REFS_INIT ("AVERAGE_WIDTH", Xatom_AVERAGE_WIDTH) - ATOM_REFS_INIT ("_MULE_BASELINE_OFFSET", Xatom_MULE_BASELINE_OFFSET) - ATOM_REFS_INIT ("_MULE_RELATIVE_COMPOSE", Xatom_MULE_RELATIVE_COMPOSE) - ATOM_REFS_INIT ("_MULE_DEFAULT_ASCENT", Xatom_MULE_DEFAULT_ASCENT) - /* Ghostscript support. */ - ATOM_REFS_INIT ("DONE", Xatom_DONE) - ATOM_REFS_INIT ("PAGE", Xatom_PAGE) - ATOM_REFS_INIT ("SCROLLBAR", Xatom_Scrollbar) - ATOM_REFS_INIT ("HORIZONTAL_SCROLLBAR", Xatom_Horizontal_Scrollbar) - ATOM_REFS_INIT ("_XEMBED", Xatom_XEMBED) - /* EWMH */ - ATOM_REFS_INIT ("_NET_WM_STATE", Xatom_net_wm_state) - ATOM_REFS_INIT ("_NET_WM_STATE_FULLSCREEN", Xatom_net_wm_state_fullscreen) - ATOM_REFS_INIT ("_NET_WM_STATE_MAXIMIZED_HORZ", - Xatom_net_wm_state_maximized_horz) - 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_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", - Xatom_net_window_type_tooltip) - ATOM_REFS_INIT ("_NET_WM_ICON_NAME", Xatom_net_wm_icon_name) - ATOM_REFS_INIT ("_NET_WM_NAME", Xatom_net_wm_name) - ATOM_REFS_INIT ("_NET_SUPPORTED", Xatom_net_supported) - ATOM_REFS_INIT ("_NET_SUPPORTING_WM_CHECK", Xatom_net_supporting_wm_check) - ATOM_REFS_INIT ("_NET_WM_WINDOW_OPACITY", Xatom_net_wm_window_opacity) - ATOM_REFS_INIT ("_NET_ACTIVE_WINDOW", Xatom_net_active_window) - 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) - /* Session management */ - ATOM_REFS_INIT ("SM_CLIENT_ID", Xatom_SM_CLIENT_ID) - ATOM_REFS_INIT ("_XSETTINGS_SETTINGS", Xatom_xsettings_prop) - ATOM_REFS_INIT ("MANAGER", Xatom_xsettings_mgr) - 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) - }; + sprintf (cm_atom_sprintf, cm_atom_fmt, + XScreenNumberOfScreen (dpyinfo->screen)); + { int i; - enum { atom_count = ARRAYELTS (atom_refs) }; + enum { atom_count = ARRAYELTS (x_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"; @@ -13188,24 +27243,31 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) + INT_STRLEN_BOUND (int)]; for (i = 0; i < atom_count; i++) - atom_names[i] = (char *) atom_refs[i].name; + atom_names[i] = (char *) x_atom_refs[i].name; /* Build _XSETTINGS_SN atom 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); for (i = 0; i < atom_count; i++) - *(Atom *) ((char *) dpyinfo + atom_refs[i].offset) = atoms_return[i]; + *(Atom *) ((char *) dpyinfo + x_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]; } - dpyinfo->x_dnd_atoms_size = 8; +#ifdef HAVE_XKB + /* Figure out which modifier bits mean what. */ + x_find_modifier_meanings (dpyinfo); +#endif + + dpyinfo->x_dnd_atoms_size = 16; dpyinfo->x_dnd_atoms = xmalloc (sizeof *dpyinfo->x_dnd_atoms * dpyinfo->x_dnd_atoms_size); dpyinfo->gray @@ -13213,7 +27275,10 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) gray_bits, gray_width, gray_height, 1, 0, 1); - x_setup_pointer_blanking (dpyinfo); + dpyinfo->invisible_cursor = make_invisible_cursor (dpyinfo); +#ifdef HAVE_XFIXES + dpyinfo->fixes_pointer_blanking = egetenv ("EMACS_XFIXES"); +#endif #ifdef HAVE_X_I18N xim_initialize (dpyinfo, resource_name); @@ -13286,23 +27351,103 @@ 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 tty or started as a daemon. */ - if (terminal->id == 1 && ! IS_DAEMON) + if (!dpyinfo->next && ! IS_DAEMON) 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; } + + +/* Remove all the selection input events on the keyboard buffer + intended for DPYINFO. */ + +static void +x_delete_selection_requests (struct x_display_info *dpyinfo) +{ + union buffered_input_event *event; + int moved_events; + + for (event = kbd_fetch_ptr; event != kbd_store_ptr; + event = X_NEXT_KBD_EVENT (event)) + { + if (event->kind == SELECTION_REQUEST_EVENT + || event->kind == SELECTION_CLEAR_EVENT) + { + if (SELECTION_EVENT_DPYINFO (&event->sie) != dpyinfo) + continue; + + /* Remove the event from the fifo buffer before processing; + otherwise swallow_events called recursively could see it + and process it again. To do this, we move the events + between kbd_fetch_ptr and EVENT one slot to the right, + cyclically. */ + + if (event < kbd_fetch_ptr) + { + memmove (kbd_buffer + 1, kbd_buffer, + (event - kbd_buffer) * sizeof *kbd_buffer); + kbd_buffer[0] = kbd_buffer[KBD_BUFFER_SIZE - 1]; + moved_events = kbd_buffer + KBD_BUFFER_SIZE - 1 - kbd_fetch_ptr; + } + else + moved_events = event - kbd_fetch_ptr; + + memmove (kbd_fetch_ptr + 1, kbd_fetch_ptr, + moved_events * sizeof *kbd_fetch_ptr); + kbd_fetch_ptr = X_NEXT_KBD_EVENT (kbd_fetch_ptr); + + /* `detect_input_pending' will then recompute whether or not + pending input events exist. */ + input_pending = false; + } + } +} + /* Get rid of display DPYINFO, deleting all frames on it, and without sending any more commands to the X server. */ @@ -13311,6 +27456,8 @@ x_delete_display (struct x_display_info *dpyinfo) { struct terminal *t; struct color_name_cache_entry *color_entry, *next_color_entry; + int i; + struct x_selection_request_event *ie, *last, *temp; /* Close all frames and delete the generic struct terminal for this X display. */ @@ -13326,9 +27473,38 @@ x_delete_display (struct x_display_info *dpyinfo) break; } + /* Find any pending selection requests for this display and unchain + them. */ + + last = NULL; + + for (ie = pending_selection_requests; ie; ie = ie->next) + { + again: + + if (SELECTION_EVENT_DPYINFO (&ie->se) == dpyinfo) + { + if (last) + last->next = ie->next; + + temp = ie; + ie = ie->next; + xfree (temp); + + goto again; + } + + last = ie; + } + + x_delete_selection_requests (dpyinfo); + if (next_noop_dpyinfo == dpyinfo) next_noop_dpyinfo = dpyinfo->next; + if (mouse_click_timeout_display == dpyinfo) + mouse_click_timeout_display = NULL; + if (x_display_list == dpyinfo) x_display_list = dpyinfo->next; else @@ -13340,18 +27516,30 @@ x_delete_display (struct x_display_info *dpyinfo) tail->next = tail->next->next; } - for (color_entry = dpyinfo->color_names; - color_entry; - color_entry = next_color_entry) + for (i = 0; i < dpyinfo->color_names_size; ++i) { - next_color_entry = color_entry->next; - xfree (color_entry->name); - xfree (color_entry); + for (color_entry = dpyinfo->color_names[i]; + color_entry; color_entry = next_color_entry) + { + next_color_entry = color_entry->next; + + xfree (color_entry->name); + xfree (color_entry); + } } + xfree (dpyinfo->color_names); + xfree (dpyinfo->color_names_length); 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); } @@ -13468,6 +27656,28 @@ x_delete_terminal (struct terminal *terminal) image_destroy_all_bitmaps (dpyinfo); XSetCloseDownMode (dpyinfo->display, DestroyAll); + /* Get rid of any drag-and-drop operation that might be in + progress as well. */ + if ((x_dnd_in_progress || x_dnd_waiting_for_finish) + && dpyinfo->display == (x_dnd_waiting_for_finish + ? x_dnd_finish_display + : FRAME_X_DISPLAY (x_dnd_frame))) + { + x_dnd_last_seen_window = None; + x_dnd_last_seen_toplevel = None; + x_dnd_in_progress = false; + x_dnd_waiting_for_finish = false; + + /* The display is going away, so there's no point in + de-selecting for input on the DND toplevels. */ + if (x_dnd_use_toplevels) + x_dnd_free_toplevels (false); + + x_dnd_return_frame_object = NULL; + x_dnd_movement_frame = NULL; + x_dnd_frame = NULL; + } + /* Whether or not XCloseDisplay destroys the associated resource database depends on the version of libX11. To avoid both crash and memory leak, we dissociate the database from the @@ -13494,6 +27704,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 +27717,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; @@ -13524,6 +27741,25 @@ x_delete_terminal (struct terminal *terminal) unblock_input (); } +#ifdef HAVE_XINPUT2 +static bool +x_have_any_grab (struct x_display_info *dpyinfo) +{ + int i; + + if (!dpyinfo->supports_xi2) + return false; + + for (i = 0; i < dpyinfo->num_devices; ++i) + { + if (dpyinfo->devices[i].grab) + return true; + } + + return false; +} +#endif + /* Create a struct terminal, initialize it with the X11 specific functions and make DISPLAY->TERMINAL point to it. */ @@ -13548,7 +27784,9 @@ x_create_terminal (struct x_display_info *dpyinfo) terminal->update_end_hook = x_update_end; terminal->read_socket_hook = XTread_socket; terminal->frame_up_to_date_hook = XTframe_up_to_date; +#ifdef HAVE_XDBE terminal->buffer_flipping_unblocked_hook = XTbuffer_flipping_unblocked_hook; +#endif terminal->defined_color_hook = x_defined_color; terminal->query_frame_background_color = x_query_frame_background_color; terminal->query_colors = x_query_colors; @@ -13588,6 +27826,10 @@ 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; +#ifdef HAVE_XINPUT2 + terminal->any_grab_hook = x_have_any_grab; +#endif /* Other hooks are NULL by default. */ return terminal; @@ -13601,6 +27843,7 @@ x_initialize (void) x_noop_count = 0; any_help_event_p = false; ignore_next_mouse_click_timeout = 0; + mouse_click_timeout_display = NULL; #ifdef USE_GTK current_count = -1; @@ -13653,20 +27896,246 @@ 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 \ + || defined HAVE_XRANDR || defined USE_GTK + 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 +#if defined HAVE_XRANDR || defined USE_GTK + mark_object (dpyinfo->last_monitor_attributes_list); +#endif + } +#endif +} + +/* Error handling functions for Lisp functions that expose X protocol + requests. They are mostly like `x_catch_errors' and friends, but + respect `x-fast-protocol-requests'. */ + +void +x_catch_errors_for_lisp (struct x_display_info *dpyinfo) +{ + if (!x_fast_protocol_requests) + x_catch_errors (dpyinfo->display); + else + x_ignore_errors_for_next_request (dpyinfo); +} + +void +x_check_errors_for_lisp (struct x_display_info *dpyinfo, + const char *format) +{ + if (!x_fast_protocol_requests) + x_check_errors (dpyinfo->display, format); +} + +void +x_uncatch_errors_for_lisp (struct x_display_info *dpyinfo) +{ + if (!x_fast_protocol_requests) + x_uncatch_errors (); + else + x_stop_ignoring_errors (dpyinfo); +} + +/* Preserve the selections in LOST in another frame on DPYINFO. LOST + is a list of local selections that were lost, due to their frame + being deleted. */ + +void +x_preserve_selections (struct x_display_info *dpyinfo, Lisp_Object lost, + Lisp_Object current_owner) +{ + Lisp_Object tail, frame, new_owner, tem; + Time timestamp; + Window *owners; + Atom *names; + ptrdiff_t nowners, counter; + struct selection_input_event clear; +#ifdef USE_XCB + xcb_get_selection_owner_cookie_t *cookies; + xcb_generic_error_t *error; + xcb_get_selection_owner_reply_t *reply; +#endif + + new_owner = Qnil; + + FOR_EACH_FRAME (tail, frame) + { + if (FRAME_X_P (XFRAME (frame)) + && !EQ (frame, current_owner) + && FRAME_DISPLAY_INFO (XFRAME (frame)) == dpyinfo) + { + new_owner = frame; + break; + } + } + + tail = lost; + nowners = 0; + + FOR_EACH_TAIL_SAFE (tail) + { + tem = XCAR (tail); + ++nowners; + + /* The selection is really lost (since we cannot find a new + owner), so run the appropriate hooks. */ + if (NILP (new_owner)) + CALLN (Frun_hook_with_args, Qx_lost_selection_functions, + XCAR (tem)); + else + { + CONS_TO_INTEGER (XCAR (XCDR (XCDR (tem))), Time, timestamp); + + /* This shouldn't be able to signal any errors, despite the + call to `x_check_errors' inside. */ + x_own_selection (XCAR (tem), XCAR (XCDR (tem)), + new_owner, XCAR (XCDR (XCDR (XCDR (XCDR (tem))))), + timestamp); + } + } + + if (!NILP (new_owner)) + { + owners = alloca (sizeof *owners * nowners); + names = alloca (sizeof *names * nowners); +#ifdef USE_XCB + cookies = alloca (sizeof *cookies * nowners); +#endif + + tail = lost; + nowners = 0; + counter = 0; + + FOR_EACH_TAIL_SAFE (tail) + { + tem = XCAR (tail); + + /* Now check if we still don't own that selection, which can + happen if another program set itself as the owner. */ + names[counter++] = symbol_to_x_atom (dpyinfo, XCAR (tem)); + +#ifndef USE_XCB + owners[nowners++] = XGetSelectionOwner (dpyinfo->display, + names[counter - 1]); +#else + cookies[nowners++] + = xcb_get_selection_owner (dpyinfo->xcb_connection, + names[counter - 1]); + } + + nowners = 0; + + FOR_EACH_TAIL_SAFE (tail) + { + reply = xcb_get_selection_owner_reply (dpyinfo->xcb_connection, + cookies[nowners++], &error); + + if (reply) + owners[nowners - 1] = reply->owner; + else + owners[nowners - 1] = None; + + free (reply ? (void *) reply : (void *) error); +#endif + + if (owners[nowners - 1] != FRAME_X_WINDOW (XFRAME (new_owner))) + { + /* Clear the local selection, since we know we don't own + it any longer. */ + CONS_TO_INTEGER (XCAR (XCDR (XCDR (tem))), Time, timestamp); + + clear.kind = SELECTION_CLEAR_EVENT; + + SELECTION_EVENT_DPYINFO (&clear) = dpyinfo; + SELECTION_EVENT_SELECTION (&clear) = names[nowners - 1]; + SELECTION_EVENT_TIME (&clear) = timestamp; + + x_handle_selection_event (&clear); + } + } + + tail = lost; + nowners = 0; + + FOR_EACH_TAIL_SAFE (tail) + { + tem = XCAR (tail); + + /* If the selection isn't owned by us anymore, note that the + selection was lost. */ + if (owners[nowners++] != FRAME_X_WINDOW (XFRAME (new_owner))) + CALLN (Frun_hook_with_args, Qx_lost_selection_functions, + XCAR (tem)); + } + } +} + +void syms_of_xterm (void) { x_error_message = NULL; PDUMPER_IGNORE (x_error_message); + x_dnd_monitors = Qnil; + staticpro (&x_dnd_monitors); + + x_dnd_action_symbol = Qnil; + staticpro (&x_dnd_action_symbol); + + x_dnd_selection_alias_cell = Fcons (Qnil, Qnil); + staticpro (&x_dnd_selection_alias_cell); + + x_dnd_unsupported_drop_data = Qnil; + staticpro (&x_dnd_unsupported_drop_data); + DEFSYM (Qvendor_specific_keysyms, "vendor-specific-keysyms"); DEFSYM (Qlatin_1, "latin-1"); + DEFSYM (Qnow, "now"); + DEFSYM (Qx_dnd_targets_list, "x-dnd-targets-list"); + DEFSYM (Qx_auto_preserve_selections, "x-auto-preserve-selections"); #ifdef USE_GTK xg_default_icon_file = build_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg"); @@ -13704,15 +28173,27 @@ This variable is used only when the window manager requires that you click on a frame to select it (give it focus). In that case, a value of nil, means that the selected window and cursor position changes to reflect the mouse click position, while a non-nil value means that the -selected window or cursor position is preserved. */); +selected window or cursor position is preserved. + +This option works by ignoring button press events for a given amount +of time after a frame might've been focused. If it does not work for +you, try increasing the value of +`x-mouse-click-focus-ignore-time'. */); x_mouse_click_focus_ignore_position = false; + DEFVAR_INT ("x-mouse-click-focus-ignore-time", x_mouse_click_focus_ignore_time, + doc: /* Number of miliseconds for which to ignore buttons after focus change. +This variable only takes effect if +`x-mouse-click-focus-ignore-position' is non-nil, and should be +adjusted if the default value does not work for whatever reason. */); + x_mouse_click_focus_ignore_time = 200; + DEFVAR_LISP ("x-toolkit-scroll-bars", Vx_toolkit_scroll_bars, doc: /* Which toolkit scroll bars Emacs uses, if any. 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 +28219,8 @@ 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"); + DEFSYM (Qx_selection_alias_alist, "x-selection-alias-alist"); DEFVAR_LISP ("x-ctrl-keysym", Vx_ctrl_keysym, doc: /* Which keys Emacs uses for the ctrl modifier. @@ -13813,8 +28296,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 +28323,116 @@ 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_BOOL ("x-dnd-disable-motif-drag", x_dnd_disable_motif_drag, + doc: /* Disable the Motif drag protocol during DND. +This reduces network usage, but also means you can no longer scroll +around inside the Motif window underneath the cursor during +drag-and-drop. */); + x_dnd_disable_motif_drag = false; + + 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, FRAME, TIME and +LOCAL-SELECTION, 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', FRAME is the frame which initiated the drag-and-drop +operation, TIME is the X server time when the drop happened, and +LOCAL-SELECTION is the contents of the `XdndSelection' when +`x-begin-drag' was run; its contents can be retrieved by calling the +function `x-get-local-selection'. + +If a symbol is returned, then it will be used as the return value of +`x-begin-drag'. */); + Vx_dnd_unsupported_drop_function = Qnil; + + DEFVAR_INT ("x-color-cache-bucket-size", x_color_cache_bucket_size, + doc: /* Max number of buckets allowed per display in the internal color cache. +Values less than 1 mean 128. This option is for debugging only. */); + x_color_cache_bucket_size = 128; + + DEFVAR_LISP ("x-dnd-targets-list", Vx_dnd_targets_list, + doc: /* List of drag-and-drop targets. +This variable contains the list of drag-and-drop selection targets +during a drag-and-drop operation, in the same format as the TARGET +argument to `x-begin-drag'. */); + Vx_dnd_targets_list = Qnil; + + DEFVAR_LISP ("x-dnd-native-test-function", Vx_dnd_native_test_function, + doc: /* Function that determines return value of drag-and-drop on Emacs frames. +If the value is a function, `x-begin-drag' will call it with two +arguments, POS and ACTION, where POS is a mouse position list +that specifies the location of the drop, and ACTION is the +action specified by the caller of `x-begin-drag'. The function +should return a symbol describing what to return from +`x-begin-drag' if the drop happens on an Emacs frame. + +If the value is nil, or the function returns a value that is not +a symbol, a drop on an Emacs frame will be canceled. */); + Vx_dnd_native_test_function = Qnil; + + DEFVAR_BOOL ("x-dnd-preserve-selection-data", x_dnd_preserve_selection_data, + doc: /* Preserve selection data after `x-begin-drag' returns. +This lets you inspect the contents of `XdndSelection' after a +drag-and-drop operation, which is useful when writing tests for +drag-and-drop code. */); + x_dnd_preserve_selection_data = false; + + DEFVAR_BOOL ("x-dnd-disable-motif-protocol", x_dnd_disable_motif_protocol, + doc: /* Disable the Motif drag-and-drop protocols. +When non-nil, `x-begin-drag' will not drop onto any window that only +supports the Motif drag-and-drop protocols. */); + x_dnd_disable_motif_protocol = false; + + DEFVAR_BOOL ("x-dnd-use-unsupported-drop", x_dnd_use_unsupported_drop, + doc: /* Enable the emulation of drag-and-drop based on the primary selection. +When nil, do not use the primary selection and synthetic mouse clicks +to emulate the drag-and-drop of `STRING', `UTF8_STRING', +`COMPOUND_TEXT' or `TEXT'. */); + x_dnd_use_unsupported_drop = true; + + DEFVAR_BOOL ("x-fast-protocol-requests", x_fast_protocol_requests, + doc: /* Whether or not X protocol-related functions should wait for errors. +When this is nil, functions such as `x-delete-window-property', +`x-change-window-property' and `x-send-client-message' will wait for a +reply from the X server, and signal any errors that occurred while +executing the protocol request. Otherwise, errors will be silently +ignored without waiting, which is generally faster. */); + x_fast_protocol_requests = false; + + DEFVAR_BOOL ("x-auto-preserve-selections", x_auto_preserve_selections, + doc: /* Whether or not to transfer selection ownership when deleting a frame. +When non-nil, deleting a frame that is currently the owner of a +selection will cause its ownership to be transferred to another frame +on the same display. */); + x_auto_preserve_selections = true; } diff --git a/src/xterm.h b/src/xterm.h index 0040958cd35..6afd08eab2b 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; @@ -67,6 +75,9 @@ typedef GtkWidget *xt_or_gtk_widget; #endif #endif /* USE_GTK */ +/* Number of "failable requests" to store. */ +#define N_FAILABLE_REQUESTS 128 + #ifdef USE_CAIRO #include <cairo-xlib.h> #ifdef CAIRO_HAS_PDF_SURFACE @@ -78,6 +89,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 +102,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 +135,7 @@ INLINE_HEADER_BEGIN | FocusChangeMask \ | LeaveWindowMask \ | EnterWindowMask \ + | PropertyChangeMask \ | VisibilityChangeMask) #ifdef HAVE_X11R6_XIM @@ -124,6 +147,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 +179,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 +189,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 @@ -159,13 +199,78 @@ extern cairo_pattern_t *x_bitmap_stipple (struct frame *, Pixmap); struct color_name_cache_entry { struct color_name_cache_entry *next; + + /* The color values of the cached color entry. */ XColor rgb; + + /* The name of the cached color. */ char *name; + + /* Whether or not RGB is valid (i.e. the color actually exists). */ + bool_bf valid : 1; +}; + +#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); +struct x_failable_request +{ + /* The first request making up this sequence. */ + unsigned long start; + + /* If this is zero, then the request has not yet been made. + Otherwise, this is the request that ends this sequence. */ + unsigned long end; +}; + /* For each X display, we have a structure that records information about it. */ @@ -199,6 +304,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; @@ -228,8 +341,10 @@ struct x_display_info Unused if this display supports Xfixes extension. */ Cursor invisible_cursor; - /* Function used to toggle pointer visibility on this display. */ - void (*toggle_visible_pointer) (struct frame *, bool); +#ifdef HAVE_XFIXES + /* Whether or not to use Xfixes for pointer blanking. */ + bool fixes_pointer_blanking; +#endif #ifdef USE_GTK /* The GDK cursor for scroll bars and popup menus. */ @@ -289,10 +404,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,26 +419,30 @@ 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. */ Atom Xatom_PIXEL_SIZE, Xatom_AVERAGE_WIDTH, - Xatom_MULE_BASELINE_OFFSET, Xatom_MULE_RELATIVE_COMPOSE, - Xatom_MULE_DEFAULT_ASCENT; + Xatom_MULE_BASELINE_OFFSET, Xatom_MULE_RELATIVE_COMPOSE, + Xatom_MULE_DEFAULT_ASCENT; /* More atoms for Ghostscript support. */ Atom Xatom_DONE, Xatom_PAGE; @@ -334,6 +453,25 @@ 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; + + /* Atoms used by the Motif drag and drop protocols. */ + 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; + + /* Atoms used by Emacs internally. */ + Atom Xatom_EMACS_DRAG_ATOM; + + /* Special selections used by the Motif drop protocol to indicate + success or failure. */ + Atom Xatom_XmTRANSFER_SUCCESS, Xatom_XmTRANSFER_FAILURE; + + /* Atoms used by both versions of the OffiX DND protocol (the "old + KDE" protocol in x-dnd.el). */ + Atom Xatom_DndProtocol, Xatom_DND_PROTOCOL; + /* 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,7 +507,8 @@ 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 of last user interaction as returned in X events on this + display. */ Time last_user_time; /* Position where the mouse was last time we reported a motion. @@ -389,6 +528,9 @@ struct x_display_info received, and return that in hopes that it's somewhat accurate. */ Time last_mouse_movement_time; + /* Whether or not the last mouse motion was synthetic. */ + bool last_mouse_movement_time_send_event; + /* The gray pixmap. */ Pixmap gray; @@ -397,10 +539,17 @@ 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. */ - struct color_name_cache_entry *color_names; + struct color_name_cache_entry **color_names; + + /* The number of buckets for each hash in that hash table. */ + ptrdiff_t *color_names_length; + + /* The size of that hash table. */ + int color_names_size; /* If non-null, a cache of the colors in the color map. Don't use this directly, call x_color_cells instead. */ @@ -408,8 +557,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 @@ -430,6 +580,23 @@ struct x_display_info ptrdiff_t x_dnd_atoms_size; ptrdiff_t x_dnd_atoms_length; + /* The unique drag and drop atom used on Motif. None if it was not + already computed. */ + Atom motif_drag_atom; + + /* Its name. */ + char motif_drag_atom_name[sizeof "_EMACS_ATOM_%lu" - 3 + + INT_STRLEN_BOUND (unsigned long)]; + + /* When it was owned. */ + Time motif_drag_atom_time; + + /* The frame that currently owns `motif_drag_atom'. */ + struct frame *motif_drag_atom_owner; + + /* The drag window for this display. */ + Window motif_drag_window; + /* Extended window manager hints, Atoms supported by the window manager and atoms for setting the window type. */ Atom Xatom_net_supported, Xatom_net_supporting_wm_check; @@ -444,7 +611,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 +630,145 @@ 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; + + /* XDS source and target. */ + Atom Xatom_XdndDirectSave0, Xatom_XdndActionDirectSave, Xatom_text_plain; + +#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 + bool xrandr_supported_p; + int xrandr_event_base; + int xrandr_error_base; int xrandr_major_version; int xrandr_minor_version; #endif -#ifdef USE_CAIRO +#if defined HAVE_XRANDR || defined USE_GTK + /* This is used to determine if the monitor configuration really + changed upon receiving a monitor change event. */ + Lisp_Object last_monitor_attributes_list; +#endif + +#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 + + /* The current dimensions of the screen. This is updated when a + ConfigureNotify is received for the root window, and is zero if + that didn't happen. */ + int screen_width; + int screen_height; + + /* The mm width and height of the screen. Updated on + RRScreenChangeNotify. */ + int screen_mm_width; + int screen_mm_height; + + /* Circular buffer of request serial ranges to ignore inside an + error handler in increasing order. */ + struct x_failable_request failable_requests[N_FAILABLE_REQUESTS]; + + /* Pointer to the next request in `failable_requests'. */ + struct x_failable_request *next_failable_request; + + /* The pending drag-and-drop time for middle-click based + drag-and-drop emulation. */ + Time pending_dnd_time; }; #ifdef HAVE_X_I18N @@ -481,6 +776,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; @@ -492,6 +792,9 @@ extern bool x_display_ok (const char *); extern void select_visual (struct x_display_info *); extern Window tip_window; +extern Lisp_Object tip_dx; +extern Lisp_Object tip_dy; +extern Lisp_Object tip_frame; /* Each X frame object points to its own struct x_output object in the output_data.x field. The x_output structure contains @@ -533,6 +836,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 +870,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 +901,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 @@ -689,6 +1014,10 @@ struct x_output false, tell Xt not to wait. */ bool_bf wait_for_wm : 1; + /* True if this frame's alpha value is the same for both the active + and inactive states. */ + bool_bf alpha_identical_p : 1; + #ifdef HAVE_X_I18N /* Input context (currently, this means Compose key handler setup). */ XIC xic; @@ -696,6 +1025,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 +1073,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 @@ -764,13 +1118,15 @@ extern void x_mark_frame_dirty (struct frame *f); code after any drawing command, but we can run code whenever someone asks for the handle necessary to draw. */ #define FRAME_X_DRAWABLE(f) \ - (x_mark_frame_dirty((f)), FRAME_X_RAW_DRAWABLE ((f))) + (x_mark_frame_dirty ((f)), FRAME_X_RAW_DRAWABLE ((f))) +#ifdef HAVE_XDBE #define FRAME_X_DOUBLE_BUFFERED_P(f) \ (FRAME_X_WINDOW (f) != FRAME_X_RAW_DRAWABLE (f)) /* Return the need-buffer-flip flag for frame F. */ #define FRAME_X_NEED_BUFFER_FLIP(f) ((f)->output_data.x->need_buffer_flip) +#endif /* Return the outermost X window associated with the frame F. */ #ifdef USE_X_TOOLKIT @@ -841,6 +1197,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 +1250,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; @@ -1066,27 +1445,37 @@ extern const char *x_get_string_resource (void *, const char *, const char *); /* Defined in xterm.c */ -typedef void (*x_special_error_handler)(Display *, XErrorEvent *, char *, - void *); +typedef void (*x_special_error_handler) (Display *, XErrorEvent *, char *, + void *); extern bool x_text_icon (struct frame *, const char *); extern void x_catch_errors (Display *); extern void x_catch_errors_with_handler (Display *, x_special_error_handler, void *); +extern void x_catch_errors_for_lisp (struct x_display_info *); +extern void x_uncatch_errors_for_lisp (struct x_display_info *); +extern void x_check_errors_for_lisp (struct x_display_info *, + const char *) + ATTRIBUTE_FORMAT_PRINTF (2, 0); extern void x_check_errors (Display *, const char *) ATTRIBUTE_FORMAT_PRINTF (2, 0); extern bool x_had_errors_p (Display *); +extern void x_unwind_errors_to (int); extern void x_uncatch_errors (void); extern void x_uncatch_errors_after_check (void); +extern void x_ignore_errors_for_next_request (struct x_display_info *); +extern void x_stop_ignoring_errors (struct x_display_info *); extern void x_clear_errors (Display *); -extern void x_set_window_size (struct frame *f, bool, int, int); -extern void x_make_frame_visible (struct frame *f); -extern void x_make_frame_invisible (struct frame *f); -extern void x_iconify_frame (struct frame *f); +extern void x_set_window_size (struct frame *, bool, int, int); +extern void x_set_last_user_time_from_lisp (struct x_display_info *, Time); +extern void x_make_frame_visible (struct frame *); +extern void x_make_frame_invisible (struct frame *); +extern void x_iconify_frame (struct frame *); extern void x_free_frame_resources (struct frame *); extern void x_wm_set_size_hint (struct frame *, long, bool); -extern void x_delete_terminal (struct terminal *terminal); +extern void x_delete_terminal (struct terminal *); +extern Cursor x_create_font_cursor (struct x_display_info *, int); extern unsigned long x_copy_color (struct frame *, unsigned long); #ifdef USE_X_TOOLKIT extern XtAppContext Xt_app_con; @@ -1100,50 +1489,63 @@ extern bool x_alloc_lighter_color_for_widget (Widget, Display *, Colormap, extern bool x_alloc_nearest_color (struct frame *, Colormap, XColor *); extern void x_query_colors (struct frame *f, XColor *, int); extern void x_clear_area (struct frame *f, int, int, int, int); -#if !defined USE_X_TOOLKIT && !defined USE_GTK +#if (defined USE_LUCID && defined HAVE_XINPUT2) \ + || (!defined USE_X_TOOLKIT && !defined USE_GTK) extern void x_mouse_leave (struct x_display_info *); #endif +extern void x_wait_for_cell_change (Lisp_Object, struct timespec); -#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 -INLINE int -x_display_pixel_height (struct x_display_info *dpyinfo) -{ - return HeightOfScreen (dpyinfo->screen); -} - -INLINE int -x_display_pixel_width (struct x_display_info *dpyinfo) -{ - return WidthOfScreen (dpyinfo->screen); -} +#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 -INLINE void -x_display_set_last_user_time (struct x_display_info *dpyinfo, Time t) -{ -#ifdef ENABLE_CHECKING - eassert (t <= X_ULONG_MAX); +#ifdef HAVE_GTK3 +extern void x_scroll_bar_configure (GdkEvent *); #endif - dpyinfo->last_user_time = t; -} + +#define DEFER_SELECTIONS \ + x_defer_selection_requests (); \ + record_unwind_protect_void (x_release_selection_requests_and_flush) + +extern void x_defer_selection_requests (void); +extern void x_release_selection_requests_and_flush (void); +extern void x_handle_pending_selection_requests (void); +extern bool x_detect_pending_selection_requests (void); +extern Lisp_Object x_dnd_begin_drag_and_drop (struct frame *, Time, Atom, + Lisp_Object, Atom *, const char **, + size_t, bool, Atom *, int, + Lisp_Object, bool); +extern void x_dnd_do_unsupported_drop (struct x_display_info *, Lisp_Object, + Lisp_Object, Lisp_Object, Window, int, + int, Time); + +extern int x_display_pixel_height (struct x_display_info *); +extern int x_display_pixel_width (struct x_display_info *); 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 +1555,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,16 +1563,18 @@ 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); +extern bool x_wm_supports_1 (struct x_display_info *, Atom); extern void x_wait_for_event (struct frame *, int); extern void x_clear_under_internal_border (struct frame *f); @@ -1184,6 +1588,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. */ @@ -1191,18 +1599,14 @@ extern void x_handle_property_notify (const XPropertyEvent *); extern void x_handle_selection_notify (const XSelectionEvent *); extern void x_handle_selection_event (struct selection_input_event *); extern void x_clear_frame_selections (struct frame *); - -extern void x_send_client_event (Lisp_Object display, - Lisp_Object dest, - Lisp_Object from, - Atom message_type, - Lisp_Object format, - Lisp_Object values); +extern Lisp_Object x_atom_to_symbol (struct x_display_info *, Atom); +extern Atom symbol_to_x_atom (struct x_display_info *, Lisp_Object); extern bool x_handle_dnd_message (struct frame *, const XClientMessageEvent *, struct x_display_info *, - struct input_event *); + struct input_event *, + bool, int, int); extern int x_check_property_data (Lisp_Object); extern void x_fill_property_data (Display *, Lisp_Object, @@ -1217,6 +1621,15 @@ 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_own_selection (Lisp_Object, Lisp_Object, Lisp_Object, + Lisp_Object, Time); +extern Atom x_intern_cached_atom (struct x_display_info *, const char *, + bool); +extern char *x_get_atom_name (struct x_display_info *, Atom, bool *) + ATTRIBUTE_MALLOC ATTRIBUTE_DEALLOC_FREE; + #ifdef USE_GTK extern bool xg_set_icon (struct frame *, Lisp_Object); extern bool xg_set_icon_from_xpm_data (struct frame *, const char **); @@ -1230,6 +1643,8 @@ extern void xic_set_statusarea (struct frame *); extern void xic_set_xfontset (struct frame *, const char *); extern bool x_defined_color (struct frame *, const char *, Emacs_Color *, bool, bool); +extern void x_preserve_selections (struct x_display_info *, Lisp_Object, + Lisp_Object); #ifdef HAVE_X_I18N extern void free_frame_xic (struct frame *); # if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT @@ -1263,6 +1678,33 @@ 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 bool x_dnd_waiting_for_finish; +extern struct frame *x_dnd_frame; +extern struct frame *x_dnd_finish_frame; +extern int x_error_message_count; + +#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); +#ifndef USE_GTK +extern unsigned int xi_convert_event_state (XIDeviceEvent *); +#endif +#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) {} |