summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorDmitry Gutov <dgutov@yandex.ru>2022-07-11 14:17:45 +0300
committerDmitry Gutov <dgutov@yandex.ru>2022-07-11 14:17:45 +0300
commitd4875e1235375feb8d67bad8b1a76e64445f3b1a (patch)
treef011f6df1cc03dfb724fdffae09886f6589c3adb /src
parent9c00d6c3f6f45755a20d093bbd821673fc7ac405 (diff)
parentb283e36cf1902eeb6d532077e1f46270aa1224e1 (diff)
downloademacs-scratch/etags-regen.tar.gz
Merge branch 'master' into scratch/etags-regenscratch/etags-regen
Diffstat (limited to 'src')
-rw-r--r--src/.gdbinit12
-rw-r--r--src/Makefile.in31
-rw-r--r--src/alloc.c804
-rw-r--r--src/atimer.c37
-rw-r--r--src/bidi.c65
-rw-r--r--src/bignum.c93
-rw-r--r--src/bignum.h1
-rw-r--r--src/buffer.c172
-rw-r--r--src/bytecode.c657
-rw-r--r--src/callint.c49
-rw-r--r--src/callproc.c86
-rw-r--r--src/ccl.c6
-rw-r--r--src/character.c40
-rw-r--r--src/character.h2
-rw-r--r--src/charset.c29
-rw-r--r--src/coding.c65
-rw-r--r--src/comp.c431
-rw-r--r--src/comp.h4
-rw-r--r--src/composite.c95
-rw-r--r--src/conf_post.h54
-rw-r--r--src/cygw32.c8
-rw-r--r--src/data.c363
-rw-r--r--src/dbusbind.c41
-rw-r--r--src/decompress.c12
-rw-r--r--src/deps.mk2
-rw-r--r--src/dired.c71
-rw-r--r--src/dispextern.h49
-rw-r--r--src/dispnew.c126
-rw-r--r--src/doc.c73
-rw-r--r--src/dynlib.c4
-rw-r--r--src/dynlib.h1
-rw-r--r--src/editfns.c24
-rw-r--r--src/emacs-module.c14
-rw-r--r--src/emacs.c395
-rw-r--r--src/emacsgtkfixed.c36
-rw-r--r--src/eval.c1031
-rw-r--r--src/fileio.c132
-rw-r--r--src/filelock.c188
-rw-r--r--src/floatfns.c22
-rw-r--r--src/fns.c1173
-rw-r--r--src/font.c88
-rw-r--r--src/font.h5
-rw-r--r--src/fontset.c97
-rw-r--r--src/frame.c248
-rw-r--r--src/frame.h35
-rw-r--r--src/fringe.c23
-rw-r--r--src/ftcrfont.c72
-rw-r--r--src/ftfont.c51
-rw-r--r--src/gnutls.c38
-rw-r--r--src/gnutls.h1
-rw-r--r--src/gtkutil.c944
-rw-r--r--src/gtkutil.h11
-rw-r--r--src/haiku_draw_support.cc288
-rw-r--r--src/haiku_font_support.cc508
-rw-r--r--src/haiku_io.c68
-rw-r--r--src/haiku_select.cc489
-rw-r--r--src/haiku_support.cc3986
-rw-r--r--src/haiku_support.h1073
-rw-r--r--src/haikufns.c1769
-rw-r--r--src/haikufont.c478
-rw-r--r--src/haikugui.h113
-rw-r--r--src/haikuimage.c9
-rw-r--r--src/haikumenu.c362
-rw-r--r--src/haikuselect.c1127
-rw-r--r--src/haikuselect.h84
-rw-r--r--src/haikuterm.c2412
-rw-r--r--src/haikuterm.h218
-rw-r--r--src/image.c1090
-rw-r--r--src/indent.c78
-rw-r--r--src/inotify.c2
-rw-r--r--src/insdel.c6
-rw-r--r--src/intervals.c7
-rw-r--r--src/intervals.h2
-rw-r--r--src/json.c18
-rw-r--r--src/keyboard.c611
-rw-r--r--src/keyboard.h20
-rw-r--r--src/keymap.c65
-rw-r--r--src/kqueue.c4
-rw-r--r--src/lisp.h665
-rw-r--r--src/lread.c2397
-rw-r--r--src/macfont.m18
-rw-r--r--src/macros.c14
-rw-r--r--src/menu.c30
-rw-r--r--src/minibuf.c177
-rw-r--r--src/msdos.c3
-rw-r--r--src/msdos.h9
-rw-r--r--src/nsfns.m868
-rw-r--r--src/nsfont.m22
-rw-r--r--src/nsimage.m2
-rw-r--r--src/nsmenu.m429
-rw-r--r--src/nsselect.m239
-rw-r--r--src/nsterm.h147
-rw-r--r--src/nsterm.m1732
-rw-r--r--src/nsxwidget.m3
-rw-r--r--src/pdumper.c42
-rw-r--r--src/pgtkfns.c630
-rw-r--r--src/pgtkim.c16
-rw-r--r--src/pgtkmenu.c71
-rw-r--r--src/pgtkselect.c2090
-rw-r--r--src/pgtkselect.h33
-rw-r--r--src/pgtkterm.c2616
-rw-r--r--src/pgtkterm.h306
-rw-r--r--src/print.c1181
-rw-r--r--src/process.c354
-rw-r--r--src/profiler.c4
-rw-r--r--src/regex-emacs.c53
-rw-r--r--src/search.c63
-rw-r--r--src/sheap.h2
-rw-r--r--src/sort.c974
-rw-r--r--src/sound.c10
-rw-r--r--src/sqlite.c99
-rw-r--r--src/syntax.c16
-rw-r--r--src/syntax.h4
-rw-r--r--src/sysdep.c377
-rw-r--r--src/syssignal.h2
-rw-r--r--src/sysstdio.h7
-rw-r--r--src/systhread.h2
-rw-r--r--src/systime.h5
-rw-r--r--src/term.c12
-rw-r--r--src/termhooks.h62
-rw-r--r--src/terminal.c6
-rw-r--r--src/textprop.c41
-rw-r--r--src/thread.c39
-rw-r--r--src/thread.h23
-rw-r--r--src/timefns.c162
-rw-r--r--src/tparam.h7
-rw-r--r--src/undo.c4
-rw-r--r--src/verbose.mk.in31
-rw-r--r--src/w16select.c2
-rw-r--r--src/w32.c210
-rw-r--r--src/w32.h3
-rw-r--r--src/w32console.c12
-rw-r--r--src/w32fns.c182
-rw-r--r--src/w32font.c28
-rw-r--r--src/w32image.c5
-rw-r--r--src/w32menu.c21
-rw-r--r--src/w32notify.c32
-rw-r--r--src/w32proc.c17
-rw-r--r--src/w32select.c2
-rw-r--r--src/w32term.c312
-rw-r--r--src/w32term.h23
-rw-r--r--src/w32xfns.c78
-rw-r--r--src/widget.c71
-rw-r--r--src/widget.h2
-rw-r--r--src/window.c343
-rw-r--r--src/window.h14
-rw-r--r--src/xdisp.c726
-rw-r--r--src/xfaces.c402
-rw-r--r--src/xfns.c1878
-rw-r--r--src/xfont.c28
-rw-r--r--src/xftfont.c190
-rw-r--r--src/xgselect.c55
-rw-r--r--src/xgselect.h7
-rw-r--r--src/xmenu.c478
-rw-r--r--src/xrdb.c65
-rw-r--r--src/xselect.c744
-rw-r--r--src/xsettings.c202
-rw-r--r--src/xsettings.h10
-rw-r--r--src/xsmfns.c2
-rw-r--r--src/xterm.c15672
-rw-r--r--src/xterm.h476
-rw-r--r--src/xwidget.c828
-rw-r--r--src/xwidget.h8
163 files changed, 47141 insertions, 15084 deletions
diff --git a/src/.gdbinit b/src/.gdbinit
index 132f414af94..9ec536a96d1 100644
--- a/src/.gdbinit
+++ b/src/.gdbinit
@@ -751,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
@@ -1016,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
diff --git a/src/Makefile.in b/src/Makefile.in
index 04fabd5f424..7d15b7afd51 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -146,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@
@@ -264,9 +265,18 @@ 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@
@@ -396,9 +406,9 @@ EMACS_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \
$(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) $(HAIKU_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) \
@@ -424,7 +434,7 @@ 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 \
@@ -545,17 +555,17 @@ lisp = $(addprefix ${lispsource}/,${shortlisp})
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) $(XINPUT_LIBS) $(HAIKU_LIBS) \
- $(SQLITE3_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,
@@ -616,7 +626,7 @@ endif
## icon set.
ifeq ($(HAVE_BE_APP),yes)
-Emacs: emacs$(EXEEXT)
+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 $@
@@ -678,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
@@ -914,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 7582a426011..f115a3cebaa 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -445,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
@@ -490,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
@@ -592,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));
}
@@ -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;
}
@@ -1853,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;
@@ -1867,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);
@@ -1967,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,
@@ -2483,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;
@@ -2513,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
@@ -3515,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
@@ -3599,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;
@@ -3668,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
@@ -3850,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
@@ -4884,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;
@@ -4956,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\
@@ -4969,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\
@@ -5111,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
@@ -5212,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)
@@ -5638,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. */
@@ -5699,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;
@@ -6055,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)
@@ -6062,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);
@@ -6070,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);
@@ -6143,6 +6180,7 @@ garbage_collect (void)
mark_pinned_objects ();
mark_pinned_symbols ();
+ mark_lread ();
mark_terminals ();
mark_kboards ();
mark_threads ();
@@ -6162,6 +6200,14 @@ garbage_collect (void)
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. */
@@ -6192,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 ();
@@ -6220,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);
}
@@ -6259,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
@@ -6273,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[] = {
@@ -6362,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)
@@ -6412,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))
{
@@ -6424,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
@@ -6589,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 */
@@ -6701,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
@@ -6901,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. */
@@ -6937,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:
@@ -7337,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
@@ -7351,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)
@@ -7373,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))
@@ -7697,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;
@@ -7707,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);
}
diff --git a/src/atimer.c b/src/atimer.c
index 1c6c881fc02..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,11 +301,6 @@ 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)
{
@@ -337,20 +336,24 @@ set_alarm (void)
}
#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);
-#endif /* not HAVE_SETITIMER */
- alarm (max (interval.tv_sec, 1));
+ struct itimerval it = {.it_value = make_timeval (interval)};
+ setitimer (ITIMER_REAL, &it, 0);
+#else
+ alarm (max (interval.tv_sec, 1));
+#endif
+ }
}
}
diff --git a/src/bidi.c b/src/bidi.c
index c5d524f0493..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
@@ -2758,6 +2785,7 @@ bidi_find_bracket_pairs (struct bidi_it *bidi_it)
(which requires the display engine to copy the cache back and
forth many times). */
if (maxlevel == base_level
+ && (l2r_seen || r2l_seen) /* N0d */
&& ((base_level == 0 && !r2l_seen)
|| (base_level == 1 && !l2r_seen)))
{
@@ -2793,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;
}
@@ -2920,13 +2954,17 @@ bidi_resolve_brackets (struct bidi_it *bidi_it)
int embedding_level = bidi_it->level_stack[bidi_it->stack_idx].level;
bidi_type_t embedding_type = (embedding_level & 1) ? STRONG_R : STRONG_L;
- eassert (bidi_it->prev_for_neutral.type != UNKNOWN_BT);
eassert (bidi_it->bracket_pairing_pos > bidi_it->charpos);
if (bidi_it->bracket_enclosed_type == embedding_type) /* N0b */
type = embedding_type;
- else
+ else if (bidi_it->bracket_enclosed_type == STRONG_L /* N0c, N0d */
+ || bidi_it->bracket_enclosed_type == STRONG_R)
{
- 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:
@@ -3358,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)
@@ -3393,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);
}
}
@@ -3569,7 +3614,9 @@ bidi_move_to_visually_next (struct bidi_it *bidi_it)
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. */
@@ -3607,8 +3654,8 @@ bidi_find_first_overridden (struct bidi_it *bidi_it)
|| ((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 cb5322f291a..e4e4d45d686 100644
--- a/src/bignum.c
+++ b/src/bignum.c
@@ -476,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 10ac91915c6..509ce51b55e 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -912,6 +912,10 @@ does not run the hooks `kill-buffer-hook',
Fset (intern ("buffer-save-without-query"), Qnil);
Fset (intern ("buffer-file-number"), Qnil);
Fset (intern ("buffer-stale-function"), Qnil);
+ /* Cloned buffers need extra setup, to do things such as deep
+ variable copies for list variables that might be mangled due
+ to destructive operations in the indirect buffer. */
+ run_hook (Qclone_indirect_buffer_hook);
set_buffer_internal_1 (old_b);
}
@@ -1061,7 +1065,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 +1159,9 @@ is first appended to NAME, to speed up finding a non-existent buffer. */)
else
{
char number[sizeof "-999999"];
-
- /* Use XFIXNUM instead of XFIXNAT to work around GCC bug 80776. */
- int i = XFIXNUM (Frandom (make_fixnum (1000000)));
- eassume (0 <= i && i < 1000000);
-
+ EMACS_INT r = get_random ();
+ eassume (0 <= r);
+ int i = r % 1000000;
AUTO_STRING_WITH_LEN (lnumber, number, sprintf (number, "-%d", i));
genbase = concat2 (name, lnumber);
if (NILP (Fget_buffer (genbase)))
@@ -1216,7 +1218,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 +1249,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object buffer)
{ /* Look in local_var_alist. */
struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
XSETSYMBOL (variable, sym); /* Update In case of aliasing. */
- result = Fassoc (variable, BVAR (buf, local_var_alist), Qnil);
+ result = assq_no_quit (variable, BVAR (buf, local_var_alist));
if (!NILP (result))
{
if (blv->fwd.fwdptr)
@@ -1311,7 +1313,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 +1336,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 +1376,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 +1447,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 +1491,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 +1518,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.
@@ -1574,7 +1607,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)));
}
@@ -1632,16 +1665,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
@@ -1657,15 +1681,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,
@@ -1770,7 +1786,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 ();
@@ -1793,10 +1809,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. */
@@ -1835,7 +1853,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
@@ -1879,7 +1897,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. */
@@ -2093,7 +2111,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);
@@ -2116,7 +2133,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. */
@@ -2486,23 +2503,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),
@@ -2512,10 +2529,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;
@@ -3925,9 +3943,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);
@@ -4031,7 +4049,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;
@@ -4045,9 +4063,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);
@@ -4092,7 +4110,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)
@@ -4152,7 +4170,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);
@@ -5551,6 +5569,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));
@@ -5569,6 +5588,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,
@@ -5580,8 +5601,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,
@@ -6392,6 +6416,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);
@@ -6408,6 +6439,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);
@@ -6442,5 +6474,9 @@ 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");
+
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 = &current_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 = &current_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 4d3b0bb8e06..dd162f36a6c 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -85,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;
@@ -122,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
@@ -289,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]))
{
@@ -310,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.
@@ -323,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;
@@ -331,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;
@@ -616,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)
{
@@ -654,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
{
@@ -681,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 */
@@ -813,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
@@ -957,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
@@ -977,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)
@@ -1009,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
@@ -1069,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;
@@ -1123,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);
}
@@ -1334,7 +1339,8 @@ emacs_posix_spawn_init_actions (posix_spawn_file_actions_t *actions,
}
static int
-emacs_posix_spawn_init_attributes (posix_spawnattr_t *attributes)
+emacs_posix_spawn_init_attributes (posix_spawnattr_t *attributes,
+ const sigset_t *oldset)
{
int error = posix_spawnattr_init (attributes);
if (error != 0)
@@ -1376,11 +1382,7 @@ emacs_posix_spawn_init_attributes (posix_spawnattr_t *attributes)
goto out;
/* Stop blocking SIGCHLD in the child. */
- sigset_t oldset;
- error = pthread_sigmask (SIG_SETMASK, NULL, &oldset);
- if (error != 0)
- goto out;
- error = posix_spawnattr_setsigmask (attributes, &oldset);
+ error = posix_spawnattr_setsigmask (attributes, oldset);
if (error != 0)
goto out;
@@ -1391,23 +1393,6 @@ emacs_posix_spawn_init_attributes (posix_spawnattr_t *attributes)
return error;
}
-static int
-emacs_posix_spawn_init (posix_spawn_file_actions_t *actions,
- posix_spawnattr_t *attributes, int std_in,
- int std_out, int std_err, const char *cwd)
-{
- int error = emacs_posix_spawn_init_actions (actions, std_in,
- std_out, std_err, cwd);
- if (error != 0)
- return error;
-
- error = emacs_posix_spawn_init_attributes (attributes);
- if (error != 0)
- return error;
-
- return 0;
-}
-
#endif
/* Start a new asynchronous subprocess. If successful, return zero
@@ -1442,9 +1427,12 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
if (use_posix_spawn)
{
/* Initialize optional attributes before blocking. */
- int error
- = emacs_posix_spawn_init (&actions, &attributes, std_in,
- std_out, std_err, cwd);
+ int error = emacs_posix_spawn_init_actions (&actions, std_in,
+ std_out, std_err, cwd);
+ if (error != 0)
+ return error;
+
+ error = emacs_posix_spawn_init_attributes (&attributes, oldset);
if (error != 0)
return error;
}
@@ -1500,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
@@ -1703,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))
@@ -1711,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))
@@ -1828,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/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..d12df23f8ea 100644
--- a/src/character.c
+++ b/src/character.c
@@ -654,15 +654,14 @@ str_as_multibyte (unsigned char *str, ptrdiff_t len, ptrdiff_t nbytes,
ptrdiff_t
count_size_as_multibyte (const unsigned char *str, ptrdiff_t len)
{
- const unsigned char *endp = str + len;
+ /* Count the number of non-ASCII (raw) bytes, since they will occupy
+ two bytes in a multibyte string. */
+ ptrdiff_t nonascii = 0;
+ for (ptrdiff_t i = 0; i < len; i++)
+ nonascii += str[i] >> 7;
ptrdiff_t bytes;
-
- for (bytes = 0; str < endp; str++)
- {
- int n = *str < 0x80 ? 1 : 2;
- if (INT_ADD_WRAPV (bytes, n, &bytes))
- string_overflow ();
- }
+ if (INT_ADD_WRAPV (len, nonascii, &bytes))
+ string_overflow ();
return bytes;
}
@@ -735,31 +734,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..2ca935ba04c 100644
--- a/src/character.h
+++ b/src/character.h
@@ -569,8 +569,6 @@ 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_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 dec9d56df2c..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). */
@@ -793,16 +793,21 @@ map_charset_chars (void (*c_function)(Lisp_Object, Lisp_Object), Lisp_Object fun
DEFUN ("map-charset-chars", Fmap_charset_chars, Smap_charset_chars, 2, 5, 0,
doc: /* Call FUNCTION for all characters in CHARSET.
-FUNCTION is called with an argument RANGE and the optional 3rd
-argument ARG.
-
-RANGE is a cons (FROM . TO), where FROM and TO indicate a range of
-characters contained in CHARSET.
-
-The optional 4th and 5th arguments FROM-CODE and TO-CODE specify the
-range of code points (in CHARSET) of target characters. Note that
-these are not character codes, but code points in CHARSET; for the
-difference see `decode-char' and `list-charset-chars'. */)
+Optional 3rd argument ARG is an additional argument to be passed
+to FUNCTION, see below.
+Optional 4th and 5th arguments FROM-CODE and TO-CODE specify the
+range of code points (in CHARSET) of target characters on which to
+map the FUNCTION. Note that these are not character codes, but code
+points of CHARSET; for the difference see `decode-char' and
+`list-charset-chars'. If FROM-CODE is nil or imitted, it stands for
+the first code point of CHARSET; if TO-CODE is nil or omitted, it
+stands for the last code point of CHARSET.
+
+FUNCTION will be called with two arguments: RANGE and ARG.
+RANGE is a cons (FROM . TO), where FROM and TO specify a range of
+characters that belong to CHARSET on which FUNCTION should do its
+job. FROM and TO are Emacs character codes, unlike FROM-CODE and
+TO-CODE, which are CHARSET code points. */)
(Lisp_Object function, Lisp_Object charset, Lisp_Object arg, Lisp_Object from_code, Lisp_Object to_code)
{
struct charset *cs;
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 64db13fc1cb..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);
@@ -4124,7 +4397,7 @@ one for the file name and another for its contents, followed by .eln. */)
{
Lisp_Object match_idx =
Fstring_match (XCAR (lds_re_tail), filename, Qnil, Qnil);
- if (EQ (match_idx, make_fixnum (0)))
+ if (BASE_EQ (match_idx, make_fixnum (0)))
{
filename =
Freplace_match (build_string ("//"), Qt, Qt, filename, Qnil);
@@ -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));
}
@@ -4840,13 +5122,14 @@ 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 (comp__loadable)
+ if (comp__compilable)
{
/* Startup is done, comp is usable. */
- Frequire (Qcomp, Qnil, Qnil);
- Fputhash (function_name, definition, Vcomp_deferred_pending_h);
+ CALL0I (startup--require-comp-safely);
CALLN (Ffuncall, intern_c_string ("native--compile-async"),
src, Qnil, Qlate);
}
@@ -4982,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);
@@ -5000,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
@@ -5017,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 = &current_thread;
+ *f_symbols_with_pos_enabled_reloc = &symbols_with_pos_enabled;
*pure_reloc = pure;
/* Imported functions. */
@@ -5055,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
@@ -5119,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;
@@ -5152,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;
@@ -5175,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. */
@@ -5205,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;
}
@@ -5321,9 +5602,9 @@ syms_of_comp (void)
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--loadable",
- comp__loadable,
- doc: /* Non-nil when comp.el can be loaded.
+ 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",
@@ -5386,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");
@@ -5499,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.
@@ -5536,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 711284ba6fc..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))
@@ -2064,7 +2096,8 @@ The default value is the function `compose-chars-after'. */);
Use the command `auto-composition-mode' to change this variable.
If this variable is a string, `auto-composition-mode' will be disabled in
-buffers displayed on a terminal whose type compares equal to this string. */);
+buffers displayed on a terminal whose type, as reported by `tty-type',
+compares equal to that string. */);
Vauto_composition_mode = Qt;
DEFVAR_LISP ("auto-composition-function", Vauto_composition_function,
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 5d0790692b7..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;
@@ -318,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)
@@ -677,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
@@ -755,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))
@@ -767,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))
@@ -789,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.
@@ -808,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);
@@ -952,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;
@@ -970,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) :
@@ -984,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))
@@ -1015,13 +1139,21 @@ 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;
}
DEFUN ("command-modes", Fcommand_modes, Scommand_modes, 1, 1, 0,
@@ -1047,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;
@@ -1410,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)
@@ -1449,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);
@@ -1476,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))
@@ -1717,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);
@@ -1803,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,
@@ -1822,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);
@@ -2002,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:
@@ -2103,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))
@@ -2183,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,
@@ -2194,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);
}
@@ -2224,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. */
@@ -2232,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:
{
@@ -2697,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);
}
@@ -2705,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);
}
@@ -2713,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);
}
@@ -2721,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);
}
@@ -2852,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.
@@ -2859,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,
@@ -3352,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)
{
@@ -3397,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));
@@ -3896,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");
@@ -3931,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");
@@ -3958,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");
@@ -4036,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");
@@ -4074,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");
@@ -4093,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);
@@ -4123,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);
@@ -4205,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 954992a0ec2..ca7834dec55 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -1075,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;
@@ -1720,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
@@ -1753,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;
@@ -1844,7 +1856,6 @@ enum face_id
CHILD_FRAME_BORDER_FACE_ID,
TAB_BAR_FACE_ID,
TAB_LINE_FACE_ID,
- MODE_LINE_FACE_ID,
BASIC_FACE_ID_SENTINEL
};
@@ -2731,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;
@@ -3074,12 +3085,15 @@ struct image
XFORM xform;
#endif
#ifdef HAVE_HAIKU
- /* Non-zero if the image has not yet been transformed for display. */
- int have_be_transforms_p;
+ /* 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;
- double be_rotate;
- double be_scale_x;
- double be_scale_y;
+ /* 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. */
@@ -3396,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;
@@ -3452,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);
@@ -3480,6 +3499,9 @@ bool update_window_fringes (struct window *, bool);
void gui_init_fringe (struct redisplay_interface *);
+extern int max_used_fringe_bitmap;
+void gui_define_fringe_bitmap (struct frame *, int);
+
#ifdef HAVE_NTGUI
void w32_reset_fringes (void);
#endif
@@ -3488,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
@@ -3599,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
diff --git a/src/dispnew.c b/src/dispnew.c
index 178d5caffb2..53a47c4b2f2 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -1837,7 +1837,18 @@ adjust_frame_glyphs (struct frame *f)
if (FRAME_WINDOW_P (f))
adjust_frame_glyphs_for_window_redisplay (f);
else
- adjust_frame_glyphs_for_frame_redisplay (f);
+ {
+ adjust_frame_glyphs_for_frame_redisplay (f);
+ eassert (FRAME_INITIAL_P (f)
+ || noninteractive
+ || !initialized
+ || (f->current_matrix
+ && f->current_matrix->nrows > 0
+ && f->current_matrix->rows
+ && f->desired_matrix
+ && f->desired_matrix->nrows > 0
+ && f->desired_matrix->rows));
+ }
/* Don't forget the buffer for decode_mode_spec. */
adjust_decode_mode_spec_buffer (f);
@@ -2119,6 +2130,19 @@ adjust_frame_glyphs_for_frame_redisplay (struct frame *f)
SET_FRAME_GARBAGED (f);
}
}
+ else if (!FRAME_INITIAL_P (f) && !noninteractive && initialized)
+ {
+ if (!f->desired_matrix->nrows || !f->desired_matrix->rows)
+ {
+ adjust_glyph_matrix (NULL, f->desired_matrix, 0, 0, matrix_dim);
+ SET_FRAME_GARBAGED (f);
+ }
+ if (!f->current_matrix->nrows || !f->current_matrix->rows)
+ {
+ adjust_glyph_matrix (NULL, f->current_matrix, 0, 0, matrix_dim);
+ SET_FRAME_GARBAGED (f);
+ }
+ }
}
@@ -2708,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);
@@ -3907,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);
@@ -3928,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);
@@ -4009,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
@@ -4080,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])
{
@@ -4155,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
@@ -4179,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)
@@ -4208,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;
}
@@ -4230,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;
@@ -4388,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.
@@ -4434,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
@@ -4463,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. */
@@ -4877,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;
@@ -6176,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);
@@ -6237,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;
@@ -6252,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;
@@ -6662,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'
@@ -6675,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'
@@ -6715,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 0b12eb154d6..34b80d03aa9 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -83,7 +83,7 @@ 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;
@@ -341,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))
{
@@ -448,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. */
@@ -514,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)
@@ -545,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
@@ -569,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 ***/
@@ -612,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
@@ -678,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,
diff --git a/src/dynlib.c b/src/dynlib.c
index 8cb9a233745..e2c71f14489 100644
--- a/src/dynlib.c
+++ b/src/dynlib.c
@@ -279,11 +279,13 @@ 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)
@@ -313,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 ac3d8e58ab3..03b8f983564 100644
--- a/src/dynlib.h
+++ b/src/dynlib.h
@@ -20,6 +20,7 @@ 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;
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.c b/src/emacs.c
index f6e2c01ee74..3c768412818 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -140,6 +140,10 @@ extern char etext;
#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;
@@ -155,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;
@@ -190,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
@@ -222,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;
@@ -284,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\
",
@@ -420,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);
@@ -453,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, "/:");
@@ -703,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
@@ -739,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;
@@ -830,7 +817,36 @@ 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";
@@ -879,7 +895,7 @@ load_pdump (int argc, char **argv)
#ifndef NS_SELF_CONTAINED
ptrdiff_t exec_bufsize;
#endif
- emacs_executable = load_pdump_find_executable (argv[0], &bufsize);
+ emacs_executable = find_emacs_executable (argv[0], &bufsize);
#ifndef NS_SELF_CONTAINED
exec_bufsize = bufsize;
#endif
@@ -896,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
@@ -959,20 +975,24 @@ load_pdump (int argc, char **argv)
sprintf (dump_file, "%s%c%s-%s%s",
path_exec, DIRECTORY_SEP, argv0_base, hexbuf, suffix);
#if !defined (NS_SELF_CONTAINED)
- /* Assume the Emacs binary lives in a sibling directory as set up by
- the default installation configuration. */
- const char *go_up = "../../../../bin/";
- needed += (strip_suffix ? strlen (strip_suffix) : 0)
- - strlen (suffix) + strlen (go_up);
- if (exec_bufsize < needed)
+ if (!(emacs_executable && *emacs_executable))
{
- xfree (emacs_executable);
- emacs_executable = xpalloc (NULL, &exec_bufsize, needed - exec_bufsize,
- -1, 1);
+ /* If we didn't find the Emacs binary, assume that it lives in a
+ sibling directory as set up by the default installation
+ configuration. */
+ const char *go_up = "../../../../bin/";
+ needed += (strip_suffix ? strlen (strip_suffix) : 0)
+ - strlen (suffix) + strlen (go_up);
+ if (exec_bufsize < needed)
+ {
+ xfree (emacs_executable);
+ emacs_executable = xpalloc (NULL, &exec_bufsize,
+ needed - exec_bufsize, -1, 1);
+ }
+ sprintf (emacs_executable, "%s%c%s%s%s",
+ path_exec, DIRECTORY_SEP, go_up, argv0_base,
+ strip_suffix ? strip_suffix : "");
}
- sprintf (emacs_executable, "%s%c%s%s%s",
- path_exec, DIRECTORY_SEP, go_up, argv0_base,
- strip_suffix ? strip_suffix : "");
#endif
result = pdumper_load (dump_file, emacs_executable);
@@ -1021,7 +1041,8 @@ load_pdump (int argc, char **argv)
out:
xfree (dump_file);
- xfree (emacs_executable);
+
+ return emacs_executable;
}
#endif /* HAVE_PDUMPER */
@@ -1312,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
@@ -1334,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);
@@ -1384,7 +1409,7 @@ main (int argc, char **argv)
related to the GUI system, like -font, -geometry, and -title, and
then processes the rest of arguments whose priority is below
those that are related to the GUI system. The arguments
- porcessed by 'command-line' are removed from 'command-line-args';
+ processed by 'command-line' are removed from 'command-line-args';
the arguments processed by 'command-line-1' aren't, they are only
removed from 'command-line-args-left'.
@@ -1394,54 +1419,19 @@ 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))
- {
- 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);
- }
- }
- 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);
- }
+ only_version = true;
#ifdef HAVE_PDUMPER
if (argmatch (argv, argc, "-fingerprint", "--fingerprint", 4,
- NULL, &skip_args))
+ NULL, &skip_args)
+ && !only_version)
{
if (initialized)
{
@@ -1458,12 +1448,16 @@ main (int argc, char **argv)
#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,
@@ -1589,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))
@@ -1627,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;
@@ -1644,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]);
@@ -1665,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))
+ if (!only_version)
{
- 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 (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
@@ -1727,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)
{
@@ -1914,16 +1930,9 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
init_bignum ();
init_threads ();
init_eval ();
-#ifdef HAVE_PGTK
- init_pgtkterm (); /* before init_atimer(). */
-#endif
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 ();
@@ -1932,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);
@@ -1945,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);
@@ -1993,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;
@@ -2029,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;
}
@@ -2125,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 ();
@@ -2328,11 +2418,11 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
#if defined WINDOWSNT || defined HAVE_NTGUI
globals_of_w32select ();
#endif
+ }
#ifdef HAVE_HAIKU
- init_haiku_select ();
+ init_haiku_select ();
#endif
- }
init_charset ();
@@ -2470,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 },
@@ -2719,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. */
@@ -2780,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
@@ -2810,9 +2936,6 @@ shut_down_emacs (int sig, Lisp_Object stuff)
/* Don't update display from now on. */
Vinhibit_redisplay = Qt;
-#ifdef HAVE_HAIKU
- be_app_quit ();
-#endif
/* If we are controlling the terminal, reset terminal modes. */
#ifndef DOS_NT
pid_t tpgrp = tcgetpgrp (STDIN_FILENO);
@@ -2867,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
@@ -2900,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 ();
@@ -3073,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 (".");
@@ -3100,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;
@@ -3202,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);
}
diff --git a/src/emacsgtkfixed.c b/src/emacsgtkfixed.c
index da56031e2a4..f2c9fa7b7db 100644
--- a/src/emacsgtkfixed.c
+++ b/src/emacsgtkfixed.c
@@ -164,15 +164,33 @@ XSetWMSizeHints (Display *d,
if ((hints->flags & PMinSize) && f)
{
-#ifdef HAVE_PGTK
- int w = f->output_data.pgtk->size_hints.min_width;
- int h = f->output_data.pgtk->size_hints.min_height;
-#else
- int w = f->output_data.x->size_hints.min_width;
- int h = f->output_data.x->size_hints.min_height;
-#endif
- 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,
diff --git a/src/eval.c b/src/eval.c
index 5514583b6a1..141d2546f08 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -65,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
@@ -104,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);
@@ -138,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
@@ -237,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
@@ -281,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
@@ -303,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--;
@@ -354,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));
}
@@ -574,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))));
}
@@ -677,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;
@@ -720,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;
@@ -750,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);
}
@@ -784,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))
@@ -797,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
@@ -811,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.
@@ -827,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);
@@ -839,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))
@@ -875,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
@@ -904,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? */
@@ -936,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;
@@ -996,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;
@@ -1100,7 +1085,7 @@ If FUNCTION takes less time to execute than TIMEOUT seconds, MESSAGE
is not displayed. */)
(Lisp_Object timeout, Lisp_Object message, Lisp_Object function)
{
- ptrdiff_t count = SPECPDL_INDEX ();
+ specpdl_ref count = SPECPDL_INDEX ();
CHECK_NUMBER (timeout);
CHECK_STRING (message);
@@ -1266,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
@@ -1280,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);
}
@@ -1313,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));
@@ -1383,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
@@ -1437,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));
}
@@ -1458,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));
}
@@ -1547,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. */
@@ -1720,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;
}
@@ -1738,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 ();
@@ -1831,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);
}
@@ -1893,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 (Vdebugger, 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);
}
@@ -2167,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;
@@ -2176,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;
}
@@ -2256,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
@@ -2267,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). */
@@ -2301,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;
@@ -2314,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;
@@ -2363,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
@@ -2450,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);
@@ -2458,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)
@@ -2507,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--;
@@ -2529,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)
{
@@ -2601,7 +2522,7 @@ 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
@@ -2633,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--;
@@ -2849,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))
{
@@ -2924,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))
@@ -3034,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;
@@ -3114,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;
@@ -3223,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--;
@@ -3245,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;
@@ -3270,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
@@ -3366,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);
}
@@ -3517,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));
}
@@ -3607,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:
@@ -3619,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)
{
@@ -3637,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. */
@@ -3682,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 ();
}
@@ -3725,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)
@@ -3777,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:
@@ -3841,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;
}
@@ -3853,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;
@@ -3864,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
@@ -3902,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
@@ -4073,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. */
@@ -4095,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;
@@ -4103,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;
@@ -4110,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,
@@ -4143,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:
@@ -4159,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);
@@ -4247,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;
}
}
}
@@ -4320,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 ();
}
@@ -4422,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.
@@ -4468,6 +4284,7 @@ might not be safe to continue. */);
doc: /* Non-nil means display call stack frames as lists. */);
debugger_stack_frame_as_list = 0;
+ DEFSYM (Qdebugger, "debugger");
DEFVAR_LISP ("debugger", Vdebugger,
doc: /* Function to call to invoke debugger.
If due to frame exit, args are `exit' and the value being returned;
@@ -4475,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.
@@ -4557,9 +4374,11 @@ 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);
diff --git a/src/fileio.c b/src/fileio.c
index 9c50cbb35a6..9697f6c8cf1 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -708,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)
{
@@ -2165,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;
@@ -2416,7 +2416,7 @@ permissions. */)
#endif /* not WINDOWSNT */
/* Discard the unwind protects. */
- specpdl_ptr = specpdl + count;
+ specpdl_ptr = specpdl_ref_to_ptr (count);
return Qnil;
}
@@ -2505,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)
{
@@ -2523,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. */
@@ -2597,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;
}
@@ -2714,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);
@@ -3514,8 +3532,9 @@ DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 3,
Only the 12 low bits of MODE are used. If optional FLAG is `nofollow',
do not follow FILENAME if it is a symbolic link.
-Interactively, mode bits are read by `read-file-modes', which accepts
-symbolic notation, like the `chmod' command from GNU Coreutils. */)
+Interactively, prompt for FILENAME, and read MODE with
+`read-file-modes', which accepts symbolic notation, like the `chmod'
+command from GNU Coreutils. */)
(Lisp_Object filename, Lisp_Object mode, Lisp_Object flag)
{
CHECK_FIXNUM (mode);
@@ -3880,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
@@ -3903,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;
@@ -3922,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. */
@@ -3931,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");
@@ -3984,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. */
@@ -4004,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))
{
@@ -4012,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);
}
@@ -4034,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
{
@@ -4056,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. */
@@ -4094,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.
@@ -4327,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. */
@@ -4398,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;
@@ -4556,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. */
@@ -4602,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;
@@ -4653,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;
}
@@ -4704,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);
@@ -4831,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);
}
@@ -4855,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);
@@ -5186,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;
@@ -5390,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
@@ -5520,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
@@ -5800,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.
@@ -5809,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,
@@ -5839,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;
@@ -5952,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)
{
@@ -5969,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;
diff --git a/src/filelock.c b/src/filelock.c
index a213c2b3cae..a657cc4582c 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -413,14 +413,20 @@ create_lock_file (char *lfname, char *lock_info_str, bool force)
Return 0 if successful, an error number on failure. */
static int
-lock_file_1 (char *lfname, bool force)
+lock_file_1 (Lisp_Object lfname, bool force)
{
- /* Call this first because it can GC. */
intmax_t boot = get_boot_time ();
-
Lisp_Object luser_name = Fuser_login_name (Qnil);
- char const *user_name = STRINGP (luser_name) ? SSDATA (luser_name) : "";
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];
intmax_t pid = getpid ();
@@ -439,7 +445,7 @@ lock_file_1 (char *lfname, bool force)
user_name, host_name, pid))
return ENAMETOOLONG;
- return create_lock_file (lfname, lock_info_str, force);
+ return create_lock_file (SSDATA (lfname), lock_info_str, force);
}
/* Return true if times A and B are no more than one second apart. */
@@ -490,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, char *lfname)
+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;
@@ -510,7 +530,7 @@ current_lock_owner (lock_info_type *owner, char *lfname)
owner = &local_owner;
/* If nonexistent lock file, all is well; otherwise, got strange error. */
- lfinfolen = read_lock_data (lfname, owner->user);
+ lfinfolen = read_lock_data (SSDATA (lfname), owner->user);
if (lfinfolen < 0)
return errno == ENOENT || errno == ENOTDIR ? 0 : errno;
if (MAX_LFINFO < lfinfolen)
@@ -564,65 +584,78 @@ current_lock_owner (lock_info_type *owner, char *lfname)
if (lfinfo_end != owner->user + lfinfolen)
return EINVAL;
- /* On current host? */
Lisp_Object system_name = Fsystem_name ();
+ /* If `system-name' returns nil, that means we're in a
+ --no-build-details Emacs, and the name part of the link (e.g.,
+ .#test.txt -> larsi@.118961:1646577954) is an empty string. */
+ if (NILP (system_name))
+ system_name = build_string ("");
+ /* 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
- return unlink (lfname) < 0 ? errno : 0;
+ return unlink (SSDATA (lfname)) < 0 ? errno : 0;
}
else
{ /* If we wanted to support the check for stale locks on remote machines,
here's where we'd do it. */
- ret = -1;
+ return ANOTHER_OWNS_IT;
}
-
- return ret;
}
/* Lock the lock named LFNAME if possible.
Return 0 in that case.
- Return negative if some other process owns the lock, and info about
+ Return ANOTHER_OWNS_IT if some other process owns the lock, and info about
that process in CLASHER.
- Return positive errno value if cannot lock for any other reason. */
+ Return errno value if cannot lock for any other reason. */
static int
-lock_if_free (lock_info_type *clasher, char *lfname)
+lock_if_free (lock_info_type *clasher, Lisp_Object lfname)
{
int err;
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;
}
+/* Return the encoded name of the lock file for FN, or nil if none. */
+
static Lisp_Object
make_lock_file_name (Lisp_Object fn)
{
- return call1 (Qmake_lock_file_name, Fexpand_file_name (fn, Qnil));
+ Lisp_Object lock_file_name = call1 (Qmake_lock_file_name,
+ Fexpand_file_name (fn, Qnil));
+ return !NILP (lock_file_name) ? ENCODE_FILE (lock_file_name) : Qnil;
}
/* lock_file locks file FN,
@@ -654,47 +687,46 @@ lock_file (Lisp_Object fn)
if (will_dump_p ())
return Qnil;
- /* If the file name has special constructs in it,
- call the corresponding file name handler. */
- Lisp_Object handler;
- handler = Ffind_file_name_handler (fn, Qlock_file);
- if (!NILP (handler))
+ Lisp_Object lfname = Qnil;
+ if (create_lockfiles)
{
- return call2 (handler, Qlock_file, fn);
+ /* Create the name of the lock-file for file fn */
+ lfname = make_lock_file_name (fn);
+ if (NILP (lfname))
+ return Qnil;
}
- Lisp_Object lock_filename = make_lock_file_name (fn);
- if (NILP (lock_filename))
- return Qnil;
- char *lfname = SSDATA (ENCODE_FILE (lock_filename));
-
/* See if this file is visited and has changed on disk since it was
visited. */
Lisp_Object subject_buf = get_truename_buffer (fn);
if (!NILP (subject_buf)
&& NILP (Fverify_visited_file_modtime (subject_buf))
&& !NILP (Ffile_exists_p (fn))
- && 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);
- /* 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)
+ /* Don't do locking if the user has opted out. */
+ if (!NILP (lfname))
{
- /* Someone else has the lock. Consider breaking it. */
- Lisp_Object attack;
- char *dot = lock_info.dot;
- ptrdiff_t pidlen = lock_info.colon - (dot + 1);
- static char const replacement[] = " (pid ";
- int replacementlen = sizeof replacement - 1;
- memmove (dot + replacementlen, dot + 1, pidlen);
- strcpy (dot + replacementlen + pidlen, ")");
- memcpy (dot, replacement, replacementlen);
- attack = call2 (intern ("ask-user-about-lock"), fn,
- build_string (lock_info.user));
- /* Take the lock if the user said so. */
- if (!NILP (attack))
- lock_file_1 (lfname, 1);
+ /* Try to lock the lock. FIXME: This ignores errors when
+ 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;
+ char *dot = lock_info.dot;
+ ptrdiff_t pidlen = lock_info.colon - (dot + 1);
+ static char const replacement[] = " (pid ";
+ int replacementlen = sizeof replacement - 1;
+ memmove (dot + replacementlen, dot + 1, pidlen);
+ strcpy (dot + replacementlen + pidlen, ")");
+ memcpy (dot, replacement, replacementlen);
+ attack = call2 (intern ("ask-user-about-lock"), fn,
+ build_string (lock_info.user));
+ /* Take the lock if the user said so. */
+ if (!NILP (attack))
+ lock_file_1 (lfname, 1);
+ }
}
return Qnil;
}
@@ -702,17 +734,14 @@ lock_file (Lisp_Object fn)
static Lisp_Object
unlock_file (Lisp_Object fn)
{
- char *lfname;
-
- Lisp_Object lock_filename = make_lock_file_name (fn);
- if (NILP (lock_filename))
+ Lisp_Object lfname = make_lock_file_name (fn);
+ if (NILP (lfname))
return Qnil;
- lfname = SSDATA (ENCODE_FILE (lock_filename));
int err = current_lock_owner (0, lfname);
- if (err == -2 && unlink (lfname) != 0 && errno != ENOENT)
- err = errno;
- if (0 < err)
+ if (! (err == 0 || err == ANOTHER_OWNS_IT
+ || (err == I_OWN_IT
+ && (unlink (SSDATA (lfname)) == 0 || (err = errno) == ENOENT))))
report_file_errno ("Unlocking file", fn, err);
return Qnil;
@@ -748,12 +777,16 @@ If the option `create-lockfiles' is nil, this does nothing. */)
(Lisp_Object file)
{
#ifndef MSDOS
- /* Don't do locking if the user has opted out. */
- if (create_lockfiles)
- {
- CHECK_STRING (file);
- lock_file (file);
- }
+ CHECK_STRING (file);
+
+ /* If the file name has special constructs in it,
+ call the corresponding file name handler. */
+ Lisp_Object handler;
+ handler = Ffind_file_name_handler (file, Qlock_file);
+ if (!NILP (handler))
+ return call2 (handler, Qlock_file, file);
+
+ lock_file (file);
#endif /* MSDOS */
return Qnil;
}
@@ -850,16 +883,17 @@ t if it is locked by you, else a string saying which user has locked it. */)
return call2 (handler, Qfile_locked_p, filename);
}
- Lisp_Object lock_filename = make_lock_file_name (filename);
- if (NILP (lock_filename))
+ Lisp_Object lfname = make_lock_file_name (filename);
+ if (NILP (lfname))
return Qnil;
- char *lfname = SSDATA (ENCODE_FILE (lock_filename));
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);
}
@@ -877,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 f2b3b13acd8..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>
diff --git a/src/fns.c b/src/fns.c
index 86c49e6fc6b..61ed01eee4e 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -39,9 +39,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "puresize.h"
#include "gnutls.h"
-static void sort_vector_copy (Lisp_Object pred, ptrdiff_t len,
- Lisp_Object src[restrict VLA_ELEMS (len)],
- Lisp_Object dest[restrict VLA_ELEMS (len)]);
enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES };
static bool internal_equal (Lisp_Object, Lisp_Object,
enum equal_kind, int, Lisp_Object);
@@ -55,49 +52,24 @@ DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
return argument;
}
+/* Return a random Lisp fixnum I in the range 0 <= I < LIM,
+ where LIM is taken from a positive fixnum. */
static Lisp_Object
-ccall2 (Lisp_Object (f) (ptrdiff_t nargs, Lisp_Object *args),
- Lisp_Object arg1, Lisp_Object arg2)
+get_random_fixnum (EMACS_INT lim)
{
- Lisp_Object args[2] = {arg1, arg2};
- return f (2, args);
-}
-
-static Lisp_Object
-get_random_bignum (Lisp_Object limit)
-{
- /* This is a naive transcription into bignums of the fixnum algorithm.
- I'd be quite surprised if that's anywhere near the best algorithm
- for it. */
- while (true)
+ /* Return the remainder of a random integer R (in range 0..INTMASK)
+ divided by LIM, except reject the rare case where R is so close
+ to INTMASK that the remainder isn't random. */
+ EMACS_INT difflim = INTMASK - lim + 1, diff, remainder;
+ do
{
- Lisp_Object val = make_fixnum (0);
- Lisp_Object lim = limit;
- int bits = 0;
- int bitsperiteration = FIXNUM_BITS - 1;
- do
- {
- /* Shift by one so it is a valid positive fixnum. */
- EMACS_INT rand = get_random () >> 1;
- Lisp_Object lrand = make_fixnum (rand);
- bits += bitsperiteration;
- val = ccall2 (Flogior,
- Fash (val, make_fixnum (bitsperiteration)),
- lrand);
- lim = Fash (lim, make_fixnum (- bitsperiteration));
- }
- while (!EQ (lim, make_fixnum (0)));
- /* Return the remainder, except reject the rare case where
- get_random returns a number so close to INTMASK that the
- remainder isn't random. */
- Lisp_Object remainder = Frem (val, limit);
- if (!NILP (ccall2 (Fleq,
- ccall2 (Fminus, val, remainder),
- ccall2 (Fminus,
- Fash (make_fixnum (1), make_fixnum (bits)),
- limit))))
- return remainder;
+ EMACS_INT r = get_random ();
+ remainder = r % lim;
+ diff = r - remainder;
}
+ while (difflim < diff);
+
+ return make_fixnum (remainder);
}
DEFUN ("random", Frandom, Srandom, 0, 1, 0,
@@ -111,32 +83,26 @@ With a string argument, set the seed based on the string's contents.
See Info node `(elisp)Random Numbers' for more details. */)
(Lisp_Object limit)
{
- EMACS_INT val;
-
if (EQ (limit, Qt))
init_random ();
else if (STRINGP (limit))
seed_random (SSDATA (limit), SBYTES (limit));
- if (BIGNUMP (limit))
+ else if (FIXNUMP (limit))
{
- if (0 > mpz_sgn (*xbignum_val (limit)))
- xsignal2 (Qwrong_type_argument, Qnatnump, limit);
- return get_random_bignum (limit);
+ EMACS_INT lim = XFIXNUM (limit);
+ if (lim <= 0)
+ xsignal1 (Qargs_out_of_range, limit);
+ return get_random_fixnum (lim);
+ }
+ else if (BIGNUMP (limit))
+ {
+ struct Lisp_Bignum *lim = XBIGNUM (limit);
+ if (mpz_sgn (*bignum_val (lim)) <= 0)
+ xsignal1 (Qargs_out_of_range, limit);
+ return get_random_bignum (lim);
}
- val = get_random ();
- if (FIXNUMP (limit) && 0 < XFIXNUM (limit))
- while (true)
- {
- /* Return the remainder, except reject the rare case where
- get_random returns a number so close to INTMASK that the
- remainder isn't random. */
- EMACS_INT remainder = val % XFIXNUM (limit);
- if (val - remainder <= INTMASK - XFIXNUM (limit) + 1)
- return make_fixnum (remainder);
- val = get_random ();
- }
- return make_ufixnum (val);
+ return make_ufixnum (get_random ());
}
/* Random data-structure functions. */
@@ -475,15 +441,24 @@ Symbols are also allowed; their print names are used instead. */)
{
if (SYMBOLP (string1))
string1 = SYMBOL_NAME (string1);
+ else
+ CHECK_STRING (string1);
if (SYMBOLP (string2))
string2 = SYMBOL_NAME (string2);
- CHECK_STRING (string1);
- CHECK_STRING (string2);
+ else
+ CHECK_STRING (string2);
+
+ ptrdiff_t n = min (SCHARS (string1), SCHARS (string2));
+ if (!STRING_MULTIBYTE (string1) && !STRING_MULTIBYTE (string2))
+ {
+ /* Both arguments are unibyte (hot path). */
+ int d = memcmp (SSDATA (string1), SSDATA (string2), n);
+ return d < 0 || (d == 0 && n < SCHARS (string2)) ? Qt : Qnil;
+ }
ptrdiff_t i1 = 0, i1_byte = 0, i2 = 0, i2_byte = 0;
- ptrdiff_t end = min (SCHARS (string1), SCHARS (string2));
- while (i1 < end)
+ while (i1 < n)
{
/* When we find a mismatch, we must compare the
characters, not just the bytes. */
@@ -516,37 +491,9 @@ Symbols are also allowed; their print names are used instead. */)
string2 = SYMBOL_NAME (string2);
CHECK_STRING (string1);
CHECK_STRING (string2);
- return string_version_cmp (string1, string2) < 0 ? Qt : Qnil;
-}
-
-/* Return negative, 0, positive if STRING1 is <, =, > STRING2 as per
- string-version-lessp. */
-int
-string_version_cmp (Lisp_Object string1, Lisp_Object string2)
-{
- char *p1 = SSDATA (string1);
- char *p2 = SSDATA (string2);
- char *lim1 = p1 + SBYTES (string1);
- char *lim2 = p2 + SBYTES (string2);
- int cmp;
-
- while ((cmp = filevercmp (p1, p2)) == 0)
- {
- /* If the strings are identical through their first null bytes,
- skip past identical prefixes and try again. */
- ptrdiff_t size = strlen (p1) + 1;
- eassert (size == strlen (p2) + 1);
- p1 += size;
- p2 += size;
- bool more1 = p1 <= lim1;
- bool more2 = p2 <= lim2;
- if (!more1)
- return more2;
- if (!more2)
- return -1;
- }
-
- return cmp;
+ int cmp = filenvercmp (SSDATA (string1), SBYTES (string1),
+ SSDATA (string2), SBYTES (string2));
+ return cmp < 0 ? Qt : Qnil;
}
DEFUN ("string-collate-lessp", Fstring_collate_lessp, Sstring_collate_lessp, 2, 4, 0,
@@ -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,371 @@ 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 += copy_text (SDATA (arg),
+ SDATA (result) + toindex_byte,
+ nchars, 0, 1);
}
- toindex_byte += thislen_byte;
- toindex += thisleni;
+ toindex += nchars;
}
- /* Copy a single-byte string to a multibyte string. */
- else if (STRINGP (this) && STRINGP (val))
+ else if (VECTORP (arg))
{
- if (string_intervals (this))
+ ptrdiff_t len = ASIZE (arg);
+ for (ptrdiff_t j = 0; j < len; j++)
{
- textprops[num_textprops].argnum = argnum;
- textprops[num_textprops].from = 0;
- textprops[num_textprops++].to = toindex;
+ int c = XFIXNAT (AREF (arg, j));
+ if (dest_multibyte)
+ toindex_byte += CHAR_STRING (c, SDATA (result) + toindex_byte);
+ else
+ SSET (result, toindex_byte++, c);
+ toindex++;
}
- toindex_byte += copy_text (SDATA (this),
- SDATA (val) + toindex_byte,
- SCHARS (this), 0, 1);
- toindex += thisleni;
}
else
- /* Copy element by element. */
- while (1)
+ for (Lisp_Object tail = arg; !NILP (tail); tail = XCDR (tail))
{
- register Lisp_Object elt;
-
- /* Fetch next element of `this' arg into `elt', or break if
- `this' is exhausted. */
- if (NILP (this)) break;
- if (CONSP (this))
- elt = XCAR (this), this = XCDR (this);
- else if (thisindex >= thisleni)
- break;
- else if (STRINGP (this))
- {
- int c;
- if (STRING_MULTIBYTE (this))
- c = fetch_string_char_advance_no_check (this, &thisindex,
- &thisindex_byte);
- else
- {
- c = SREF (this, thisindex); thisindex++;
- if (some_multibyte && !ASCII_CHAR_P (c))
- c = BYTE8_TO_CHAR (c);
- }
- XSETFASTINT (elt, c);
- }
- else if (BOOL_VECTOR_P (this))
- {
- elt = bool_vector_ref (this, thisindex);
- thisindex++;
- }
+ int c = XFIXNAT (XCAR (tail));
+ if (dest_multibyte)
+ toindex_byte += CHAR_STRING (c, SDATA (result) + toindex_byte);
else
- {
- elt = AREF (this, thisindex);
- thisindex++;
- }
-
- /* Store this element into the result. */
- if (toindex < 0)
- {
- XSETCAR (tail, elt);
- prev = tail;
- tail = XCDR (tail);
- }
- else if (VECTORP (val))
- {
- ASET (val, toindex, elt);
- toindex++;
- }
- else
- {
- int c;
- CHECK_CHARACTER (elt);
- c = XFIXNAT (elt);
- if (some_multibyte)
- toindex_byte += CHAR_STRING (c, SDATA (val) + toindex_byte);
- else
- SSET (val, toindex_byte++, c);
- toindex++;
- }
+ SSET (result, toindex_byte++, c);
+ toindex++;
}
}
- if (!NILP (prev))
- XSETCDR (prev, last_tail);
if (num_textprops > 0)
{
- Lisp_Object props;
ptrdiff_t last_to_end = -1;
-
- for (argnum = 0; argnum < num_textprops; argnum++)
+ for (ptrdiff_t i = 0; i < num_textprops; i++)
{
- this = args[textprops[argnum].argnum];
- props = text_property_list (this,
- make_fixnum (0),
- make_fixnum (SCHARS (this)),
- Qnil);
+ Lisp_Object arg = args[textprops[i].argnum];
+ Lisp_Object props = text_property_list (arg,
+ make_fixnum (0),
+ make_fixnum (SCHARS (arg)),
+ Qnil);
/* If successive arguments have properties, be sure that the
value of `composition' property be the copy. */
- if (last_to_end == textprops[argnum].to)
+ if (last_to_end == textprops[i].to)
make_composition_value_copy (props);
- add_text_properties_from_list (val, props,
- make_fixnum (textprops[argnum].to));
- last_to_end = textprops[argnum].to + SCHARS (this);
+ add_text_properties_from_list (result, props,
+ make_fixnum (textprops[i].to));
+ last_to_end = textprops[i].to + SCHARS (arg);
}
}
SAFE_FREE ();
- return val;
+ return result;
+}
+
+/* Concatenate sequences into a list. */
+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 +1096,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 +1156,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)
{
@@ -1353,19 +1413,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 +1445,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 +1632,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 +2070,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 +2169,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 +2181,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 +2263,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 +2332,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 +2360,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 +2429,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 +2438,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 +2448,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 +2563,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 +2808,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,17 +2845,14 @@ 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);
}
}
@@ -2881,12 +2885,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 ();
@@ -2965,6 +2975,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)
@@ -2991,7 +3004,7 @@ if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil. */)
AUTO_STRING (yes_or_no, "(yes or no) ");
prompt = CALLN (Fconcat, prompt, yes_or_no);
- ptrdiff_t count = SPECPDL_INDEX ();
+ specpdl_ref count = SPECPDL_INDEX ();
specbind (Qenable_recursive_minibuffers, Qt);
while (1)
@@ -3105,25 +3118,25 @@ require_unwind (Lisp_Object old_value)
}
DEFUN ("require", Frequire, Srequire, 1, 3, 0,
- doc: /* If feature FEATURE is not loaded, load it from FILENAME.
-If FEATURE is not a member of the list `features', then the feature is
-not loaded; so load the file FILENAME.
+ doc: /* If FEATURE is not already loaded, load it from FILENAME.
+If FEATURE is not a member of the list `features', then the feature was
+not yet loaded; so load it from file FILENAME.
If FILENAME is omitted, the printname of FEATURE is used as the file
-name, and `load' will try to load this name appended with the suffix
-`.elc', `.el', or the system-dependent suffix for dynamic module
-files, in that order. The name without appended suffix will not be
-used. See `get-load-suffixes' for the complete list of suffixes.
+name, and `load' is called to try to load the file by that name, after
+appending the suffix `.elc', `.el', or the system-dependent suffix for
+dynamic module files, in that order; but the function will not try to
+load the file without any suffix. See `get-load-suffixes' for the
+complete list of suffixes.
-The directories in `load-path' are searched when trying to find the
-file name.
+To find the file, this function searches the directories in `load-path'.
-If the optional third argument NOERROR is non-nil, then return nil if
-the file is not found instead of signaling an error. Normally the
-return value is FEATURE.
+If the optional third argument NOERROR is non-nil, then, if
+the file is not found, the function returns nil instead of signaling
+an error. Normally the return value is FEATURE.
-The normal messages at start and end of loading FILENAME are
-suppressed. */)
+The normal messages issued by `load' at start and end of loading
+FILENAME are suppressed. */)
(Lisp_Object feature, Lisp_Object filename, Lisp_Object noerror)
{
Lisp_Object tem;
@@ -3153,14 +3166,19 @@ 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,
@@ -3180,12 +3198,8 @@ 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));
@@ -3207,8 +3221,6 @@ suppressed. */)
SDATA (tem3), tem2);
}
- /* Once loading finishes, don't undo it. */
- Vautoload_queue = Qt;
feature = unbind_to (count, feature);
}
@@ -3222,22 +3234,25 @@ 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))
@@ -3247,13 +3262,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;
}
@@ -3270,7 +3294,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);
@@ -4160,13 +4184,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
@@ -4175,7 +4199,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
@@ -4185,7 +4209,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
@@ -4196,34 +4220,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
@@ -4479,7 +4504,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;
@@ -4529,7 +4555,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);
@@ -4916,6 +4942,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. */
@@ -4951,7 +4979,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)
@@ -4961,7 +4990,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)
@@ -5268,7 +5298,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));
}
@@ -5918,9 +5948,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);
}
@@ -6096,8 +6129,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);
diff --git a/src/font.c b/src/font.c
index 266e5bc75c6..3846cfc1079 100644
--- a/src/font.c
+++ b/src/font.c
@@ -731,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)))))
@@ -745,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;
}
@@ -2183,7 +2183,9 @@ font_score (Lisp_Object entity, Lisp_Object *spec_prop)
/* Score three style numeric fields. Maximum difference is 127. */
for (i = FONT_WEIGHT_INDEX; i <= FONT_WIDTH_INDEX; i++)
- if (! NILP (spec_prop[i]) && ! EQ (AREF (entity, i), spec_prop[i]))
+ if (! NILP (spec_prop[i])
+ && ! EQ (AREF (entity, i), spec_prop[i])
+ && FIXNUMP (AREF (entity, i)))
{
EMACS_INT diff = ((XFIXNUM (AREF (entity, i)) >> 8)
- (XFIXNUM (spec_prop[i]) >> 8));
@@ -2764,26 +2766,31 @@ font_delete_unmatched (Lisp_Object vec, Lisp_Object spec, int size)
{
if (FIXNUMP (AREF (spec, prop)))
{
- int required = XFIXNUM (AREF (spec, prop)) >> 8;
- int candidate = XFIXNUM (AREF (entity, prop)) >> 8;
+ 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
+ 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)
+ /* 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;
+ )
+ prop = FONT_SPEC_MAX;
+ }
}
}
if (prop < FONT_SPEC_MAX
@@ -3582,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)
@@ -4230,26 +4237,33 @@ merge_font_spec (Lisp_Object from, Lisp_Object to)
DEFUN ("font-get", Ffont_get, Sfont_get, 2, 2, 0,
doc: /* Return the value of FONT's property KEY.
FONT is a font-spec, a font-entity, or a font-object.
-KEY is any symbol, but these are reserved for specific meanings:
- :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
- :size, :name, :script, :otf
+KEY can be any symbol, but these are reserved for specific meanings:
+ :foundry, :family, :adstyle, :registry, :weight, :slant, :width,
+ :size, :dpi, :spacing, :avgwidth, :script, :lang, :otf
See the documentation of `font-spec' for their meanings.
-In addition, if FONT is a font-entity or a font-object, values of
-:script and :otf are different from those of a font-spec as below:
-The value of :script may be a list of scripts that are supported by the font.
+If FONT is a font-entity or a font-object, then values of
+:script and :otf properties are different from those of a font-spec
+as below:
-The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
-representing the OpenType features supported by the font by this form:
- ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
-SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
-Layout tags.
+ The value of :script may be a list of scripts that are supported by
+ the font.
+
+ The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are
+ lists representing the OpenType features supported by the font, of
+ this form: ((SCRIPT (LANGSYS FEATURE ...) ...) ...), where
+ SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
+ Layout tags. See `otf-script-alist' for the OpenType script tags.
In addition to the keys listed above, the following keys are reserved
for the specific meanings as below:
-The value of :combining-capability is non-nil if the font-backend of
-FONT supports rendering of combining characters for non-OTF fonts. */)
+ The value of :type is a symbol that identifies the font backend to be
+ used, such as `ftcrhb' or `xfthb' on X , `harfbuzz' or `uniscribe' on
+ MS-Windows, `ns' on Cocoa/GNUstep, etc.
+
+ The value of :combining-capability is non-nil if the font-backend of
+ FONT supports rendering of combining characters for non-OTF fonts. */)
(Lisp_Object font, Lisp_Object key)
{
int idx;
@@ -4377,7 +4391,9 @@ accepted by the function `font-spec' (which see), VAL must be what
allowed in `font-spec'.
If FONT is a font-entity or a font-object, KEY must not be the one
-accepted by `font-spec'. */)
+accepted by `font-spec'.
+
+See also `font-get' for KEYs that have special meanings. */)
(Lisp_Object font, Lisp_Object prop, Lisp_Object val)
{
int idx;
diff --git a/src/font.h b/src/font.h
index 424616a4a1e..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. */
diff --git a/src/fontset.c b/src/fontset.c
index eb563a69e2b..1793715450e 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -1450,28 +1450,30 @@ static void update_auto_fontset_alist (Lisp_Object, Lisp_Object);
DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0,
doc: /*
-Modify fontset NAME to use FONT-SPEC for TARGET characters.
+Modify FONTSET to use font specification in FONT-SPEC for displaying CHARACTERS.
-NAME is a fontset name (a string), nil for the fontset of FRAME,
-or t for the default fontset.
+FONTSET should be a fontset name (a string); or nil, meaning the
+fontset of FRAME; or t, meaning the default fontset.
-TARGET may be a single character to use FONT-SPEC for.
+CHARACTERS may be a single character to use FONT-SPEC for.
-TARGET may be a cons (FROM . TO), where FROM and TO are characters.
+CHARACTERS may be a cons (FROM . TO), where FROM and TO are characters.
In that case, use FONT-SPEC for all the characters in the range
between FROM and TO (inclusive).
-TARGET may be a script symbol. In that case, use FONT-SPEC for
+CHARACTERS may be a script symbol. In that case, use FONT-SPEC for
all the characters that belong to the script. See the variable
-`script-representative-chars' for the list of known scripts.
+`script-representative-chars' for the list of known scripts, and
+see the variable `char-script-table' for the script of any specific
+character.
-TARGET may be a charset. In that case, use FONT-SPEC for all
-the characters in the charset. See `list-character-sets' and
+CHARACTERS may be a charset symbol. In that case, use FONT-SPEC for
+all the characters in the charset. See `list-character-sets' and
`list-charset-chars' for the list of character sets and their
characters.
-TARGET may be nil. In that case, use FONT-SPEC for any character for
-which no font-spec is specified.
+CHARACTERS may be nil. In that case, use FONT-SPEC for any
+character for which no font-spec is specified in FONTSET.
FONT-SPEC may one of these:
* A font-spec object made by the function `font-spec' (which see).
@@ -1479,25 +1481,28 @@ FONT-SPEC may one of these:
REGISTRY is a font registry name. FAMILY may contain foundry
name, and REGISTRY may contain encoding name.
* A font name string.
- * nil, which explicitly specifies that there's no font for TARGET.
+ * nil, which explicitly specifies that there's no font for CHARACTERS.
-Optional 4th argument FRAME is a frame, or nil for the selected frame,
-to be considered in the case that NAME is nil.
+Optional 4th argument FRAME is a frame whose fontset should be modified;
+it is used if FONTSET is nil. If FONTSET is nil and FRAME is omitted
+or nil, that stands for the fontset of the selected frame.
Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
-to the previously set font specifications for TARGET. If it is
-`prepend', FONT-SPEC is prepended. If it is `append', FONT-SPEC is
-appended. By default, FONT-SPEC overrides the previous settings. */)
- (Lisp_Object name, Lisp_Object target, Lisp_Object font_spec, Lisp_Object frame, Lisp_Object add)
+to the previously set font specifications for CHARACTERS. If it is
+`prepend', FONT-SPEC is prepended to the existing font specifications.
+If it is `append', FONT-SPEC is appended. By default, FONT-SPEC
+overwrites the previous settings. */)
+ (Lisp_Object fontset, Lisp_Object characters, Lisp_Object font_spec,
+ Lisp_Object frame, Lisp_Object add)
{
- Lisp_Object fontset;
+ Lisp_Object fontset_obj;
Lisp_Object font_def, registry, family;
Lisp_Object range_list;
struct charset *charset = NULL;
Lisp_Object fontname;
bool ascii_changed = 0;
- fontset = check_fontset_name (name, &frame);
+ fontset_obj = check_fontset_name (fontset, &frame);
fontname = Qnil;
if (CONSP (font_spec))
@@ -1555,18 +1560,18 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
else
font_def = Qnil;
- if (CHARACTERP (target))
+ if (CHARACTERP (characters))
{
- if (XFIXNAT (target) < 0x80)
+ if (XFIXNAT (characters) < 0x80)
error ("Can't set a font for partial ASCII range");
- range_list = list1 (Fcons (target, target));
+ range_list = list1 (Fcons (characters, characters));
}
- else if (CONSP (target))
+ else if (CONSP (characters))
{
Lisp_Object from, to;
- from = Fcar (target);
- to = Fcdr (target);
+ from = Fcar (characters);
+ to = Fcdr (characters);
CHECK_CHARACTER (from);
CHECK_CHARACTER (to);
if (XFIXNAT (from) < 0x80)
@@ -1575,38 +1580,38 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
error ("Can't set a font for partial ASCII range");
ascii_changed = 1;
}
- range_list = list1 (target);
+ range_list = list1 (characters);
}
- else if (SYMBOLP (target) && !NILP (target))
+ else if (SYMBOLP (characters) && !NILP (characters))
{
Lisp_Object script_list;
Lisp_Object val;
range_list = Qnil;
script_list = XCHAR_TABLE (Vchar_script_table)->extras[0];
- if (! NILP (Fmemq (target, script_list)))
+ if (! NILP (Fmemq (characters, script_list)))
{
- if (EQ (target, Qlatin))
+ if (EQ (characters, Qlatin))
ascii_changed = 1;
- val = list1 (target);
+ val = list1 (characters);
map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table,
val);
range_list = Fnreverse (XCDR (val));
}
- if (CHARSETP (target))
+ if (CHARSETP (characters))
{
- CHECK_CHARSET_GET_CHARSET (target, charset);
+ CHECK_CHARSET_GET_CHARSET (characters, charset);
if (charset->ascii_compatible_p)
ascii_changed = 1;
}
else if (NILP (range_list))
error ("Invalid script or charset name: %s",
- SDATA (SYMBOL_NAME (target)));
+ SDATA (SYMBOL_NAME (characters)));
}
- else if (NILP (target))
+ else if (NILP (characters))
range_list = list1 (Qnil);
else
- error ("Invalid target for setting a font");
+ error ("Invalid second argument for setting a font in a fontset");
if (ascii_changed)
{
@@ -1614,7 +1619,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
if (NILP (font_spec))
error ("Can't set ASCII font to nil");
- val = CHAR_TABLE_REF (fontset, 0);
+ val = CHAR_TABLE_REF (fontset_obj, 0);
if (! NILP (val) && EQ (add, Qappend))
/* We are going to change just an additional font for ASCII. */
ascii_changed = 0;
@@ -1622,7 +1627,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
if (charset)
{
- Lisp_Object arg = CALLN (Fvector, fontset, font_def, add,
+ Lisp_Object arg = CALLN (Fvector, fontset_obj, font_def, add,
ascii_changed ? Qt : Qnil, range_list);
map_charset_chars (set_fontset_font, Qnil, arg, charset,
@@ -1631,15 +1636,15 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
range_list = AREF (arg, 4);
}
for (; CONSP (range_list); range_list = XCDR (range_list))
- FONTSET_ADD (fontset, XCAR (range_list), font_def, add);
+ FONTSET_ADD (fontset_obj, XCAR (range_list), font_def, add);
if (ascii_changed)
{
Lisp_Object tail, fr;
- int fontset_id = XFIXNUM (FONTSET_ID (fontset));
+ int fontset_id = XFIXNUM (FONTSET_ID (fontset_obj));
- set_fontset_ascii (fontset, fontname);
- name = FONTSET_NAME (fontset);
+ set_fontset_ascii (fontset_obj, fontname);
+ fontset = FONTSET_NAME (fontset_obj);
FOR_EACH_FRAME (tail, fr)
{
struct frame *f = XFRAME (fr);
@@ -1657,17 +1662,17 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
font_object = font_open_by_spec (f, font_spec);
if (! NILP (font_object))
{
- update_auto_fontset_alist (font_object, fontset);
- AUTO_FRAME_ARG (arg, Qfont, Fcons (name, font_object));
+ update_auto_fontset_alist (font_object, fontset_obj);
+ AUTO_FRAME_ARG (arg, Qfont, Fcons (fontset, font_object));
Fmodify_frame_parameters (fr, arg);
}
}
}
- /* Free all realized fontsets whose base is FONTSET. This way, the
+ /* Free all realized fontsets whose base is FONTSET_OBJ. This way, the
specified character(s) are surely redisplayed by a correct
font. */
- free_realized_fontsets (fontset);
+ free_realized_fontsets (fontset_obj);
return Qnil;
}
diff --git a/src/frame.c b/src/frame.c
index 92120792f8f..923ef2d609a 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -277,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.
@@ -333,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)
{
@@ -1442,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.
@@ -1453,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;
@@ -1475,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);
@@ -1570,6 +1515,19 @@ do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object nor
if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
last_nonminibuf_frame = XFRAME (selected_frame);
+ /* If the selected window in the target frame is its mini-window, we move
+ to a different window, the most recently used one, unless there is a
+ valid active minibuffer in the mini-window. */
+ if (EQ (f->selected_window, f->minibuffer_window)
+ /* The following test might fail if the mini-window contains a
+ non-active minibuffer. */
+ && NILP (Fminibufferp (XWINDOW (f->minibuffer_window)->contents, Qt)))
+ {
+ Lisp_Object w = call1 (Qget_mru_window, frame);
+ if (WINDOW_LIVE_P (w)) /* W can be nil in minibuffer-only frames. */
+ Fset_frame_selected_window (frame, w, Qnil);
+ }
+
Fselect_window (f->selected_window, norecord);
/* We want to make sure that the next event generates a frame-switch
@@ -1612,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,
@@ -1628,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,
@@ -1985,6 +1943,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);
@@ -2134,7 +2101,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
@@ -2152,6 +2119,17 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
x_clear_frame_selections (f);
#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.
This function must be called before the window tree of the
frame is deleted because windows contain dynamically allocated
@@ -2323,7 +2301,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;
@@ -2380,9 +2359,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
@@ -2500,9 +2482,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);
@@ -2529,7 +2514,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);
@@ -2537,7 +2522,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);
@@ -2550,9 +2538,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;
@@ -2573,7 +2563,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);
@@ -3490,7 +3484,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);
@@ -3514,6 +3511,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'). */)
@@ -3611,7 +3611,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)
{
@@ -3902,6 +3902,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)},
@@ -4241,7 +4245,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)
@@ -4249,7 +4253,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)
@@ -5019,6 +5023,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,7 +5073,9 @@ gui_set_no_special_glyphs (struct frame *f, Lisp_Object new_value, Lisp_Object o
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));
}
@@ -5379,7 +5413,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;
@@ -5400,7 +5434,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);
@@ -5662,9 +5696,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))
{
@@ -5700,7 +5734,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))
{
@@ -5738,7 +5772,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;
@@ -5751,7 +5785,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))
{
@@ -5774,7 +5808,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
{
@@ -5804,7 +5838,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
{
@@ -5813,7 +5847,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;
@@ -6050,6 +6084,7 @@ 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");
@@ -6095,6 +6130,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");
@@ -6194,14 +6230,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;
@@ -6221,7 +6267,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
@@ -6467,6 +6513,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
@@ -6482,6 +6536,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 cb2f58e2611..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
@@ -123,6 +127,7 @@ struct frame
/* This frame's selected window.
Each frame has its own window hierarchy
and one of the windows in it is selected within the frame.
+ This window may be the mini-window of the frame, if any.
The selected window of the selected frame is Emacs's selected window. */
Lisp_Object selected_window;
@@ -637,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. */
@@ -1285,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;
@@ -1335,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);
@@ -1669,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);
diff --git a/src/fringe.c b/src/fringe.c
index 1f4dd46ec5a..bf0b5fde761 100644
--- a/src/fringe.c
+++ b/src/fringe.c
@@ -30,7 +30,9 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "termhooks.h"
#include "pdumper.h"
-#include "pgtkterm.h"
+#ifdef HAVE_PGTK
+# include "pgtkterm.h"
+#endif
/* Fringe bitmaps are represented in three different ways:
@@ -971,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
@@ -1823,6 +1825,23 @@ gui_init_fringe (struct redisplay_interface *rif)
}
}
+/* Call frame F's specific define_fringe_bitmap method for a fringe
+ bitmap number N. Called by various *term.c functions when they
+ need to display a fringe bitmap whose terminal-specific data is not
+ available. */
+void
+gui_define_fringe_bitmap (struct frame *f, int n)
+{
+ struct redisplay_interface *rif = FRAME_RIF (f);
+
+ if (!rif || !rif->define_fringe_bitmap || n >= max_used_fringe_bitmap)
+ return;
+
+ struct fringe_bitmap *fb = fringe_bitmaps[n];
+ if (fb)
+ rif->define_fringe_bitmap (n, fb->bits, fb->height, fb->width);
+}
+
#ifdef HAVE_NTGUI
void
w32_reset_fringes (void)
diff --git a/src/ftcrfont.c b/src/ftcrfont.c
index 558e44d5b91..6bb41110d5c 100644
--- a/src/ftcrfont.c
+++ b/src/ftcrfont.c
@@ -37,6 +37,9 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#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)
@@ -168,7 +171,12 @@ 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);
@@ -522,12 +530,23 @@ 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 ();
@@ -538,12 +557,12 @@ ftcrfont_draw (struct glyph_string *s,
cr = pgtk_begin_cr_clip (f);
#endif
#else
- BView_draw_lock (FRAME_HAIKU_VIEW (f));
+ /* 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)
{
- BView_draw_unlock (FRAME_HAIKU_VIEW (f));
EmacsWindow_end_cr_critical_section (FRAME_HAIKU_WINDOW (f));
unblock_input ();
return 0;
@@ -555,23 +574,21 @@ ftcrfont_draw (struct glyph_string *s,
{
#ifndef USE_BE_CAIRO
#ifdef HAVE_X_WINDOWS
- x_set_cr_source_with_gc_background (f, s->gc);
+ 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);
+ pgtk_set_cr_source_with_color (f, s->xgcv.background,
+ s->hl != DRAW_CURSOR);
#endif
#else
- struct face *face = s->face;
-
- uint32_t col = s->hl == DRAW_CURSOR ?
- FRAME_CURSOR_COLOR (s->f).pixel : face->background;
+ 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 (face->font),
- s->width, FONT_HEIGHT (face->font));
+ cairo_rectangle (cr, x, y - FONT_BASE (s->font),
+ s->width, FONT_HEIGHT (s->font));
cairo_fill (cr);
}
@@ -587,13 +604,12 @@ ftcrfont_draw (struct glyph_string *s,
}
#ifndef USE_BE_CAIRO
#ifdef HAVE_X_WINDOWS
- x_set_cr_source_with_gc_foreground (f, s->gc);
+ x_set_cr_source_with_gc_foreground (f, s->gc, false);
#else
- pgtk_set_cr_source_with_color (f, s->xgcv.foreground);
+ pgtk_set_cr_source_with_color (f, s->xgcv.foreground, false);
#endif
#else
- uint32_t col = s->hl == DRAW_CURSOR ?
- FRAME_OUTPUT_DATA (s->f)->cursor_fg : face->foreground;
+ uint32_t col = be_foreground;
cairo_set_source_rgb (cr, RED_FROM_ULONG (col) / 255.0,
GREEN_FROM_ULONG (col) / 255.0,
@@ -610,13 +626,34 @@ ftcrfont_draw (struct glyph_string *s,
#else
haiku_end_cr_clip (cr);
EmacsWindow_end_cr_critical_section (FRAME_HAIKU_WINDOW (f));
- BView_draw_unlock (FRAME_HAIKU_VIEW (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
@@ -687,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 2bdcce306bc..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));
@@ -627,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;
@@ -767,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
@@ -863,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;
@@ -909,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;
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 93f51d77962..f2018bc01f5 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -76,6 +76,34 @@ typedef struct pgtk_output xp_output;
#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
@@ -114,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
/***********************************************************************
@@ -199,6 +266,7 @@ xg_display_open (char *display_name, GdkDisplay **dpy)
static int
xg_get_gdk_scale (void)
{
+#ifdef HAVE_GTK3
const char *sscale = getenv ("GDK_SCALE");
if (sscale)
@@ -207,6 +275,7 @@ xg_get_gdk_scale (void)
if (0 < scale)
return min (scale, INT_MAX);
}
+#endif
return 1;
}
@@ -667,67 +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
+
+ 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))
+ if (!FRAME_GTK_WIDGET (f) || !(get_bg || get_fg))
return success_p;
block_input ();
- {
#ifdef HAVE_GTK3
-#ifndef HAVE_PGTK
- GtkStyleContext *gsty
- = gtk_widget_get_style_context (FRAME_GTK_OUTER_WIDGET (f));
-#else
- GtkStyleContext *gsty
- = gtk_widget_get_style_context (FRAME_WIDGET (f));
-#endif
- GdkRGBA col;
- char buf[sizeof "rgb://rrrr/gggg/bbbb"];
- int state = GTK_STATE_FLAG_SELECTED|GTK_STATE_FLAG_FOCUSED;
- 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;
+
+ 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);
+ }
- unsigned short
- r = col.red * 65535,
- g = col.green * 65535,
- b = col.blue * 65535;
+ 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;
+ 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;
+ sprintf (buf, "#%04x%04x%04x", r, g, b);
+ success_p = pgtk_parse_color (f, buf, color) != 0;
#endif
#else
- GtkStyle *gsty = gtk_widget_get_style (FRAME_GTK_WIDGET (f));
- GdkColor *grgb = get_bg
- ? &gsty->bg[GTK_STATE_SELECTED]
- : &gsty->fg[GTK_STATE_SELECTED];
+ 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;
+ 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;
}
@@ -992,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);
@@ -999,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)),
@@ -1113,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.
@@ -1159,7 +1245,11 @@ xg_frame_set_char_size (struct frame *f, int width, int height)
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)
{
@@ -1437,6 +1527,9 @@ 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;
@@ -1459,6 +1552,12 @@ xg_create_frame_widgets (struct frame *f)
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
Gtk+ 2.0 applications also. But it has a bug that makes Emacs loop
@@ -1530,10 +1629,7 @@ 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);
@@ -1577,6 +1673,21 @@ xg_create_frame_widgets (struct frame *f)
#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. */
@@ -1598,6 +1709,7 @@ 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
@@ -1621,10 +1733,25 @@ xg_create_frame_widgets (struct frame *f)
#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),
@@ -1761,6 +1888,7 @@ xg_free_frame_widgets (struct frame *f)
/* 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 */
@@ -1787,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. */
@@ -1875,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)
{
@@ -1927,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));
}
@@ -2326,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);
@@ -2928,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.
@@ -3158,8 +3296,13 @@ menu_bar_button_pressed_cb (GtkWidget *widget, GdkEvent *event,
{
struct frame *f = user_data;
- if (event->button.button < 4)
- set_frame_menubar (f, true);
+ 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;
}
@@ -3221,7 +3364,12 @@ 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);
@@ -3974,6 +4122,7 @@ xg_update_frame_menubar (struct frame *f)
{
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;
@@ -3991,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 ();
@@ -4083,13 +4244,13 @@ xg_event_is_for_menubar (struct frame *f, const XEvent *event)
}
else
{
-#else
+#endif
rec.x = event->xbutton.x / scale;
rec.y = event->xbutton.y / scale;
-#endif
#ifdef HAVE_XINPUT2
}
#endif
+
rec.width = 1;
rec.height = 1;
@@ -4120,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. */
@@ -4191,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];
@@ -4199,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)
{
@@ -4258,7 +4457,7 @@ xg_get_default_scrollbar_height (struct frame *f)
return scroll_bar_width_for_theme * xg_get_scale (f);
}
-#ifndef HAVE_PGTK
+#ifndef HAVE_GTK3
/* Return the scrollbar id for X Window WID on display DPY.
Return -1 if WID not in id_to_widget. */
@@ -4285,12 +4484,40 @@ xg_get_scroll_id_for_window (Display *dpy, Window wid)
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,
@@ -4301,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,
@@ -4341,27 +4581,35 @@ xg_finish_scroll_bar_creation (struct frame *f,
gtk_widget_realize (webox);
#ifdef HAVE_PGTK
gtk_widget_show_all (webox);
-#endif
-#ifndef HAVE_PGTK
+#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_PGTK
+#ifdef HAVE_GTK3
GtkStyleContext *ctxt = gtk_widget_get_style_context (wscroll);
- gtk_style_context_add_provider (ctxt,
- GTK_STYLE_PROVIDER (FRAME_OUTPUT_DATA (f)->
- scrollbar_foreground_css_provider),
+ 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 (FRAME_OUTPUT_DATA (f)->
- scrollbar_background_css_provider),
+ 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
@@ -4435,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);
@@ -4458,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.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);
@@ -4495,7 +4748,18 @@ 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. */
@@ -4510,7 +4774,8 @@ xg_update_scrollbar_pos (struct frame *f,
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
@@ -4549,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.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);
@@ -4587,6 +4855,16 @@ 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. */
@@ -4602,7 +4880,7 @@ 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
@@ -4642,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)
{
@@ -4729,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)
{
@@ -4761,7 +5042,8 @@ 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 EVENT *event)
+xg_event_is_for_scrollbar (struct frame *f, const EVENT *event,
+ bool for_valuator)
{
bool retval = 0;
@@ -4771,11 +5053,11 @@ xg_event_is_for_scrollbar (struct frame *f, const EVENT *event)
&& event->type == GenericEvent
&& (event->xgeneric.extension
== FRAME_DISPLAY_INFO (f)->xi2_opcode)
- && ((event->xgeneric.evtype == XI_ButtonPress
- && xev->detail < 4)
- || (event->xgeneric.evtype == XI_Motion)))
+ && (event->xgeneric.evtype == XI_ButtonPress
+ && xev->detail < 4))
|| (event->type == ButtonPress
- && event->xbutton.button < 4)))
+ && event->xbutton.button < 4)
+ || for_valuator))
#else
if (f
#ifndef HAVE_PGTK
@@ -4805,19 +5087,7 @@ xg_event_is_for_scrollbar (struct frame *f, const EVENT *event)
#else
gwin = gdk_display_get_window_at_pointer (gdpy, NULL, NULL);
#endif
-#ifndef HAVE_XINPUT2
retval = gwin != gtk_widget_get_window (f->output_data.xp->edit_widget);
-#else
- retval = (gwin
- && (gwin
- != gtk_widget_get_window (f->output_data.xp->edit_widget)));
-#endif
-#ifdef HAVE_XINPUT2
- GtkWidget *grab = gtk_grab_get_current ();
- if (event->type == GenericEvent
- && event->xgeneric.evtype == XI_Motion)
- retval = retval || (grab && GTK_IS_SCROLLBAR (grab));
-#endif
}
#ifdef HAVE_XINPUT2
else if (f && ((FRAME_DISPLAY_INFO (f)->supports_xi2
@@ -5423,6 +5693,7 @@ xg_update_tool_bar_sizes (struct frame *f)
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)
@@ -5431,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
{
@@ -5440,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)
@@ -5914,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 ()));
@@ -5963,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 5a918259280..190d6628314 100644
--- a/src/gtkutil.h
+++ b/src/gtkutil.h
@@ -148,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 EVENT *);
+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);
@@ -217,7 +220,11 @@ extern void xg_print_frames_dialog (Lisp_Object);
extern bool xg_is_menu_window (Display *dpy, Window);
#endif
-/* Mark all callback data that are Lisp_object:s during GC. */
+#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_draw_support.cc b/src/haiku_draw_support.cc
index 5d355ac2058..8e911dd1843 100644
--- a/src/haiku_draw_support.cc
+++ b/src/haiku_draw_support.cc
@@ -280,16 +280,42 @@ hsl_color_rgb (double h, double s, double l, uint32_t *rgb)
void
BView_DrawBitmap (void *view, void *bitmap, int x, int y,
int width, int height, int vx, int vy, int vwidth,
- int vheight)
+ int vheight, bool use_bilinear_filtering)
{
BView *vw = get_view (view);
BBitmap *bm = (BBitmap *) bitmap;
- vw->PushState ();
+ 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));
- vw->PopState ();
+ BRect (vx, vy, vx + vwidth - 1, vy + vheight - 1),
+ B_TILE_BITMAP);
+ vw->SetDrawingMode (B_OP_COPY);
}
void
@@ -300,20 +326,25 @@ BView_DrawBitmapWithEraseOp (void *view, void *bitmap, int x,
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;
- uint32_t *bits = (uint32_t *) bc.Bits ();
- size_t stride = bc.BytesPerRow ();
+ bits = (uint32_t *) bc.Bits ();
+ stride = bc.BytesPerRow ();
if (bm->ColorSpace () == B_GRAY1)
{
- rgb_color low_color = vw->LowColor ();
- BRect bounds = bc.Bounds ();
+ 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)
+ 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);
@@ -323,166 +354,183 @@ BView_DrawBitmapWithEraseOp (void *view, void *bitmap, int x,
}
}
- vw->PushState ();
- vw->SetDrawingMode (bm->ColorSpace () == B_GRAY1 ? B_OP_OVER : B_OP_ERASE);
+ vw->SetDrawingMode ((bm->ColorSpace ()
+ == B_GRAY1)
+ ? B_OP_OVER : B_OP_ERASE);
vw->DrawBitmap (&bc, rect);
- vw->PopState ();
+ vw->SetDrawingMode (B_OP_COPY);
}
void
-BView_DrawMask (void *src, void *view,
- int x, int y, int width, int height,
- int vx, int vy, int vwidth, int vheight,
- uint32_t color)
+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;
- for (int y = 0; y < BE_RECT_HEIGHT (bounds); ++y)
+
+ /* 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 (int x = 0; x < BE_RECT_WIDTH (bounds); ++x)
+ for (bx = 0; bx < BE_RECT_WIDTH (bounds); ++bx)
{
- int bit = haiku_get_pixel ((void *) source, x, y);
+ bit = haiku_get_pixel ((void *) source, bx, by);
if (!bit)
- haiku_put_pixel ((void *) &bm, x, y, ((uint32_t) 255 << 24) | color);
+ haiku_put_pixel ((void *) &bm, bx, by,
+ ((uint32_t) 255 << 24) | color);
else
- haiku_put_pixel ((void *) &bm, x, y, 0);
+ haiku_put_pixel ((void *) &bm, bx, by, 0);
}
}
- BView *vw = get_view (view);
+
+ 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);
}
-static BBitmap *
-rotate_bitmap_270 (BBitmap *bmp)
+void
+be_apply_affine_transform (void *view, double m0, double m1, double tx,
+ double m2, double m3, double ty)
{
- BRect r = bmp->Bounds ();
- BBitmap *bm = new BBitmap (BRect (r.top, r.left, r.bottom, r.right),
- bmp->ColorSpace (), true);
- if (bm->InitCheck () != B_OK)
- gui_abort ("Failed to init bitmap for rotate");
- int w = BE_RECT_WIDTH (r);
- int h = BE_RECT_HEIGHT (r);
-
- for (int y = 0; y < h; ++y)
- for (int x = 0; x < w; ++x)
- haiku_put_pixel ((void *) bm, y, w - x - 1,
- haiku_get_pixel ((void *) bmp, x, y));
+ BAffineTransform transform (m0, m2, m1, m3, tx, ty);
- return bm;
+ get_view (view)->SetTransform (transform);
}
-static BBitmap *
-rotate_bitmap_90 (BBitmap *bmp)
+void
+be_apply_inverse_transform (double (*matrix3x3)[3], int x, int y,
+ int *x_out, int *y_out)
{
- BRect r = bmp->Bounds ();
- BBitmap *bm = new BBitmap (BRect (r.top, r.left, r.bottom, r.right),
- bmp->ColorSpace (), true);
- if (bm->InitCheck () != B_OK)
- gui_abort ("Failed to init bitmap for rotate");
- int w = BE_RECT_WIDTH (r);
- int h = BE_RECT_HEIGHT (r);
+ BAffineTransform transform (matrix3x3[0][0], matrix3x3[1][0],
+ matrix3x3[0][1], matrix3x3[1][1],
+ matrix3x3[0][2], matrix3x3[1][2]);
+ BPoint point (x, y);
- for (int y = 0; y < h; ++y)
- for (int x = 0; x < w; ++x)
- haiku_put_pixel ((void *) bm, h - y - 1, x,
- haiku_get_pixel ((void *) bmp, x, y));
+ transform.ApplyInverse (&point);
- return bm;
+ *x_out = std::floor (point.x);
+ *y_out = std::floor (point.y);
}
-void *
-BBitmap_transform_bitmap (void *bitmap, void *mask, uint32_t m_color,
- double rot, int desw, int desh)
+void
+BView_FillTriangle (void *view, int x1, int y1,
+ int x2, int y2, int x3, int y3)
{
- BBitmap *bm = (BBitmap *) bitmap;
- BBitmap *mk = (BBitmap *) mask;
- int copied_p = 0;
+ BView *vw = get_view (view);
+ vw->FillTriangle (BPoint (x1, y1), BPoint (x2, y2),
+ BPoint (x3, y3));
+}
- if (rot == 90)
- {
- copied_p = 1;
- bm = rotate_bitmap_90 (bm);
- if (mk)
- mk = rotate_bitmap_90 (mk);
- }
+void
+BView_InvertRect (void *view, int x, int y, int width, int height)
+{
+ BView *vw = get_view (view);
- if (rot == 270)
- {
- copied_p = 1;
- bm = rotate_bitmap_270 (bm);
- if (mk)
- mk = rotate_bitmap_270 (mk);
- }
+ vw->InvertRect (BRect (x, y, x + width - 1, y + height - 1));
+}
- BRect n = BRect (0, 0, desw - 1, desh - 1);
- BView vw (n, NULL, B_FOLLOW_NONE, 0);
- BBitmap *dst = new BBitmap (n, bm->ColorSpace (), true);
- if (dst->InitCheck () != B_OK)
- if (bm->InitCheck () != B_OK)
- gui_abort ("Failed to init bitmap for scale");
- dst->AddChild (&vw);
+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;
- if (!vw.LockLooper ())
- gui_abort ("Failed to lock offscreen view for scale");
+ rgb32_to_rgb_color (color, &high_color);
+ dest.ImportBits (bitmap);
- if (rot != 90 && rot != 270)
- {
- BAffineTransform tr;
- tr.RotateBy (BPoint (desw / 2, desh / 2), rot * M_PI / 180.0);
- vw.SetTransform (tr);
- }
+ if (!dest.Lock ())
+ return;
- vw.MovePenTo (0, 0);
- vw.DrawBitmap (bm, n);
- if (mk)
- {
- BRect k = mk->Bounds ();
- BView_DrawMask ((void *) mk, (void *) &vw,
- 0, 0, BE_RECT_WIDTH (k),
- BE_RECT_HEIGHT (k),
- 0, 0, desw, desh, m_color);
- }
- vw.Sync ();
- vw.RemoveSelf ();
+ dest.AddChild (&view);
- if (copied_p)
- delete bm;
- if (copied_p && mk)
- delete mk;
- return dst;
+ 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
-BView_FillTriangle (void *view, int x1, int y1,
- int x2, int y2, int x3, int y3)
+be_draw_cross_on_pixmap (void *bitmap, int x, int y, int width,
+ int height, uint32_t color)
{
- BView *vw = get_view (view);
- vw->FillTriangle (BPoint (x1, y1), BPoint (x2, y2),
- BPoint (x3, y3));
+ BBitmap *target = (BBitmap *) bitmap;
+
+ be_draw_cross_on_pixmap_1 (target, x, y, width, height,
+ color);
}
void
-BView_SetHighColorForVisibleBell (void *view, uint32_t color)
+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)
{
- BView *vw = (BView *) view;
- rgb_color col;
- rgb32_to_rgb_color (color, &col);
+ 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;
- vw->SetHighColor (col);
-}
+ if (combined.ImportBits (source) != B_OK)
+ return;
-void
-BView_FillRectangleForVisibleBell (void *view, int x, int y, int width, int height)
-{
- BView *vw = (BView *) view;
- BRect rect = BRect (x, y, x + width - 1, y + height - 1);
+ bounds = source->Bounds ();
- vw->FillRect (rect);
+ 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
index 6ea10b2e47c..d824cc59ae2 100644
--- a/src/haiku_font_support.cc
+++ b/src/haiku_font_support.cc
@@ -27,15 +27,111 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#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 uint32_t language_code_points[MAX_LANGUAGE][4] =
- {{20154, 20754, 22996, 0}, /* Chinese. */
- {51312, 49440, 44544, 0}, /* Korean. */
- {26085, 26412, 12371, 0}, /* Japanese. */};
+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,
@@ -68,7 +164,11 @@ estimate_font_ascii (BFont *font, int *max_width,
*min_width = min;
*max_width = max;
- *avg_width = total / count;
+
+ if (count)
+ *avg_width = total / count;
+ else
+ *avg_width = 0;
}
void
@@ -81,9 +181,9 @@ BFont_close (void *font)
}
void
-BFont_dat (void *font, int *px_size, int *min_width, int *max_width,
- int *avg_width, int *height, int *space_width, int *ascent,
- int *descent, int *underline_position, int *underline_thickness)
+BFont_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;
@@ -159,9 +259,9 @@ BFont_char_bounds (void *font, const char *mb_str, int *advance,
ft->GetEdges (mb_str, 1, &edge_info);
ft->GetEscapements (mb_str, 1, &escapement);
- *advance = std::ceil (escapement * size);
- *lb = std::ceil (edge_info.left * size);
- *rb = *advance + std::ceil (edge_info.right * size);
+ *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. */
@@ -192,18 +292,21 @@ font_style_to_flags (char *st, struct haiku_font_pattern *pattern)
{
char *style = strdup (st);
char *token;
- pattern->weight = -1;
+ int tok = 0;
+
+ if (!style)
+ return;
+
+ pattern->weight = NO_WEIGHT;
pattern->width = NO_WIDTH;
pattern->slant = NO_SLANT;
- int tok = 0;
while ((token = std::strtok (!tok ? style : NULL, " ")) && tok < 3)
{
if (token && !strcmp (token, "Thin"))
pattern->weight = HAIKU_THIN;
- else if (token && !strcmp (token, "UltraLight"))
- pattern->weight = HAIKU_ULTRALIGHT;
- else if (token && !strcmp (token, "ExtraLight"))
+ else if (token && (!strcmp (token, "UltraLight")
+ || !strcmp (token, "ExtraLight")))
pattern->weight = HAIKU_EXTRALIGHT;
else if (token && !strcmp (token, "Light"))
pattern->weight = HAIKU_LIGHT;
@@ -217,19 +320,20 @@ font_style_to_flags (char *st, struct haiku_font_pattern *pattern)
if (pattern->width == NO_WIDTH)
pattern->width = NORMAL_WIDTH;
- if (pattern->weight == -1)
+ if (pattern->weight == NO_WEIGHT)
pattern->weight = HAIKU_REGULAR;
}
- else if (token && !strcmp (token, "SemiBold"))
+ 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") ||
+ else if (token && (!strcmp (token, "ExtraBold")
/* This has actually been seen in the wild. */
- !strcmp (token, "Extrabold")))
+ || !strcmp (token, "Extrabold")
+ || !strcmp (token, "UltraBold")))
pattern->weight = HAIKU_EXTRA_BOLD;
- else if (token && !strcmp (token, "UltraBold"))
- pattern->weight = HAIKU_ULTRA_BOLD;
else if (token && !strcmp (token, "Book"))
pattern->weight = HAIKU_BOOK;
else if (token && !strcmp (token, "Heavy"))
@@ -268,7 +372,7 @@ font_style_to_flags (char *st, struct haiku_font_pattern *pattern)
tok++;
}
- if (pattern->weight != -1)
+ if (pattern->weight != NO_WEIGHT)
pattern->specified |= FSPEC_WEIGHT;
if (pattern->slant != NO_SLANT)
pattern->specified |= FSPEC_SLANT;
@@ -283,6 +387,7 @@ font_style_to_flags (char *st, struct haiku_font_pattern *pattern)
pattern->specified |= FSPEC_STYLE;
std::strncpy ((char *) &pattern->style, st,
sizeof pattern->style - 1);
+ pattern->style[sizeof pattern->style - 1] = '\0';
}
free (style);
@@ -292,54 +397,86 @@ static bool
font_check_wanted_chars (struct haiku_font_pattern *pattern, font_family family,
char *style)
{
- BFont ft;
+ 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)
- return false;
+ if (ft->SetFamilyAndStyle (family, style) != B_OK)
+ {
+ delete ft;
+ return false;
+ }
- for (int i = 0; i < pattern->want_chars_len; ++i)
- if (!ft.IncludesBlock (pattern->wanted_chars[i],
- pattern->wanted_chars[i]))
- return false;
+ cached = cache_font_object_data (family, style, ft);
+ }
- return true;
+ 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;
+ 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)
- return false;
+ if (ft->SetFamilyAndStyle (family, style) != B_OK)
+ {
+ delete ft;
+ return false;
+ }
- for (int i = 0; i < pattern->need_one_of_len; ++i)
- if (ft.IncludesBlock (pattern->need_one_of[i],
- pattern->need_one_of[i]))
- return true;
+ cached = cache_font_object_data (family, style, ft);
+ }
- return false;
+ 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;
+ BFont *ft;
+ static struct font_object_cache_bucket *cached;
- if (ft.SetFamilyAndStyle (family, style) != B_OK)
- return false;
+ 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;
- for (uint32_t *ch = (uint32_t *)
- &language_code_points[pattern->language]; *ch; ch++)
- if (!ft.IncludesBlock (*ch, *ch))
- return false;
-
- return true;
+ return font_object_has_chars (cached, language_code_points[pattern->language],
+ 3, false);
}
static bool
@@ -353,16 +490,20 @@ font_family_style_matches_p (font_family family, char *style, uint32_t flags,
if (style)
font_style_to_flags (style, &m);
- if ((pattern->specified & FSPEC_FAMILY) &&
- strcmp ((char *) &pattern->family, family))
+ 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))
+ 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
@@ -371,7 +512,8 @@ font_family_style_matches_p (font_family family, char *style, uint32_t flags,
if ((pattern->specified & FSPEC_SLANT)
&& (pattern->slant
- != ((m.specified & FSPEC_SLANT) ? m.slant : SLANT_REGULAR)))
+ != (m.specified & FSPEC_SLANT
+ ? m.slant : SLANT_REGULAR)))
return false;
if ((pattern->specified & FSPEC_WANTED)
@@ -379,8 +521,9 @@ font_family_style_matches_p (font_family family, char *style, uint32_t flags,
return false;
if ((pattern->specified & FSPEC_WIDTH)
- && (pattern->width !=
- ((m.specified & FSPEC_WIDTH) ? m.width : NORMAL_WIDTH)))
+ && (pattern->width
+ != (m.specified & FSPEC_WIDTH
+ ? m.width : NORMAL_WIDTH)))
return false;
if ((pattern->specified & FSPEC_NEED_ONE_OF)
@@ -405,6 +548,7 @@ haiku_font_fill_pattern (struct haiku_font_pattern *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;
}
@@ -430,18 +574,21 @@ BFont_find (struct haiku_font_pattern *pt)
font_family name;
font_style sname;
uint32 flags;
- int sty_count;
- int fam_count = count_font_families ();
+ int sty_count, fam_count, si, fi;
+ struct haiku_font_pattern *p, *head, *n;
+ bool oblique_seen_p;
+
+ fam_count = count_font_families ();
- for (int fi = 0; fi < fam_count; ++fi)
+ 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))
+ if (!sty_count
+ && font_family_style_matches_p (name, NULL, flags, pt))
{
- struct haiku_font_pattern *p = new struct haiku_font_pattern;
+ p = new struct haiku_font_pattern;
p->specified = 0;
p->oblique_seen_p = 1;
haiku_font_fill_pattern (p, name, NULL, flags);
@@ -451,14 +598,20 @@ BFont_find (struct haiku_font_pattern *pt)
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 (int si = 0; si < sty_count; ++si)
+ for (si = 0; si < sty_count; ++si)
{
- int oblique_seen_p = 0;
- struct haiku_font_pattern *head = r;
- struct haiku_font_pattern *p = NULL;
+ oblique_seen_p = 0;
+ head = r;
+ p = NULL;
if (get_font_style (name, si, &sname, &flags) == B_OK)
{
@@ -467,8 +620,24 @@ BFont_find (struct haiku_font_pattern *pt)
p = new struct haiku_font_pattern;
p->specified = 0;
haiku_font_fill_pattern (p, name, (char *) &sname, flags);
- if (p->specified & FSPEC_SLANT &&
- ((p->slant == SLANT_OBLIQUE) || (p->slant == SLANT_ITALIC)))
+
+ /* 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;
@@ -483,9 +652,7 @@ BFont_find (struct haiku_font_pattern *pt)
p->last = NULL;
for (; head; head = head->last)
- {
- head->oblique_seen_p = oblique_seen_p;
- }
+ head->oblique_seen_p = oblique_seen_p;
}
}
}
@@ -498,13 +665,18 @@ BFont_find (struct haiku_font_pattern *pt)
if (!(pt->specified & FSPEC_SLANT))
{
/* r->last is invalid from here onwards. */
- for (struct haiku_font_pattern *p = r; p;)
+ for (p = r; p;)
{
if (!p->oblique_seen_p)
{
- struct haiku_font_pattern *n = new haiku_font_pattern;
+ 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;
}
@@ -516,51 +688,99 @@ BFont_find (struct haiku_font_pattern *pt)
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;
+ 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))
+ if (!sty_count
+ && font_family_style_matches_p (name, NULL, flags, pat, 1))
{
- BFont *ft = new BFont;
+ ft = new BFont;
+ ft->SetSize (size);
+ ft->SetEncoding (B_UNICODE_UTF8);
+ ft->SetSpacing (B_BITMAP_SPACING);
+
if (ft->SetFamilyAndStyle (name, NULL) != B_OK)
{
delete ft;
return 1;
}
- ft->SetSize (size);
- ft->SetEncoding (B_UNICODE_UTF8);
- ft->SetSpacing (B_BITMAP_SPACING);
*font = (void *) ft;
return 0;
}
else if (sty_count)
{
- for (int si = 0; si < sty_count; ++si)
+ 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))
+ if (get_font_style (name, si, &sname, &flags) == B_OK
+ && font_family_style_matches_p (name, (char *) &sname,
+ flags, pat))
{
- BFont *ft = new BFont;
+ ft = 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;
}
- ft->SetSize (size);
- ft->SetEncoding (B_UNICODE_UTF8);
- ft->SetSpacing (B_BITMAP_SPACING);
+
*font = (void *) ft;
return 0;
}
@@ -569,12 +789,14 @@ BFont_open_pattern (struct haiku_font_pattern *pat, void **font, float size)
if (pat->specified & FSPEC_SLANT && pat->slant == SLANT_OBLIQUE)
{
- struct haiku_font_pattern copy = *pat;
+ copy = *pat;
copy.slant = SLANT_REGULAR;
- int code = BFont_open_pattern (&copy, font, size);
+ code = BFont_open_pattern (&copy, font, size);
+
if (code)
return code;
- BFont *ft = (BFont *) *font;
+
+ ft = (BFont *) *font;
/* XXX Font measurements don't respect shear. Haiku bug?
This apparently worked in BeOS.
ft->SetShear (100.0); */
@@ -595,6 +817,7 @@ BFont_populate_fixed_family (struct haiku_font_pattern *ptn)
ptn->specified |= FSPEC_FAMILY;
strncpy (ptn->family, f, sizeof ptn->family - 1);
+ ptn->family[sizeof ptn->family - 1] = '\0';
}
void
@@ -606,10 +829,113 @@ BFont_populate_plain_family (struct haiku_font_pattern *ptn)
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
-BFont_string_width (void *font, const char *utf8)
+be_find_font_indices (struct haiku_font_pattern *pattern,
+ int *family_index, int *style_index)
{
- return ((BFont *) font)->StringWidth (utf8);
+ 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
index cb7750634cf..5cc70f6f71f 100644
--- a/src/haiku_io.c
+++ b/src/haiku_io.c
@@ -36,10 +36,19 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
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
@@ -75,21 +84,31 @@ haiku_len (enum haiku_event_type type)
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 FILE_PANEL_EVENT:
- return sizeof (struct haiku_file_panel_event);
case MENU_BAR_HELP_EVENT:
return sizeof (struct haiku_menu_bar_help_event);
case ZOOM_EVENT:
return sizeof (struct haiku_zoom_event);
- case REFS_EVENT:
- return sizeof (struct haiku_refs_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 ();
@@ -98,9 +117,11 @@ haiku_len (enum haiku_event_type type)
/* 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)
+haiku_read_size (ssize_t *len, bool popup_menu_p)
{
- port_id from = port_application_to_emacs;
+ 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);
@@ -129,13 +150,16 @@ haiku_read (enum haiku_event_type *type, void *buf, ssize_t len)
}
/* 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,
- time_t timeout)
+ bigtime_t timeout, bool popup_menu_p)
{
int32 typ;
- port_id from = port_application_to_emacs;
+ 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,
@@ -165,9 +189,12 @@ haiku_write (enum haiku_event_type type, void *buf)
}
int
-haiku_write_without_signal (enum haiku_event_type type, void *buf)
+haiku_write_without_signal (enum haiku_event_type type, void *buf,
+ bool popup_menu_p)
{
- port_id to = port_application_to_emacs;
+ 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;
@@ -184,24 +211,3 @@ haiku_io_init_in_app_thread (void)
if (pthread_sigmask (SIG_BLOCK, &set, NULL))
perror ("pthread_sigmask");
}
-
-/* Record an unwind protect from C++ code. */
-void
-record_c_unwind_protect_from_cxx (void (*fn) (void *), void *r)
-{
- record_unwind_protect_ptr (fn, r);
-}
-
-/* SPECPDL_IDX that is safe from C++ code. */
-ptrdiff_t
-c_specpdl_idx_from_cxx (void)
-{
- return SPECPDL_INDEX ();
-}
-
-/* unbind_to (IDX, Qnil), but safe from C++ code. */
-void
-c_unbind_to_nil_from_cxx (ptrdiff_t idx)
-{
- unbind_to (idx, Qnil);
-}
diff --git a/src/haiku_select.cc b/src/haiku_select.cc
index 041e244f3ea..e1f2a815241 100644
--- a/src/haiku_select.cc
+++ b/src/haiku_select.cc
@@ -18,212 +18,493 @@ 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;
-int selection_state_flag;
+/* The number of times the system clipboard has changed. */
+static int64 count_clipboard = -1;
-static char *
-BClipboard_find_data (BClipboard *cb, const char *type, ssize_t *len)
-{
- if (!cb->Lock ())
- return 0;
+/* The number of times the primary selection has changed. */
+static int64 count_primary = -1;
- BMessage *dat = cb->Data ();
- if (!dat)
- {
- cb->Unlock ();
- return 0;
- }
+/* The number of times the secondary selection has changed. */
+static int64 count_secondary = -1;
- const char *ptr;
- ssize_t bt;
- dat->FindData (type, B_MIME_TYPE, (const void **) &ptr, &bt);
+/* Whether or not we currently think Emacs owns the primary
+ selection. */
+static bool owned_primary;
- if (!ptr)
+/* 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)
{
- cb->Unlock ();
- return NULL;
- }
+ case CLIPBOARD_PRIMARY:
+ return primary;
- if (len)
- *len = bt;
+ case CLIPBOARD_SECONDARY:
+ return secondary;
- cb->Unlock ();
+ case CLIPBOARD_CLIPBOARD:
+ return system_clipboard;
+ }
- return strndup (ptr, bt);
+ abort ();
}
-static void
-BClipboard_get_targets (BClipboard *cb, char **buf, int buf_size)
+static char *
+be_find_clipboard_data_1 (BClipboard *cb, const char *type, ssize_t *len)
{
BMessage *data;
- char *name;
- int32 count_found;
- type_code type;
- int32 i;
- int index;
+ const char *ptr;
+ ssize_t nbytes;
+ void *value;
if (!cb->Lock ())
- {
- buf[0] = NULL;
- return;
- }
+ return NULL;
data = cb->Data ();
- index = 0;
if (!data)
{
- buf[0] = NULL;
cb->Unlock ();
- return;
+ return NULL;
}
- for (i = 0; (data->GetInfo (B_ANY_TYPE, i, &name,
- &type, &count_found)
- == B_OK); ++i)
+ data->FindData (type, B_MIME_TYPE, (const void **) &ptr,
+ &nbytes);
+
+ if (!ptr)
{
- if (type == B_MIME_TYPE)
- {
- if (index < (buf_size - 1))
- {
- buf[index++] = strdup (name);
-
- if (!buf[index - 1])
- break;
- }
- }
+ cb->Unlock ();
+ return NULL;
}
- buf[index] = 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
-BClipboard_set_data (BClipboard *cb, const char *type, const char *dat,
- ssize_t len, bool clear)
+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 ();
- BMessage *mdat = cb->Data ();
- if (!mdat)
+ message_data = cb->Data ();
+
+ if (!message_data)
{
cb->Unlock ();
return;
}
- if (dat)
+ if (data)
{
- if (mdat->ReplaceData (type, B_MIME_TYPE, dat, len)
+ if (message_data->ReplaceData (type, B_MIME_TYPE, data, len)
== B_NAME_NOT_FOUND)
- mdat->AddData (type, B_MIME_TYPE, dat, len);
+ message_data->AddData (type, B_MIME_TYPE, data, len);
}
else
- mdat->RemoveName (type);
+ 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 *
-BClipboard_find_system_data (const char *type, ssize_t *len)
+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)
{
- if (!system_clipboard)
- return 0;
+ be_update_clipboard_count (id);
- return BClipboard_find_data (system_clipboard, type, len);
+ be_set_clipboard_data_1 (get_clipboard_object (id), type,
+ data, len, clear);
}
-char *
-BClipboard_find_primary_selection_data (const char *type, ssize_t *len)
+static bool
+clipboard_owner_p (void)
{
- if (!primary)
- return 0;
+ return (count_clipboard >= 0
+ && (count_clipboard + 1
+ == system_clipboard->SystemCount ()));
+}
- return BClipboard_find_data (primary, type, len);
+static bool
+primary_owner_p (void)
+{
+ return (count_primary >= 0
+ && (count_primary + 1
+ == primary->SystemCount ()));
}
-char *
-BClipboard_find_secondary_selection_data (const char *type, ssize_t *len)
+static bool
+secondary_owner_p (void)
+{
+ return (count_secondary >= 0
+ && (count_secondary + 1
+ == secondary->SystemCount ()));
+}
+
+bool
+be_clipboard_owner_p (enum haiku_clipboard clipboard)
{
- if (!secondary)
- return 0;
+ switch (clipboard)
+ {
+ case CLIPBOARD_PRIMARY:
+ return primary_owner_p ();
+
+ case CLIPBOARD_SECONDARY:
+ return secondary_owner_p ();
+
+ case CLIPBOARD_CLIPBOARD:
+ return clipboard_owner_p ();
+ }
- return BClipboard_find_data (secondary, type, len);
+ abort ();
}
void
-BClipboard_set_system_data (const char *type, const char *data,
- ssize_t len, bool clear)
+be_clipboard_init (void)
{
- if (!system_clipboard)
- return;
+ 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;
- BClipboard_set_data (system_clipboard, type, data, len, clear);
+ rc = msg->GetInfo (B_ANY_TYPE, index, &name, &type, count);
+
+ if (rc != B_OK)
+ return 1;
+
+ *tc = type;
+ *name_return = name;
+ return 0;
}
-void
-BClipboard_set_primary_selection_data (const char *type, const char *data,
- ssize_t len, bool clear)
+int
+be_get_refs_data (void *message, const char *name,
+ int32 index, char **path_buffer)
{
- if (!primary)
- return;
+ status_t rc;
+ BEntry entry;
+ BPath path;
+ entry_ref ref;
+ BMessage *msg;
+
+ msg = (BMessage *) message;
+ rc = msg->FindRef (name, index, &ref);
- BClipboard_set_data (primary, type, data, len, clear);
+ 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;
}
-void
-BClipboard_set_secondary_selection_data (const char *type, const char *data,
- ssize_t len, bool clear)
+int
+be_get_point_data (void *message, const char *name,
+ int32 index, float *x, float *y)
{
- if (!secondary)
- return;
+ 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;
- BClipboard_set_data (secondary, type, data, len, clear);
+ return 0;
}
-void
-BClipboard_free_data (void *ptr)
+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)
{
- std::free (ptr);
+ BMessage *msg = (BMessage *) message;
+
+ return msg->what;
}
void
-BClipboard_system_targets (char **buf, int len)
+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_get_targets (system_clipboard, buf, len);
+ BClipboard *board;
+
+ board = get_clipboard_object (clipboard);
+
+ if (!board->Lock ())
+ return 1;
+
+ if (clear)
+ board->Clear ();
+
+ *message_return = board->Data ();
+ return 0;
}
void
-BClipboard_primary_targets (char **buf, int len)
+be_unlock_clipboard (enum haiku_clipboard clipboard, bool discard)
{
- BClipboard_get_targets (primary, buf, len);
+ BClipboard *board;
+
+ board = get_clipboard_object (clipboard);
+
+ if (discard)
+ board->Revert ();
+ else
+ board->Commit ();
+
+ board->Unlock ();
}
void
-BClipboard_secondary_targets (char **buf, int len)
+be_handle_clipboard_changed_message (void)
{
- BClipboard_get_targets (secondary, buf, len);
+ 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
-init_haiku_select (void)
+be_start_watching_selection (enum haiku_clipboard id)
{
- system_clipboard = new BClipboard ("system");
- primary = new BClipboard ("primary");
- secondary = new BClipboard ("secondary");
+ 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;
}
diff --git a/src/haiku_support.cc b/src/haiku_support.cc
index 2e9eff40676..a3d3b7a17d3 100644
--- a/src/haiku_support.cc
+++ b/src/haiku_support.cc
@@ -17,10 +17,13 @@ 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>
@@ -36,6 +39,15 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#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>
@@ -52,6 +64,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <support/Beep.h>
#include <support/DataIO.h>
#include <support/Locker.h>
+#include <support/ObjectList.h>
#include <translation/TranslatorRoster.h>
#include <translation/TranslationDefs.h>
@@ -62,6 +75,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <kernel/scheduler.h>
#include <private/interface/ToolTip.h>
+#include <private/interface/WindowPrivate.h>
#include <cmath>
#include <cstring>
@@ -70,59 +84,152 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <csignal>
#include <cfloat>
-#include <pthread.h>
-
#ifdef USE_BE_CAIRO
#include <cairo.h>
#endif
#include "haiku_support.h"
-#define SCROLL_BAR_UPDATE 3000
+/* 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;
-static key_map *key_map = NULL;
-static char *key_chars = NULL;
+
+/* 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;
-/* A LeaveNotify event (well, the closest equivalent on Haiku, which
- is a B_MOUSE_MOVED event with `transit' set to B_EXITED_VIEW) might
- be sent out-of-order with regards to motion events from other
- windows, such as when the mouse pointer rapidly moves from an
- undecorated child frame to its parent. This can cause a failure to
- clear the mouse face on the former if an event for the latter is
- read by Emacs first and ends up showing the mouse face there.
-
- While this lock doesn't really ensure that the events will be
- delivered in the correct order, it makes them arrive in the correct
- order "most of the time" on my machine, which is good enough and
- preferable to adding a lot of extra complexity to the event
- handling code to sort motion events by their timestamps.
-
- Obviously this depends on the number of execution units that are
- available, and the scheduling priority of each thread involved in
- the input handling, but it will be good enough for most people. */
-
-static BLocker movement_locker;
+/* 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 *);
-extern "C"
-{
- extern _Noreturn void emacs_abort (void);
- /* Also defined in haikuterm.h. */
- extern void be_app_quit (void);
-}
-
+/* The ID of the thread the BApplication is running in. */
static thread_id app_thread;
_Noreturn void
@@ -132,7 +239,127 @@ gui_abort (const char *msg)
fprintf (stderr, "Under Haiku, Emacs cannot recover from errors in GUI code\n");
fprintf (stderr, "App Server disconnects usually manifest as bitmap "
"initialization failures or lock failures.");
- emacs_abort ();
+ 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
@@ -178,6 +405,40 @@ map_shift (uint32_t kc, uint32_t *ch)
}
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 ())
@@ -194,11 +455,167 @@ map_normal (uint32_t kc, uint32_t *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:
- Emacs () : BApplication ("application/x-vnd.GNU-emacs")
+ 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
@@ -215,39 +632,31 @@ public:
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);
- return 0;
+
+ 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
- RefsReceived (BMessage *msg)
+ MessageReceived (BMessage *msg)
{
- struct haiku_refs_event rq;
- entry_ref ref;
- BEntry entry;
- BPath path;
- int32 cookie = 0;
- int32 x, y;
- void *window;
-
- if ((msg->FindPointer ("window", 0, &window) != B_OK)
- || (msg->FindInt32 ("x", 0, &x) != B_OK)
- || (msg->FindInt32 ("y", 0, &y) != B_OK))
- return;
+ struct haiku_clipboard_changed_event rq;
- rq.window = window;
- rq.x = x;
- rq.y = y;
-
- while (msg->FindRef ("refs", cookie++, &ref) == B_OK)
- {
- if (entry.SetTo (&ref, 0) == B_OK
- && entry.GetPath (&path) == B_OK)
- {
- rq.ref = strdup (path.Path ());
- haiku_write (REFS_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);
}
};
@@ -259,23 +668,45 @@ public:
struct child_frame *next;
int xoff, yoff;
EmacsWindow *window;
- } *subset_windows = NULL;
+ } *subset_windows;
- EmacsWindow *parent = NULL;
+ EmacsWindow *parent;
BRect pre_fullscreen_rect;
BRect pre_zoom_rect;
- int x_before_zoom = INT_MIN;
- int y_before_zoom = INT_MIN;
- int fullscreen_p = 0;
- int zoomed_p = 0;
- int shown_flag = 0;
- volatile int was_shown_p = 0;
- bool menu_bar_active_p = false;
+ 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)
+ 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 ()
@@ -299,6 +730,19 @@ public:
}
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)
@@ -345,17 +789,16 @@ public:
void
Unparent (void)
{
+ EmacsWindow *parent;
+
if (!child_frame_lock.Lock ())
gui_abort ("Failed to lock child frame state lock");
- this->SetFeel (B_NORMAL_WINDOW_FEEL);
+
+ parent = this->parent;
+ this->parent = NULL;
+ RecomputeFeel ();
UpwardsUnSubsetChildren (parent);
this->RemoveFromSubset (this);
- this->parent = NULL;
- if (fullscreen_p)
- {
- fullscreen_p = 0;
- MakeFullscreen (1);
- }
child_frame_lock.Unlock ();
}
@@ -401,16 +844,10 @@ public:
UnparentAndUnlink ();
this->parent = window;
- this->SetFeel (B_FLOATING_SUBSET_WINDOW_FEEL);
+ RecomputeFeel ();
this->AddToSubset (this);
if (!IsHidden () && this->parent)
UpwardsSubsetChildren (parent);
- if (fullscreen_p)
- {
- fullscreen_p = 0;
- MakeFullscreen (1);
- }
- this->Sync ();
window->LinkChild (this);
child_frame_lock.Unlock ();
@@ -437,11 +874,23 @@ public:
}
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->MoveTo (frame.left + f->xoff,
- frame.top + f->yoff);
+ f->window->MoveToIncludingFrame (frame.left + f->xoff,
+ frame.top + f->yoff);
}
void
@@ -489,74 +938,36 @@ public:
void
MessageReceived (BMessage *msg)
{
- int32 old_what = 0;
-
if (msg->WasDropped ())
{
- entry_ref ref;
BPoint whereto;
+ int32 windowid;
+ struct haiku_drag_and_drop_event rq;
- if (msg->FindRef ("refs", &ref) == B_OK)
- {
- msg->what = B_REFS_RECEIVED;
- msg->AddPointer ("window", this);
- if (msg->FindPoint ("_drop_point_", &whereto) == B_OK)
- {
- this->ConvertFromScreen (&whereto);
- msg->AddInt32 ("x", whereto.x);
- msg->AddInt32 ("y", whereto.y);
- }
- be_app->PostMessage (msg);
- msg->SendReply (B_OK);
- }
+ if (msg->FindInt32 ("emacs:window_id", &windowid) == B_OK
+ && !msg->IsSourceRemote ()
+ && windowid == this->window_id)
+ return;
+
+ whereto = msg->DropPoint ();
+
+ this->ConvertFromScreen (&whereto);
+
+ rq.window = this;
+ rq.message = DetachCurrentMessage ();
+ rq.x = whereto.x;
+ rq.y = whereto.y;
+
+ haiku_write (DRAG_AND_DROP_EVENT, &rq);
}
else if (msg->GetPointer ("menuptr"))
{
struct haiku_menu_bar_select_event rq;
+
rq.window = this;
rq.ptr = (void *) msg->GetPointer ("menuptr");
- haiku_write (MENU_BAR_SELECT_EVENT, &rq);
- }
- else if (msg->what == 'FPSE'
- || ((msg->FindInt32 ("old_what", &old_what) == B_OK
- && old_what == 'FPSE')))
- {
- struct haiku_file_panel_event rq;
- BEntry entry;
- BPath path;
- entry_ref ref;
-
- rq.ptr = NULL;
-
- if (msg->FindRef ("refs", &ref) == B_OK &&
- entry.SetTo (&ref, 0) == B_OK &&
- entry.GetPath (&path) == B_OK)
- {
- const char *str_path = path.Path ();
- if (str_path)
- rq.ptr = strdup (str_path);
- }
- if (msg->FindRef ("directory", &ref),
- entry.SetTo (&ref, 0) == B_OK &&
- entry.GetPath (&path) == B_OK)
- {
- const char *name = msg->GetString ("name");
- const char *str_path = path.Path ();
-
- if (name)
- {
- char str_buf[std::strlen (str_path)
- + std::strlen (name) + 2];
- snprintf ((char *) &str_buf,
- std::strlen (str_path)
- + std::strlen (name) + 2, "%s/%s",
- str_path, name);
- rq.ptr = strdup (str_buf);
- }
- }
-
- haiku_write (FILE_PANEL_EVENT, &rq);
+ haiku_write (MENU_BAR_SELECT_EVENT, &rq);
}
else
BWindow::MessageReceived (msg);
@@ -579,7 +990,11 @@ public:
rq.window = this;
- int32_t code = msg->GetInt32 ("raw_char", 0);
+ 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 ();
@@ -596,15 +1011,33 @@ public:
if (mods & B_OPTION_KEY)
rq.modifiers |= HAIKU_MODIFIER_SUPER;
- rq.mb_char = code;
- rq.kc = msg->GetInt32 ("key", -1);
- rq.unraw_mb_char =
- BUnicodeChar::FromUTF8 (msg->GetString ("bytes"));
+ ret = keysym_from_raw_char (raw, key, &rq.keysym);
+
+ if (!ret)
+ rq.keysym = 0;
- if ((mods & B_SHIFT_KEY) && rq.kc >= 0)
- map_shift (rq.kc, &rq.unraw_mb_char);
- else if (rq.kc >= 0)
- map_normal (rq.kc, &rq.unraw_mb_char);
+ 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);
}
@@ -638,17 +1071,30 @@ public:
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 ()
+ 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;
- haiku_write (MENU_BAR_OPEN, &rq);
menu_bar_active_p = true;
}
@@ -667,43 +1113,70 @@ public:
{
struct haiku_resize_event rq;
rq.window = this;
- rq.px_heightf = newHeight + 1.0f;
- rq.px_widthf = newWidth + 1.0f;
+ rq.width = newWidth + 1.0f;
+ rq.height = newHeight + 1.0f;
haiku_write (FRAME_RESIZED, &rq);
BWindow::FrameResized (newWidth, newHeight);
}
void
- FrameMoved (BPoint newPosition)
+ 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 (newPosition.x);
- rq.y = std::lrint (newPosition.y);
+ 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);
- 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)
- DoMove (f);
- child_frame_lock.Unlock ();
+ CHILD_FRAME_LOCK_INSIDE_LOOPER_CALLBACK
+ {
+ for (f = subset_windows; f; f = f->next)
+ DoMove (f);
+ child_frame_lock.Unlock ();
- Sync ();
- BWindow::FrameMoved (newPosition);
+ BWindow::FrameMoved (new_position);
+ }
}
void
WorkspacesChanged (uint32_t old, uint32_t n)
{
- if (!child_frame_lock.Lock ())
- gui_abort ("Failed to lock child frames for changing workspaces");
- for (struct child_frame *f = subset_windows;
- f; f = f->next)
- DoUpdateWorkspace (f);
- child_frame_lock.Unlock ();
+ 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
@@ -713,7 +1186,7 @@ public:
gui_abort ("Failed to lock child frame state lock");
if (!this->parent)
- this->MoveTo (x, y);
+ this->MoveToIncludingFrame (x, y);
else
this->parent->MoveChild (this, x, y, 0);
child_frame_lock.Unlock ();
@@ -731,12 +1204,13 @@ public:
void
Minimize (bool minimized_p)
{
- BWindow::Minimize (minimized_p);
struct haiku_iconification_event rq;
+
rq.window = this;
rq.iconified_p = !parent && minimized_p;
-
haiku_write (ICONIFICATION, &rq);
+
+ BWindow::Minimize (minimized_p);
}
void
@@ -784,73 +1258,113 @@ public:
child_frame_lock.Unlock ();
}
- void
- Zoom (BPoint o, float w, float h)
+ BRect
+ ClearFullscreen (enum haiku_fullscreen_mode target_mode)
{
- struct haiku_zoom_event rq;
- rq.window = this;
+ BRect original_frame;
- rq.x = o.x;
- rq.y = o.y;
+ switch (fullscreen_mode)
+ {
+ case FULLSCREEN_MODE_MAXIMIZED:
+ original_frame = pre_zoom_rect;
- rq.width = w + 1;
- rq.height = h + 1;
+ 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;
- if (fullscreen_p)
- MakeFullscreen (0);
+ 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 (o.x != x_before_zoom ||
- o.y != y_before_zoom)
- {
- x_before_zoom = Frame ().left;
- y_before_zoom = Frame ().top;
- pre_zoom_rect = Frame ();
- zoomed_p = 1;
- haiku_write (ZOOM_EVENT, &rq);
- }
- else
- {
- zoomed_p = 0;
- x_before_zoom = y_before_zoom = INT_MIN;
+ 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;
}
- BWindow::Zoom (o, w, h);
+ out:
+ fullscreen_mode = FULLSCREEN_MODE_NONE;
+ return original_frame;
}
- void
- UnZoom (void)
+ BRect
+ FullscreenRectForMode (enum haiku_fullscreen_mode mode)
{
- if (!zoomed_p)
- return;
- zoomed_p = 0;
+ BScreen screen (this);
+ BRect frame;
+
+ if (!screen.IsValid ())
+ return BRect (0, 0, 0, 0);
+
+ frame = screen.Frame ();
- EmacsMoveTo (pre_zoom_rect.left, pre_zoom_rect.top);
- ResizeTo (BE_RECT_WIDTH (pre_zoom_rect),
- BE_RECT_HEIGHT (pre_zoom_rect));
+ 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
- GetParentWidthHeight (int *width, int *height)
+ SetFullscreen (enum haiku_fullscreen_mode mode)
{
- if (!child_frame_lock.Lock ())
- gui_abort ("Failed to lock child frame state lock");
+ BRect zoom_rect, frame;
- if (parent)
- {
- BRect frame = parent->Frame ();
- *width = BE_RECT_WIDTH (frame);
- *height = BE_RECT_HEIGHT (frame);
- }
- else
+ frame = ClearFullscreen (mode);
+
+ switch (mode)
{
- BScreen s (this);
- BRect frame = s.Frame ();
+ 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;
- *width = BE_RECT_WIDTH (frame);
- *height = BE_RECT_HEIGHT (frame);
+ 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;
}
- child_frame_lock.Unlock ();
+ 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
@@ -873,55 +1387,12 @@ public:
child_frame_lock.Lock ();
gui_abort ("Trying to calculate offsets for a child frame that doesn't exist");
}
-
- void
- MakeFullscreen (int make_fullscreen_p)
- {
- BScreen screen (this);
-
- if (!screen.IsValid ())
- gui_abort ("Trying to make a window fullscreen without a screen");
-
- if (make_fullscreen_p == fullscreen_p)
- return;
-
- fullscreen_p = make_fullscreen_p;
- uint32 flags = Flags ();
- if (fullscreen_p)
- {
- if (zoomed_p)
- UnZoom ();
-
- flags |= B_NOT_MOVABLE | B_NOT_ZOOMABLE;
- pre_fullscreen_rect = Frame ();
-
- if (!child_frame_lock.Lock ())
- gui_abort ("Failed to lock child frame state lock");
-
- if (parent)
- parent->OffsetChildRect (&pre_fullscreen_rect, this);
-
- child_frame_lock.Unlock ();
-
- int w, h;
- EmacsMoveTo (0, 0);
- GetParentWidthHeight (&w, &h);
- ResizeTo (w, h);
- }
- else
- {
- flags &= ~(B_NOT_MOVABLE | B_NOT_ZOOMABLE);
- EmacsMoveTo (pre_fullscreen_rect.left,
- pre_fullscreen_rect.top);
- ResizeTo (BE_RECT_WIDTH (pre_fullscreen_rect),
- BE_RECT_HEIGHT (pre_fullscreen_rect));
- }
- SetFlags (flags);
- }
};
class EmacsMenuBar : public BMenuBar
{
+ bool tracking_p;
+
public:
EmacsMenuBar () : BMenuBar (BRect (0, 0, 0, 0), NULL)
{
@@ -940,49 +1411,175 @@ public:
{
struct haiku_menu_bar_resize_event rq;
rq.window = this->Window ();
- rq.height = std::lrint (newHeight);
- rq.width = std::lrint (newWidth);
+ 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 visible_bell_color = 0;
- uint32_t previous_buttons = 0;
- int looper_locked_count = 0;
+ uint32_t previous_buttons;
+ int looper_locked_count;
BRegion sb_region;
+ BRegion invalid_region;
- BView *offscreen_draw_view = NULL;
- BBitmap *offscreen_draw_bitmap_1 = NULL;
- BBitmap *copy_bitmap = NULL;
+ BView *offscreen_draw_view;
+ BBitmap *offscreen_draw_bitmap_1;
+ BBitmap *copy_bitmap;
#ifdef USE_BE_CAIRO
- cairo_surface_t *cr_surface = NULL;
+ cairo_surface_t *cr_surface;
+ cairo_t *cr_context;
BLocker cr_surface_lock;
#endif
- BPoint tt_absl_pos;
+ BMessage *wait_for_release_message;
- color_space cspace;
-
- EmacsView () : BView (BRect (0, 0, 0, 0), "Emacs", B_FOLLOW_NONE, B_WILL_DRAW)
+ 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
- AttachedToWindow (void)
+ MessageReceived (BMessage *msg)
{
- cspace = B_RGBA32;
+ 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
@@ -993,8 +1590,10 @@ public:
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 ();
}
@@ -1014,6 +1613,10 @@ public:
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
@@ -1060,7 +1663,7 @@ public:
#endif
offscreen_draw_view->RemoveSelf ();
delete offscreen_draw_bitmap_1;
- offscreen_draw_bitmap_1 = new BBitmap (Frame (), cspace, 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");
@@ -1075,38 +1678,18 @@ public:
#endif
if (looper_locked_count)
- {
- offscreen_draw_bitmap_1->Lock ();
- }
+ offscreen_draw_bitmap_1->Lock ();
UnlockLooper ();
}
}
void
- Pulse (void)
- {
- visible_bell_color = 0;
- SetFlags (Flags () & ~B_PULSE_NEEDED);
- Window ()->SetPulseRate (0);
- Invalidate ();
- }
-
- void
Draw (BRect expose_bounds)
{
struct haiku_expose_event rq;
EmacsWindow *w = (EmacsWindow *) Window ();
- if (visible_bell_color > 0)
- {
- PushState ();
- BView_SetHighColorForVisibleBell (this, visible_bell_color);
- FillRect (Frame ());
- PopState ();
- return;
- }
-
if (w->shown_flag && offscreen_draw_view)
{
PushState ();
@@ -1143,18 +1726,6 @@ public:
}
void
- DoVisibleBell (uint32_t color)
- {
- if (!LockLooper ())
- gui_abort ("Failed to lock looper during visible bell");
- visible_bell_color = color | (255 << 24);
- SetFlags (Flags () | B_PULSE_NEEDED);
- Window ()->SetPulseRate (100 * 1000);
- Invalidate ();
- UnlockLooper ();
- }
-
- void
FlipBuffers (void)
{
if (!LockLooper ())
@@ -1162,7 +1733,6 @@ public:
if (!offscreen_draw_view)
gui_abort ("Failed to lock offscreen view during buffer flip");
- offscreen_draw_view->Flush ();
offscreen_draw_view->Sync ();
EmacsWindow *w = (EmacsWindow *) Window ();
@@ -1175,17 +1745,19 @@ public:
copy_bitmap = NULL;
}
if (!copy_bitmap)
- copy_bitmap = new BBitmap (offscreen_draw_bitmap_1);
+ {
+ 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");
- SetViewBitmap (copy_bitmap,
- Frame (), Frame (), B_FOLLOW_NONE, 0);
-
- Invalidate ();
+ Invalidate (&invalid_region);
+ invalid_region.MakeEmpty ();
UnlockLooper ();
return;
}
@@ -1198,7 +1770,7 @@ public:
if (offscreen_draw_view)
gui_abort ("Failed to lock offscreen view setting up double buffering");
- offscreen_draw_bitmap_1 = new BBitmap (Frame (), cspace, 1);
+ 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
@@ -1213,58 +1785,87 @@ public:
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 *msg)
+ 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.just_exited_p = transit == B_EXITED_VIEW;
rq.x = point.x;
rq.y = point.y;
- rq.be_code = transit;
- rq.window = this->Window ();
+ rq.window = window;
+ rq.time = system_time ();
- if (ToolTip ())
- ToolTip ()->SetMouseRelativeLocation (BPoint (-(point.x - tt_absl_pos.x),
- -(point.y - tt_absl_pos.y)));
+ 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 (movement_locker.Lock ())
+ if (!grab_view_locker.Lock ())
+ gui_abort ("Couldn't lock grab view locker");
+
+ if (grab_view && this != grab_view)
{
- haiku_write (MOUSE_MOTION, &rq);
- movement_locker.Unlock ();
+ grab_view_locker.Unlock ();
+ return;
}
+
+ grab_view_locker.Unlock ();
+
+ haiku_write (MOUSE_MOTION, &rq);
}
void
- MouseDown (BPoint point)
+ BasicMouseDown (BPoint point, BView *scroll_bar)
{
struct haiku_button_event rq;
- uint32 buttons;
+ 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.btn_no = 0;
+ rq.scroll_bar = scroll_bar;
- if (!(previous_buttons & B_PRIMARY_MOUSE_BUTTON) &&
- (buttons & B_PRIMARY_MOUSE_BUTTON))
+ 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))
+ 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))
+ else if (!(previous_buttons & B_TERTIARY_MOUSE_BUTTON)
+ && (buttons & B_TERTIARY_MOUSE_BUTTON))
rq.btn_no = 1;
+ else
+ return;
+
previous_buttons = buttons;
rq.x = point.x;
rq.y = point.y;
- uint32_t mods = modifiers ();
+ mods = modifiers ();
rq.modifiers = 0;
if (mods & B_SHIFT_KEY)
@@ -1279,21 +1880,46 @@ public:
if (mods & B_OPTION_KEY)
rq.modifiers |= HAIKU_MODIFIER_SUPER;
- SetMouseEventMask (B_POINTER_EVENTS, B_LOCK_WINDOW_FOCUS);
+ 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
- MouseUp (BPoint point)
+ MouseDown (BPoint point)
+ {
+ BasicMouseDown (point, NULL);
+ }
+
+ void
+ BasicMouseUp (BPoint point, BView *scroll_bar)
{
struct haiku_button_event rq;
- uint32 buttons;
+ 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.btn_no = 0;
+ rq.scroll_bar = scroll_bar;
if ((previous_buttons & B_PRIMARY_MOUSE_BUTTON)
&& !(buttons & B_PRIMARY_MOUSE_BUTTON))
@@ -1304,12 +1930,15 @@ public:
else if ((previous_buttons & B_TERTIARY_MOUSE_BUTTON)
&& !(buttons & B_TERTIARY_MOUSE_BUTTON))
rq.btn_no = 1;
+ else
+ return;
+
previous_buttons = buttons;
rq.x = point.x;
rq.y = point.y;
- uint32_t mods = modifiers ();
+ mods = modifiers ();
rq.modifiers = 0;
if (mods & B_SHIFT_KEY)
@@ -1324,56 +1953,326 @@ public:
if (mods & B_OPTION_KEY)
rq.modifiers |= HAIKU_MODIFIER_SUPER;
- if (!buttons)
- SetMouseEventMask (0, 0);
-
+ rq.time = system_time ();
haiku_write (BUTTON_UP, &rq);
}
+
+ void
+ MouseUp (BPoint point)
+ {
+ BasicMouseUp (point, NULL);
+ }
};
class EmacsScrollBar : public BScrollBar
{
public:
- void *scroll_bar;
-
- EmacsScrollBar (int x, int y, int x1, int y1, bool horizontal_p) :
- BScrollBar (BRect (x, y, x1, y1), NULL, NULL, 0, 0, horizontal_p ?
- B_HORIZONTAL : B_VERTICAL)
+ 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)
{
- this->SetRange (0, msg->GetInt32 ("emacs:range", 0));
- this->SetValue (msg->GetInt32 ("emacs:units", 0));
+ 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;
- rq.scroll_bar = scroll_bar;
- rq.position = new_value;
- haiku_write (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.scroll_bar = scroll_bar;
+ 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);
}
@@ -1381,12 +2280,119 @@ public:
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 = scroll_bar;
+ 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
@@ -1404,7 +2410,7 @@ public:
menu->PushState ();
menu->SetFont (be_bold_font);
- BView_SetHighColorForVisibleBell (menu, 0);
+ menu->SetHighColor (ui_color (B_MENU_ITEM_TEXT_COLOR));
BMenuItem::DrawContent ();
menu->PopState ();
}
@@ -1413,29 +2419,26 @@ public:
class EmacsMenuItem : public BMenuItem
{
public:
- int menu_bar_id = -1;
- void *wind_ptr = NULL;
- char *key = NULL;
- char *help = NULL;
-
- EmacsMenuItem (const char *ky,
- const char *str,
- const char *help,
- BMessage *message = NULL) : BMenuItem (str, message)
+ 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 (ky)
- {
- key = strdup (ky);
- if (!key)
- gui_abort ("strdup failed");
- }
+ if (key_label)
+ key = strdup (key_label);
if (help)
- {
- this->help = strdup (help);
- if (!this->help)
- gui_abort ("strdup failed");
- }
+ this->help = strdup (help);
}
~EmacsMenuItem ()
@@ -1455,11 +2458,17 @@ public:
if (key)
{
- BRect r = menu->Frame ();
- int w = menu->StringWidth (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 ();
}
}
@@ -1475,49 +2484,837 @@ public:
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 (menu_bar_id >= 0)
+ 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);
- haiku_write (MENU_BAR_HELP_EVENT, &rq);
+ 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);
+ }
+ }
}
- else if (help)
+
+ 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)
{
- Menu ()->SetToolTip (highlight_p ? help : NULL);
+ 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;
}
- BMenuItem::Highlight (highlight_p);
+ 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 EmacsPopUpMenu : public BPopUpMenu
+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:
- EmacsPopUpMenu (const char *name) : BPopUpMenu (name, 0)
+ 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
- FrameResized (float w, float h)
+ UpdatePreview (void)
{
- Invalidate ();
- BPopUpMenu::FrameResized (w, h);
+ 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 (!((Emacs *) data)->Lock ())
+ if (!app->Lock ())
gui_abort ("Failed to lock application");
- ((Emacs *) data)->Run ();
- ((Emacs *) data)->Unlock ();
+ app->Run ();
+ app->Unlock ();
return 0;
}
@@ -1587,44 +3384,58 @@ BBitmap_dimensions (void *bitmap, int *left, int *top,
*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)
{
- if (be_app)
- return be_app;
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_new (void **view)
{
- BWindow *window = new (std::nothrow) EmacsWindow;
- BView **v = (BView **) _view;
+ BWindow *window;
+ BView *vw;
+
+ window = new (std::nothrow) EmacsWindow;
if (!window)
{
- *v = NULL;
+ *view = NULL;
return window;
}
- BView *vw = new (std::nothrow) EmacsView;
+ vw = new (std::nothrow) EmacsView;
if (!vw)
{
- *v = NULL;
+ *view = NULL;
window->LockLooper ();
window->Quit ();
return NULL;
@@ -1638,15 +3449,17 @@ BWindow_new (void *_view)
the first time. */
window->UnlockLooper ();
window->AddChild (vw);
- *v = vw;
+ *view = vw;
return window;
}
void
BWindow_quit (void *window)
{
- ((BWindow *) window)->LockLooper ();
- ((BWindow *) window)->Quit ();
+ BWindow *w = (BWindow *) window;
+
+ w->LockLooper ();
+ w->Quit ();
}
/* Set WINDOW's offset to X, Y. */
@@ -1666,6 +3479,16 @@ BWindow_set_offset (void *window, int x, int y)
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)
@@ -1705,7 +3528,7 @@ BWindow_retitle (void *window, const char *title)
void
BWindow_resize (void *window, int width, int height)
{
- ((BWindow *) window)->ResizeTo (width, height);
+ ((BWindow *) window)->ResizeTo (width - 1, height - 1);
}
/* Activate WINDOW, making it the subject of keyboard focus and
@@ -1719,15 +3542,18 @@ BWindow_activate (void *window)
/* Return the pixel dimensions of the main screen in WIDTH and
HEIGHT. */
void
-BScreen_px_dim (int *width, int *height)
+be_get_screen_dimensions (int *width, int *height)
{
BScreen screen;
+ BRect frame;
+
if (!screen.IsValid ())
gui_abort ("Invalid screen");
- BRect frame = screen.Frame ();
- *width = frame.right - frame.left;
- *height = frame.bottom - frame.top;
+ frame = screen.Frame ();
+
+ *width = BE_RECT_WIDTH (frame);
+ *height = BE_RECT_HEIGHT (frame);
}
/* Resize VIEW to WIDTH, HEIGHT. */
@@ -1742,55 +3568,28 @@ BView_resize_to (void *view, int width, int height)
vw->UnlockLooper ();
}
-void *
-BCursor_create_default (void)
-{
- return new BCursor (B_CURSOR_ID_SYSTEM_DEFAULT);
-}
-
-void *
-BCursor_create_modeline (void)
-{
- return new BCursor (B_CURSOR_ID_CONTEXT_MENU);
-}
-
-void *
-BCursor_from_id (enum haiku_cursor cursor)
-{
- return new BCursor ((enum BCursorID) cursor);
-}
-
-void *
-BCursor_create_i_beam (void)
-{
- return new BCursor (B_CURSOR_ID_I_BEAM);
-}
-
-void *
-BCursor_create_progress_cursor (void)
+void
+be_delete_cursor (void *cursor)
{
- return new BCursor (B_CURSOR_ID_PROGRESS);
+ if (cursor)
+ delete (BCursor *) cursor;
}
void *
-BCursor_create_grab (void)
-{
- return new BCursor (B_CURSOR_ID_GRAB);
-}
-
-void
-BCursor_delete (void *cursor)
+be_create_cursor_from_id (int id)
{
- delete (BCursor *) cursor;
+ return new BCursor ((enum BCursorID) id);
}
void
BView_set_view_cursor (void *view, void *cursor)
{
- if (!((BView *) view)->LockLooper ())
+ BView *v = (BView *) view;
+
+ if (!v->LockLooper ())
gui_abort ("Failed to lock view setting cursor");
- ((BView *) view)->SetViewCursor ((BCursor *) cursor);
- ((BView *) view)->UnlockLooper ();
+ v->SetViewCursor ((BCursor *) cursor);
+ v->UnlockLooper ();
}
void
@@ -1799,88 +3598,24 @@ BWindow_Flush (void *window)
((BWindow *) window)->Flush ();
}
-/* Map the keycode KC, storing the result in CODE and 1 in
- NON_ASCII_P if it should be used. */
-void
-BMapKey (uint32_t kc, int *non_ascii_p, unsigned *code)
-{
- if (*code == 10 && kc != 0x42)
- {
- *code = XK_Return;
- *non_ascii_p = 1;
- return;
- }
-
- switch (kc)
- {
- default:
- *non_ascii_p = 0;
- if (kc < 0xe && kc > 0x1)
- {
- *code = XK_F1 + kc - 2;
- *non_ascii_p = 1;
- }
- return;
- case 0x1e:
- *code = XK_BackSpace;
- break;
- case 0x61:
- *code = XK_Left;
- break;
- case 0x63:
- *code = XK_Right;
- break;
- case 0x57:
- *code = XK_Up;
- break;
- case 0x62:
- *code = XK_Down;
- break;
- case 0x64:
- *code = XK_Insert;
- break;
- case 0x65:
- *code = XK_Delete;
- break;
- case 0x37:
- *code = XK_Home;
- break;
- case 0x58:
- *code = XK_End;
- break;
- case 0x39:
- *code = XK_Page_Up;
- break;
- case 0x5a:
- *code = XK_Page_Down;
- break;
- case 0x1:
- *code = XK_Escape;
- break;
- case 0x68:
- *code = XK_Menu;
- break;
- }
- *non_ascii_p = 1;
-}
-
/* Make a scrollbar, attach it to VIEW's window, and return it. */
void *
-BScrollBar_make_for_view (void *view, int horizontal_p,
- int x, int y, int x1, int y1,
- void *scroll_bar_ptr)
+be_make_scroll_bar_for_view (void *view, int horizontal_p,
+ int x, int y, int x1, int y1)
{
- EmacsScrollBar *sb = new EmacsScrollBar (x, y, x1, y1, horizontal_p);
- sb->scroll_bar = scroll_bar_ptr;
-
+ EmacsScrollBar *scroll_bar;
BView *vw = (BView *) view;
- BView *sv = (BView *) sb;
+
if (!vw->LockLooper ())
gui_abort ("Failed to lock scrollbar owner");
- vw->AddChild ((BView *) sb);
- sv->WindowActivated (vw->Window ()->IsActive ());
+
+ scroll_bar = new EmacsScrollBar (x, y, x1, y1, horizontal_p,
+ (EmacsView *) vw);
+
+ vw->AddChild (scroll_bar);
vw->UnlockLooper ();
- return sb;
+
+ return scroll_bar;
}
void
@@ -1906,19 +3641,25 @@ BView_move_frame (void *view, int x, int y, int x1, int y1)
gui_abort ("Failed to lock view moving frame");
vw->MoveTo (x, y);
vw->ResizeTo (x1 - x, y1 - y);
- vw->Flush ();
- vw->Sync ();
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)
+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);
}
@@ -1927,7 +3668,9 @@ BView_scroll_bar_update (void *sb, int portion, int whole, int position)
int
BScrollBar_default_size (int horizontal_p)
{
- return horizontal_p ? B_H_SCROLL_BAR_HEIGHT : B_V_SCROLL_BAR_WIDTH;
+ return be_control_look->GetScrollBarWidth (horizontal_p
+ ? B_HORIZONTAL
+ : B_VERTICAL);
}
/* Invalidate VIEW, causing it to be drawn again. */
@@ -1943,14 +3686,23 @@ BView_invalidate (void *view)
/* 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. */
+ 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)
+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);
@@ -1964,10 +3716,24 @@ BView_draw_lock (void *view)
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;
@@ -1991,53 +3757,25 @@ BWindow_center_on_screen (void *window)
w->CenterOnScreen ();
}
-/* Tell VIEW it has been clicked at X by Y. */
-void
-BView_mouse_down (void *view, int x, int y)
-{
- BView *vw = (BView *) view;
- if (vw->LockLooper ())
- {
- vw->MouseDown (BPoint (x, y));
- vw->UnlockLooper ();
- }
-}
-
-/* Tell VIEW the mouse has been released at X by Y. */
-void
-BView_mouse_up (void *view, int x, int y)
-{
- BView *vw = (BView *) view;
- if (vw->LockLooper ())
- {
- vw->MouseUp (BPoint (x, y));
- vw->UnlockLooper ();
- }
-}
-
-/* Tell VIEW that the mouse has moved to Y by Y. */
+/* Import fringe bitmap (short array, low bit rightmost) BITS into
+ BITMAP using the B_GRAY1 colorspace. */
void
-BView_mouse_moved (void *view, int x, int y, uint32_t transit)
-{
- BView *vw = (BView *) view;
- if (vw->LockLooper ())
- {
- vw->MouseMoved (BPoint (x, y), transit, NULL);
- vw->UnlockLooper ();
- }
-}
-
-/* Import BITS into BITMAP using the B_GRAY1 colorspace. */
-void
-BBitmap_import_mono_bits (void *bitmap, void *bits, int wd, int h)
+BBitmap_import_fringe_bitmap (void *bitmap, unsigned short *bits, int wd, int h)
{
BBitmap *bmp = (BBitmap *) bitmap;
unsigned char *data = (unsigned char *) bmp->Bits ();
- unsigned short *bts = (unsigned short *) bits;
+ int i;
- for (int i = 0; i < (h * (wd / 8)); i++)
+ for (i = 0; i < h; i++)
{
- *((unsigned short *) data) = bts[i];
+ if (wd <= 8)
+ data[0] = bits[i] & 0xff;
+ else
+ {
+ data[1] = bits[i] & 0xff;
+ data[0] = bits[i] >> 8;
+ }
+
data += bmp->BytesPerRow ();
}
}
@@ -2067,6 +3805,23 @@ BView_forget_scroll_bar (void *view, int x, int y, int width, int height)
}
}
+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)
{
@@ -2115,13 +3870,24 @@ BView_convert_from_screen (void *view, int *x, int *y)
void
BWindow_change_decoration (void *window, int decorate_p)
{
- BWindow *w = (BWindow *) window;
+ EmacsWindow *w = (EmacsWindow *) window;
if (!w->LockLooper ())
gui_abort ("Failed to lock window while changing its decorations");
- if (decorate_p)
- w->SetLook (B_TITLED_WINDOW_LOOK);
+
+ if (!w->override_redirect_p)
+ {
+ if (decorate_p)
+ w->SetLook (B_TITLED_WINDOW_LOOK);
+ else
+ w->SetLook (B_NO_BORDER_WINDOW_LOOK);
+ }
else
- w->SetLook (B_NO_BORDER_WINDOW_LOOK);
+ {
+ 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 ();
}
@@ -2129,11 +3895,16 @@ BWindow_change_decoration (void *window, int decorate_p)
void
BWindow_set_tooltip_decoration (void *window)
{
- BWindow *w = (BWindow *) 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->SetFeel (B_FLOATING_APP_WINDOW_FEEL);
+ w->SetFlags (B_NOT_ZOOMABLE
+ | B_NOT_MINIMIZABLE
+ | B_AVOID_FRONT
+ | B_AVOID_FOCUS);
w->UnlockLooper ();
}
@@ -2150,7 +3921,6 @@ BWindow_set_avoid_focus (void *window, int avoid_focus_p)
w->SetFlags (w->Flags () & ~B_AVOID_FOCUS);
else
w->SetFlags (w->Flags () | B_AVOID_FOCUS);
- w->Sync ();
w->UnlockLooper ();
}
@@ -2164,25 +3934,12 @@ BView_emacs_delete (void *view)
delete vw;
}
-/* Return the current workspace. */
-uint32_t
-haiku_current_workspace (void)
-{
- return current_workspace ();
-}
-
-/* Return a bitmask consisting of workspaces WINDOW is on. */
-uint32_t
-BWindow_workspaces (void *window)
-{
- return ((BWindow *) window)->Workspaces ();
-}
-
/* Create a popup menu. */
void *
BPopUpMenu_new (const char *name)
{
- BPopUpMenu *menu = new EmacsPopUpMenu (name);
+ BPopUpMenu *menu = new BPopUpMenu (name);
+
menu->SetRadioMode (0);
return menu;
}
@@ -2192,9 +3949,11 @@ BPopUpMenu_new (const char *name)
void
BMenu_add_title (void *menu, const char *text)
{
- EmacsTitleMenuItem *it = new EmacsTitleMenuItem (text);
- BMenu *mn = (BMenu *) menu;
- mn->AddItem (it);
+ BMenu *be_menu = (BMenu *) menu;
+ EmacsTitleMenuItem *it;
+
+ it = new EmacsTitleMenuItem (text);
+ be_menu->AddItem (it);
}
/* Add an item to the menu MENU. */
@@ -2216,6 +3975,7 @@ BMenu_add_item (void *menu, const char *label, void *ptr, bool enabled_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);
@@ -2260,20 +4020,120 @@ BMenu_new_menu_bar_submenu (void *menu, const char *label)
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)
+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);
- BMenuItem *it = mn->Go (BPoint (x, y));
- if (it)
+ 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)
{
- BMessage *mg = it->Message ();
- if (mg)
- return (void *) mg->GetPointer ("menuptr");
+ 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
- return NULL;
+ 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;
}
- return NULL;
}
/* Delete the entire menu hierarchy of MENU, and then delete MENU
@@ -2386,12 +4246,83 @@ BAlert_add_button (void *alert, const char *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_t
-BAlert_go (void *alert)
+int32
+BAlert_go (void *alert,
+ void (*block_input_function) (void),
+ void (*unblock_input_function) (void),
+ void (*process_pending_signals_function) (void))
{
- return ((BAlert *) alert)->Go ();
+ 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. */
@@ -2410,30 +4341,48 @@ BView_set_tooltip (void *view, const char *tooltip)
/* Set VIEW's tooltip to a sticky tooltip at X by Y. */
void
-BView_set_and_show_sticky_tooltip (void *view, const char *tooltip,
- int x, int y)
+be_show_sticky_tooltip (void *view, const char *tooltip_text,
+ int x, int y)
{
- BToolTip *tip;
- BView *vw = (BView *) view;
+ 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 (tooltip);
- tip = vw->ToolTip ();
- BPoint pt;
- EmacsView *ev = dynamic_cast<EmacsView *> (vw);
- if (ev)
- ev->tt_absl_pos = BPoint (x, y);
- vw->GetMouse (&pt, NULL, 1);
- pt.x -= x;
- pt.y -= y;
+ 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;
- pt.x = -pt.x;
- pt.y = -pt.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);
- tip->SetMouseRelativeLocation (pt);
- tip->SetSticky (1);
- vw->ShowToolTip (tip);
+ /* 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 ();
}
@@ -2444,25 +4393,32 @@ BAlert_delete (void *alert)
delete (BAlert *) alert;
}
-/* Place the resolution of the monitor in DPI in RSSX and RSSY. */
+/* Place the resolution of the monitor in DPI in X_OUT and Y_OUT. */
void
-BScreen_res (double *rrsx, double *rrsy)
+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");
- monitor_info i;
if (s.GetMonitorInfo (&i) == B_OK)
{
- *rrsx = (double) i.width / (double) 2.54;
- *rrsy = (double) i.height / (double) 2.54;
- }
- else
- {
- *rrsx = 72.27;
- *rrsy = 72.27;
+ 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
@@ -2493,6 +4449,8 @@ 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)
{
@@ -2506,7 +4464,10 @@ be_get_version_string (char *version, int len)
&& appFileInfo.GetVersionInfo (&versionInfo,
B_APP_VERSION_KIND) == B_OK
&& versionInfo.short_info[0] != '\0')
- std::strncpy (version, versionInfo.short_info, len - 1);
+ {
+ std::strncpy (version, versionInfo.short_info, len - 1);
+ version[len - 1] = '\0';
+ }
}
}
@@ -2515,24 +4476,35 @@ int
be_get_display_planes (void)
{
color_space space = dpy_color_space;
+ BScreen screen;
+
if (space == B_NO_COLOR_SPACE)
{
- BScreen screen; /* This is actually a very slow operation. */
if (!screen.IsValid ())
gui_abort ("Invalid screen");
+
space = dpy_color_space = screen.ColorSpace ();
}
- if (space == B_RGB32 || space == B_RGB24)
- return 24;
- if (space == B_RGB16)
- return 16;
- if (space == B_RGB15)
- return 15;
- if (space == B_CMAP8)
- return 8;
+ 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");
+ }
- 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;
@@ -2542,28 +4514,58 @@ be_get_display_planes (void)
int
be_get_display_color_cells (void)
{
+ BScreen screen;
color_space space = dpy_color_space;
+
if (space == B_NO_COLOR_SPACE)
{
- BScreen screen;
if (!screen.IsValid ())
gui_abort ("Invalid screen");
+
space = dpy_color_space = screen.ColorSpace ();
}
- if (space == B_RGB32 || space == B_RGB24)
- return 1677216;
- if (space == B_RGB16)
- return 65536;
- if (space == B_RGB15)
- return 32768;
- if (space == B_CMAP8)
- return 256;
+ 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");
+ }
- 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)
@@ -2655,159 +4657,74 @@ EmacsView_double_buffered_p (void *vw)
return db_p;
}
-struct popup_file_dialog_data
-{
- BMessage *msg;
- BFilePanel *panel;
- BEntry *entry;
-};
-
-static void
-unwind_popup_file_dialog (void *ptr)
-{
- struct popup_file_dialog_data *data =
- (struct popup_file_dialog_data *) ptr;
- BFilePanel *panel = data->panel;
- delete panel;
- delete data->entry;
- delete data->msg;
-}
-
-static void
-be_popup_file_dialog_safe_set_target (BFilePanel *dialog, BWindow *window)
-{
- dialog->SetTarget (BMessenger (window));
-}
-
/* Popup a file dialog. */
char *
-be_popup_file_dialog (int open_p, const char *default_dir, int must_match_p, int dir_only_p,
- void *window, const char *save_text, const char *prompt,
- void (*block_input_function) (void),
- void (*unblock_input_function) (void),
- void (*maybe_quit_function) (void))
-{
- ptrdiff_t idx = c_specpdl_idx_from_cxx ();
- /* setjmp/longjmp is UB with automatic objects. */
- block_input_function ();
- BWindow *w = (BWindow *) window;
- uint32_t mode = dir_only_p ? B_DIRECTORY_NODE : B_FILE_NODE | B_DIRECTORY_NODE;
- BEntry *path = new BEntry;
- BMessage *msg = new BMessage ('FPSE');
- BFilePanel *panel = new BFilePanel (open_p ? B_OPEN_PANEL : B_SAVE_PANEL,
- NULL, NULL, mode);
-
- struct popup_file_dialog_data dat;
- dat.entry = path;
- dat.msg = msg;
- dat.panel = panel;
-
- record_c_unwind_protect_from_cxx (unwind_popup_file_dialog, &dat);
- if (default_dir)
+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)
{
- if (path->SetTo (default_dir, 0) != B_OK)
- default_dir = NULL;
+ delete looper;
+ return NULL;
}
- panel->SetMessage (msg);
if (default_dir)
- panel->SetPanelDirectory (path);
- if (save_text)
- panel->SetSaveText (save_text);
- panel->SetHideWhenDone (0);
- panel->Window ()->SetTitle (prompt);
- be_popup_file_dialog_safe_set_target (panel, w);
-
- panel->Show ();
- unblock_input_function ();
-
- void *buf = alloca (200);
- while (1)
{
- enum haiku_event_type type;
- char *ptr = NULL;
+ if (path.SetTo (default_dir, 0) != B_OK)
+ default_dir = NULL;
+ }
- if (!haiku_read_with_timeout (&type, buf, 200, 100000))
- {
- block_input_function ();
- if (type != FILE_PANEL_EVENT)
- haiku_write (type, buf);
- else if (!ptr)
- ptr = (char *) ((struct haiku_file_panel_event *) buf)->ptr;
- unblock_input_function ();
+ panel_window = panel.Window ();
- maybe_quit_function ();
- }
+ if (default_dir)
+ panel.SetPanelDirectory (&path);
- ssize_t b_s;
- block_input_function ();
- haiku_read_size (&b_s);
- if (!b_s || ptr || panel->Window ()->IsHidden ())
- {
- c_unbind_to_nil_from_cxx (idx);
- unblock_input_function ();
- return ptr;
- }
- unblock_input_function ();
- }
-}
+ if (save_text)
+ panel.SetSaveText (save_text);
-void
-be_app_quit (void)
-{
- if (be_app)
- {
- while (!be_app->Lock ());
- be_app->Quit ();
- }
-}
+ panel_window->SetTitle (prompt);
+ panel_window->SetFeel (B_MODAL_APP_WINDOW_FEEL);
-/* Temporarily fill VIEW with COLOR. */
-void
-EmacsView_do_visible_bell (void *view, uint32_t color)
-{
- EmacsView *vw = (EmacsView *) view;
- vw->DoVisibleBell (color);
-}
+ panel.SetHideWhenDone (false);
+ panel.SetTarget (BMessenger (looper));
+ panel.SetMessage (&msg);
+ panel.Show ();
-/* Zoom WINDOW. */
-void
-BWindow_zoom (void *window)
-{
- BWindow *w = (BWindow *) window;
- w->Zoom ();
-}
+ looper->Run ();
+ file_name = looper->ReadFileName (process_pending_signals_function);
-/* Make WINDOW fullscreen if FULLSCREEN_P. */
-void
-EmacsWindow_make_fullscreen (void *window, int fullscreen_p)
-{
- EmacsWindow *w = (EmacsWindow *) window;
- w->MakeFullscreen (fullscreen_p);
-}
+ if (looper->Lock ())
+ looper->Quit ();
-/* Unzoom (maximize) WINDOW. */
-void
-EmacsWindow_unzoom (void *window)
-{
- EmacsWindow *w = (EmacsWindow *) window;
- w->UnZoom ();
+ return file_name;
}
-/* Move the pointer into MBAR and start tracking. */
-void
+/* 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;
- if (!mb->LockLooper ())
- gui_abort ("Couldn't lock menubar");
- BRect frame = mb->Frame ();
- BPoint pt = frame.LeftTop ();
- BPoint l = pt;
- mb->Parent ()->ConvertToScreen (&pt);
- set_mouse_position (pt.x, pt.y);
- mb->MouseDown (l);
- mb->UnlockLooper ();
+ BMessenger messenger (mb);
+ BMessage reply;
+
+ messenger.SendMessage (SHOW_MENU_BAR, &reply);
+
+ return reply.what == BE_MENU_BAR_OPEN;
}
#ifdef HAVE_NATIVE_IMAGE_API
@@ -2905,12 +4822,12 @@ BView_show_tooltip (void *view)
#ifdef USE_BE_CAIRO
-/* Return VIEW's cairo surface. */
-cairo_surface_t *
-EmacsView_cairo_surface (void *view)
+/* Return VIEW's cairo context. */
+cairo_t *
+EmacsView_cairo_context (void *view)
{
EmacsView *vw = (EmacsView *) view;
- return vw->cr_surface;
+ return vw->cr_context;
}
/* Transfer each clip rectangle in VIEW to the cairo context
@@ -2989,17 +4906,6 @@ be_get_display_screens (void)
}
/* Set the minimum width the user can resize WINDOW to. */
-void
-BWindow_set_min_size (void *window, int width, int height)
-{
- BWindow *w = (BWindow *) window;
-
- if (!w->LockLooper ())
- gui_abort ("Failed to lock window looper setting min size");
- w->SetSizeLimits (width, -1, height, -1);
- w->UnlockLooper ();
-}
-
/* Synchronize WINDOW's connection to the App Server. */
void
BWindow_sync (void *window)
@@ -3058,3 +4964,459 @@ be_use_subpixel_antialiasing (void)
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
index 6a99eb245dc..5f44494a8d3 100644
--- a/src/haiku_support.h
+++ b/src/haiku_support.h
@@ -34,21 +34,46 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <math.h>
+#include <kernel/OS.h>
+
enum haiku_cursor
{
- CURSOR_ID_NO_CURSOR = 12,
- CURSOR_ID_RESIZE_NORTH = 15,
- CURSOR_ID_RESIZE_EAST = 16,
- CURSOR_ID_RESIZE_SOUTH = 17,
- CURSOR_ID_RESIZE_WEST = 18,
- CURSOR_ID_RESIZE_NORTH_EAST = 19,
- CURSOR_ID_RESIZE_NORTH_WEST = 20,
- CURSOR_ID_RESIZE_SOUTH_EAST = 21,
- CURSOR_ID_RESIZE_SOUTH_WEST = 22,
- CURSOR_ID_RESIZE_NORTH_SOUTH = 23,
- CURSOR_ID_RESIZE_EAST_WEST = 24,
+ CURSOR_ID_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_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
@@ -74,19 +99,34 @@ enum haiku_event_type
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,
- FILE_PANEL_EVENT,
MENU_BAR_HELP_EVENT,
ZOOM_EVENT,
- REFS_EVENT,
- APP_QUIT_REQUESTED_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;
@@ -95,8 +135,8 @@ struct haiku_quit_requested_event
struct haiku_resize_event
{
void *window;
- float px_heightf;
- float px_widthf;
+ float width;
+ float height;
};
struct haiku_expose_event
@@ -108,12 +148,11 @@ struct haiku_expose_event
int height;
};
-struct haiku_refs_event
+struct haiku_drag_and_drop_event
{
void *window;
int x, y;
- /* Free this with free! */
- char *ref;
+ void *message;
};
struct haiku_app_quit_requested_event
@@ -121,18 +160,28 @@ struct haiku_app_quit_requested_event
char dummy;
};
-#define HAIKU_MODIFIER_ALT (1)
-#define HAIKU_MODIFIER_CTRL (1 << 1)
-#define HAIKU_MODIFIER_SHIFT (1 << 2)
-#define HAIKU_MODIFIER_SUPER (1 << 3)
+struct haiku_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;
- uint32_t mb_char;
- uint32_t unraw_mb_char;
- short kc;
+ unsigned keysym;
+ uint32_t multibyte_char;
+
+ /* Time the keypress occurred, in microseconds. */
+ bigtime_t time;
};
struct haiku_activation_event
@@ -147,16 +196,31 @@ struct haiku_mouse_motion_event
bool just_exited_p;
int x;
int y;
- uint32_t be_code;
+ 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
@@ -168,8 +232,9 @@ struct haiku_iconification_event
struct haiku_move_event
{
void *window;
- int x;
- int y;
+ int x, y;
+ int decorator_width;
+ int decorator_height;
};
struct haiku_wheel_move_event
@@ -186,35 +251,34 @@ struct haiku_menu_bar_select_event
void *ptr;
};
-struct haiku_file_panel_event
-{
- void *ptr;
-};
-
struct haiku_menu_bar_help_event
{
void *window;
int mb_idx;
+ void *data;
+ bool highlight_p;
};
struct haiku_zoom_event
{
void *window;
- int x;
- int y;
- int width;
- int height;
+ int fullscreen_mode;
};
-#define FSPEC_FAMILY 1
-#define FSPEC_STYLE (1 << 1)
-#define FSPEC_SLANT (1 << 2)
-#define FSPEC_WEIGHT (1 << 3)
-#define FSPEC_SPACING (1 << 4)
-#define FSPEC_WANTED (1 << 5)
-#define FSPEC_NEED_ONE_OF (1 << 6)
-#define FSPEC_WIDTH (1 << 7)
-#define FSPEC_LANGUAGE (1 << 8)
+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];
@@ -248,42 +312,124 @@ enum haiku_font_language
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 next two fields are only temporarily used during the font
- discovery process! Do not rely on them being correct outside
- BFont_find. */
+
+ /* 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;
- int weight;
+
+ /* Whether or the font is monospace. */
int mono_spacing_p;
- int want_chars_len;
- int need_one_of_len;
+
+ /* 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;
- uint32_t *wanted_chars;
- uint32_t *need_one_of;
+ /* 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;
@@ -296,21 +442,10 @@ struct haiku_menu_bar_state_event
void *window;
};
-#define HAIKU_THIN 0
-#define HAIKU_ULTRALIGHT 20
-#define HAIKU_EXTRALIGHT 40
-#define HAIKU_LIGHT 50
-#define HAIKU_SEMI_LIGHT 75
-#define HAIKU_REGULAR 100
-#define HAIKU_SEMI_BOLD 180
-#define HAIKU_BOLD 200
-#define HAIKU_EXTRA_BOLD 205
-#define HAIKU_ULTRA_BOLD 210
-#define HAIKU_BOOK 400
-#define HAIKU_HEAVY 800
-#define HAIKU_ULTRA_HEAVY 900
-#define HAIKU_BLACK 1000
-#define HAIKU_MEDIUM 2000
+struct haiku_session_manager_reply
+{
+ bool quit_reply;
+};
#ifdef __cplusplus
/* Haiku's built in Height and Width functions for calculating
@@ -330,577 +465,277 @@ struct haiku_menu_bar_state_event
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))
+#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 <pthread.h>
#include <OS.h>
#ifdef __cplusplus
- typedef void *haiku;
+typedef void *haiku;
- extern void
- haiku_put_pixel (haiku bitmap, int x, int y, unsigned long pixel);
-
- extern unsigned long
- haiku_get_pixel (haiku bitmap, int x, int y);
+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 void haiku_io_init (void);
- extern void haiku_io_init_in_app_thread (void);
-
- extern void
- haiku_read_size (ssize_t *len);
-
- extern int
- haiku_read (enum haiku_event_type *type, void *buf, ssize_t len);
-
- extern int
- haiku_read_with_timeout (enum haiku_event_type *type, void *buf, ssize_t len,
- time_t timeout);
-
- extern int
- haiku_write (enum haiku_event_type type, void *buf);
-
- extern int
- haiku_write_without_signal (enum haiku_event_type type, void *buf);
-
- extern void
- rgb_color_hsl (uint32_t rgb, double *h, double *s, double *l);
-
- extern void
- hsl_color_rgb (double h, double s, double l, uint32_t *rgb);
-
- extern void *
- BBitmap_new (int width, int height, int mono_p);
-
- extern void *
- BBitmap_data (void *bitmap);
-
- extern int
- BBitmap_convert (void *bitmap, void **new_bitmap);
-
- extern void
- BBitmap_free (void *bitmap);
-
- extern void
- BBitmap_dimensions (void *bitmap, int *left, int *top,
- int *right, int *bottom, int32_t *bytes_per_row,
- int *mono_p);
-
- extern void *
- BApplication_setup (void);
-
- extern void *
- BWindow_new (void *view);
-
- extern void
- BWindow_quit (void *window);
-
- extern void
- BWindow_set_offset (void *window, int x, int y);
-
- extern void
- BWindow_iconify (void *window);
-
- extern void
- BWindow_set_visible (void *window, int visible_p);
-
- extern void
- BFont_close (void *font);
-
- extern void
- BFont_dat (void *font, int *px_size, int *min_width, int *max_width,
- int *avg_width, int *height, int *space_width, int *ascent,
- int *descent, int *underline_position, int *underline_thickness);
-
- extern int
- BFont_have_char_p (void *font, int32_t chr);
-
- extern int
- BFont_have_char_block (void *font, int32_t beg, int32_t end);
-
- extern void
- BFont_char_bounds (void *font, const char *mb_str, int *advance,
- int *lb, int *rb);
-
- extern void
- BFont_nchar_bounds (void *font, const char *mb_str, int *advance,
- int *lb, int *rb, int32_t n);
-
- extern void
- BWindow_retitle (void *window, const char *title);
-
- extern void
- BWindow_resize (void *window, int width, int height);
-
- extern void
- BWindow_activate (void *window);
-
- extern void
- BView_StartClip (void *view);
-
- extern void
- BView_EndClip (void *view);
-
- extern void
- BView_SetHighColor (void *view, uint32_t color);
-
- extern void
- BView_SetHighColorForVisibleBell (void *view, uint32_t color);
-
- extern void
- BView_FillRectangleForVisibleBell (void *view, int x, int y, int width,
- int height);
-
- extern void
- BView_SetLowColor (void *view, uint32_t color);
-
- extern void
- BView_SetPenSize (void *view, int u);
-
- extern void
- BView_SetFont (void *view, void *font);
-
- extern void
- BView_MovePenTo (void *view, int x, int y);
-
- extern void
- BView_DrawString (void *view, const char *chr, ptrdiff_t len);
-
- extern void
- BView_DrawChar (void *view, char chr);
-
- extern void
- BView_FillRectangle (void *view, int x, int y, int width, int height);
-
- extern void
- BView_FillRectangleAbs (void *view, int x, int y, int x1, int y1);
-
- extern void
- BView_FillTriangle (void *view, int x1, int y1,
- int x2, int y2, int x3, int y3);
-
- extern void
- BView_StrokeRectangle (void *view, int x, int y, int width, int height);
-
- extern void
- BView_SetViewColor (void *view, uint32_t color);
-
- extern void
- BView_ClipToRect (void *view, int x, int y, int width, int height);
-
- extern void
- BView_ClipToInverseRect (void *view, int x, int y, int width, int height);
-
- extern void
- BView_StrokeLine (void *view, int sx, int sy, int tx, int ty);
-
- extern void
- BView_CopyBits (void *view, int x, int y, int width, int height,
- int tox, int toy, int towidth, int toheight);
-
- extern void
- BView_DrawBitmap (void *view, void *bitmap, int x, int y,
- int width, int height, int vx, int vy, int vwidth,
- int vheight);
-
- extern void
- BView_DrawBitmapWithEraseOp (void *view, void *bitmap, int x,
- int y, int width, int height);
-
- extern void
- BView_DrawMask (void *src, void *view,
- int x, int y, int width, int height,
- int vx, int vy, int vwidth, int vheight,
- uint32_t color);
-
- extern void *
- BBitmap_transform_bitmap (void *bitmap, void *mask, uint32_t m_color,
- double rot, int desw, int desh);
-
- extern void
- BScreen_px_dim (int *width, int *height);
-
- extern void
- BView_resize_to (void *view, int width, int height);
-
- /* Functions for creating and freeing cursors. */
- extern void *
- BCursor_create_default (void);
-
- extern void *
- BCursor_from_id (enum haiku_cursor cursor);
-
- extern void *
- BCursor_create_modeline (void);
-
- extern void *
- BCursor_create_i_beam (void);
-
- extern void *
- BCursor_create_progress_cursor (void);
-
- extern void *
- BCursor_create_grab (void);
-
- extern void
- BCursor_delete (void *cursor);
-
- extern void
- BView_set_view_cursor (void *view, void *cursor);
-
- extern void
- BWindow_Flush (void *window);
-
- extern void
- BMapKey (uint32_t kc, int *non_ascii_p, unsigned *code);
-
- extern void *
- BScrollBar_make_for_view (void *view, int horizontal_p,
- int x, int y, int x1, int y1,
- void *scroll_bar_ptr);
-
- extern void
- BScrollBar_delete (void *sb);
-
- extern void
- BView_move_frame (void *view, int x, int y, int x1, int y1);
-
- extern void
- BView_scroll_bar_update (void *sb, int portion, int whole, int position);
-
- extern int
- BScrollBar_default_size (int horizontal_p);
-
- extern void
- BView_invalidate (void *view);
-
- extern void
- BView_draw_lock (void *view);
-
- extern void
- BView_draw_unlock (void *view);
-
- extern void
- BWindow_center_on_screen (void *window);
-
- extern void
- BView_mouse_moved (void *view, int x, int y, uint32_t transit);
-
- extern void
- BView_mouse_down (void *view, int x, int y);
-
- extern void
- BView_mouse_up (void *view, int x, int y);
-
- extern void
- BBitmap_import_mono_bits (void *bitmap, void *bits, int wd, int h);
-
- extern void
- haiku_font_pattern_free (struct haiku_font_pattern *pt);
-
- extern struct haiku_font_pattern *
- BFont_find (struct haiku_font_pattern *pt);
-
- extern int
- BFont_open_pattern (struct haiku_font_pattern *pat, void **font, float size);
-
- extern void
- BFont_populate_fixed_family (struct haiku_font_pattern *ptn);
-
- extern void
- BFont_populate_plain_family (struct haiku_font_pattern *ptn);
-
- extern void
- BView_publish_scroll_bar (void *view, int x, int y, int width, int height);
-
- extern void
- BView_forget_scroll_bar (void *view, int x, int y, int width, int height);
-
- extern void
- BView_get_mouse (void *view, int *x, int *y);
-
- extern void
- BView_convert_to_screen (void *view, int *x, int *y);
-
- extern void
- BView_convert_from_screen (void *view, int *x, int *y);
-
- extern void
- BWindow_change_decoration (void *window, int decorate_p);
-
- extern void
- BWindow_set_tooltip_decoration (void *window);
-
- extern void
- BWindow_set_avoid_focus (void *window, int avoid_focus_p);
-
- extern void
- BView_emacs_delete (void *view);
-
- extern uint32_t
- haiku_current_workspace (void);
-
- extern uint32_t
- BWindow_workspaces (void *window);
-
- extern void *
- BPopUpMenu_new (const char *name);
-
- extern 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);
-
- extern void
- BMenu_add_separator (void *menu);
-
- extern void *
- BMenu_new_submenu (void *menu, const char *label, bool enabled_p);
-
- extern void *
- BMenu_new_menu_bar_submenu (void *menu, const char *label);
-
- extern int
- BMenu_count_items (void *menu);
-
- extern void *
- BMenu_item_at (void *menu, int idx);
-
- extern void *
- BMenu_run (void *menu, int x, int y);
-
- extern void
- BPopUpMenu_delete (void *menu);
-
- extern void *
- BMenuBar_new (void *view);
-
- extern void
- BMenu_delete_all (void *menu);
-
- extern void
- BMenuBar_delete (void *menubar);
-
- extern void
- BMenu_item_set_label (void *item, const char *label);
-
- extern void *
- BMenu_item_get_menu (void *item);
-
- extern void
- BMenu_delete_from (void *menu, int start, int count);
-
- extern void
- haiku_ring_bell (void);
-
- extern void *
- BAlert_new (const char *text, enum haiku_alert_type type);
-
- extern void *
- BAlert_add_button (void *alert, const char *text);
-
- extern int32_t
- BAlert_go (void *alert);
-
- extern void
- BButton_set_enabled (void *button, int enabled_p);
-
- extern void
- BView_set_tooltip (void *view, const char *tooltip);
-
- extern void
- BAlert_delete (void *alert);
-
- extern void
- BScreen_res (double *rrsx, double *rrsy);
-
- extern void
- EmacsWindow_parent_to (void *window, void *other_window);
-
- extern void
- EmacsWindow_unparent (void *window);
-
- extern int
- BFont_string_width (void *font, const char *utf8);
-
- extern void
- be_get_version_string (char *version, int len);
-
- extern int
- be_get_display_planes (void);
-
- extern int
- be_get_display_color_cells (void);
-
- extern void
- be_warp_pointer (int x, int y);
-
- extern void
- EmacsWindow_move_weak_child (void *window, void *child, int xoff, int yoff);
-
- extern void
- EmacsView_set_up_double_buffering (void *vw);
-
- extern void
- EmacsView_disable_double_buffering (void *vw);
-
- extern void
- EmacsView_flip_and_blit (void *vw);
-
- extern int
- EmacsView_double_buffered_p (void *vw);
-
- extern char *
- be_popup_file_dialog (int open_p, const char *default_dir, int must_match_p,
- int dir_only_p, void *window, const char *save_text,
- const char *prompt,
- void (*block_input_function) (void),
- void (*unblock_input_function) (void),
- void (*maybe_quit_function) (void));
-
- extern void
- record_c_unwind_protect_from_cxx (void (*) (void *), void *);
-
- extern ptrdiff_t
- c_specpdl_idx_from_cxx (void);
-
- extern void
- c_unbind_to_nil_from_cxx (ptrdiff_t idx);
-
- extern void
- EmacsView_do_visible_bell (void *view, uint32_t color);
-
- extern void
- BWindow_zoom (void *window);
-
- extern void
- EmacsWindow_make_fullscreen (void *window, int fullscreen_p);
-
- extern void
- EmacsWindow_unzoom (void *window);
+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 *mime);
-
- extern void *
- be_translate_bitmap_from_file_name (const char *filename);
-
- extern void *
- be_translate_bitmap_from_memory (const void *buf, size_t bytes);
+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 void
- BMenuBar_start_tracking (void *mbar);
-
- extern size_t
- BBitmap_bytes_length (void *bitmap);
-
- extern void
- BView_show_tooltip (void *view);
+extern bool BMenuBar_start_tracking (void *);
+extern size_t BBitmap_bytes_length (void *);
#ifdef USE_BE_CAIRO
- extern cairo_surface_t *
- EmacsView_cairo_surface (void *view);
-
- extern void
- BView_cr_dump_clipping (void *view, cairo_t *ctx);
-
- extern void
- EmacsWindow_begin_cr_critical_section (void *window);
-
- extern void
- EmacsWindow_end_cr_critical_section (void *window);
+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
- BView_set_and_show_sticky_tooltip (void *view, const char *tooltip,
- int x, int y);
-
- extern void
- BMenu_add_title (void *menu, const char *text);
-
- extern int
- be_plain_font_height (void);
-
- extern int
- be_string_width_with_plain_font (const char *str);
-
- extern int
- be_get_display_screens (void);
-
- extern void
- BWindow_set_min_size (void *window, int width, int height);
-
- extern void
- BWindow_set_size_alignment (void *window, int align_width, int align_height);
-
- extern void
- BWindow_sync (void *window);
-
- extern void
- BWindow_send_behind (void *window, void *other_window);
-
- extern bool
- BWindow_is_active (void *window);
-
- extern bool
- be_use_subpixel_antialiasing (void);
-
+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 void *
- find_appropriate_view_for_draw (void *vw);
}
-extern _Noreturn void
-gui_abort (const char *msg);
+extern _Noreturn void gui_abort (const char *);
+extern void *find_appropriate_view_for_draw (void *);
#endif /* _cplusplus */
-/* Borrowed from X.Org keysymdef.h */
-#define XK_BackSpace 0xff08 /* Back space, back char */
-#define XK_Tab 0xff09
-#define XK_Linefeed 0xff0a /* Linefeed, LF */
-#define XK_Clear 0xff0b
-#define XK_Return 0xff0d /* Return, enter */
-#define XK_Pause 0xff13 /* Pause, hold */
-#define XK_Scroll_Lock 0xff14
-#define XK_Sys_Req 0xff15
-#define XK_Escape 0xff1b
-#define XK_Delete 0xffff /* Delete, rubout */
-#define XK_Home 0xff50
-#define XK_Left 0xff51 /* Move left, left arrow */
-#define XK_Up 0xff52 /* Move up, up arrow */
-#define XK_Right 0xff53 /* Move right, right arrow */
-#define XK_Down 0xff54 /* Move down, down arrow */
-#define XK_Prior 0xff55 /* Prior, previous */
-#define XK_Page_Up 0xff55
-#define XK_Next 0xff56 /* Next */
-#define XK_Page_Down 0xff56
-#define XK_End 0xff57 /* EOL */
-#define XK_Begin 0xff58 /* BOL */
-#define XK_Select 0xff60 /* Select, mark */
-#define XK_Print 0xff61
-#define XK_Execute 0xff62 /* Execute, run, do */
-#define XK_Insert 0xff63 /* Insert, insert here */
-#define XK_Undo 0xff65
-#define XK_Redo 0xff66 /* Redo, again */
-#define XK_Menu 0xff67
-#define XK_Find 0xff68 /* Find, search */
-#define XK_Cancel 0xff69 /* Cancel, stop, abort, exit */
-#define XK_Help 0xff6a /* Help */
-#define XK_Break 0xff6b
-#define XK_Mode_switch 0xff7e /* Character set switch */
-#define XK_script_switch 0xff7e /* Alias for mode_switch */
-#define XK_Num_Lock 0xff7f
-#define XK_F1 0xffbe
-
#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
index 4a0d2272d08..e0a65b499f4 100644
--- a/src/haikufns.c
+++ b/src/haikufns.c
@@ -34,6 +34,9 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "haiku_support.h"
#include "termhooks.h"
+#include "bitmaps/leftptr.xbm"
+#include "bitmaps/leftpmsk.xbm"
+
#include <stdlib.h>
#include <kernel/OS.h>
@@ -45,7 +48,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#define BLUE_FROM_ULONG(color) ((color) & 0xff)
/* The frame of the currently visible tooltip. */
-static Lisp_Object tip_frame;
+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. */
@@ -64,11 +70,10 @@ 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 *f, Lisp_Object arg, Lisp_Object oldval);
-static void
-haiku_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name);
+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
@@ -94,7 +99,7 @@ get_geometry_from_preferences (struct haiku_display_info *dpyinfo,
Lisp_Object value
= gui_display_get_arg (dpyinfo, parms, r[i].tem, r[i].val, r[i].cls,
RES_TYPE_NUMBER);
- if (! EQ (value, Qunbound))
+ if (! BASE_EQ (value, Qunbound))
parms = Fcons (Fcons (r[i].tem, value), parms);
}
}
@@ -102,6 +107,22 @@ get_geometry_from_preferences (struct haiku_display_info *dpyinfo,
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)
{
@@ -250,12 +271,32 @@ haiku_set_tab_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
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;
+ 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))
{
@@ -272,10 +313,11 @@ haiku_get_color (const char *name, Emacs_Color *color)
tem = x_display_list->color_map;
for (; CONSP (tem); tem = XCDR (tem))
{
- Lisp_Object col = XCAR (tem);
+ col = XCAR (tem);
+
if (CONSP (col) && !xstrcasecmp (SSDATA (XCAR (col)), name))
{
- int32_t clr = XFIXNUM (XCDR (col));
+ clr = XFIXNUM (XCDR (col));
color->pixel = clr;
color->red = RED_FROM_ULONG (clr) * 257;
color->green = GREEN_FROM_ULONG (clr) * 257;
@@ -284,11 +326,34 @@ haiku_get_color (const char *name, Emacs_Color *color)
return 0;
}
}
-
unblock_input ();
}
- return 1;
+ 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 *
@@ -296,15 +361,15 @@ haiku_display_info_for_name (Lisp_Object name)
{
CHECK_STRING (name);
- if (!NILP (Fstring_equal (name, build_string ("be"))))
+ if (!strcmp (SSDATA (name), "be"))
{
- if (!x_display_list)
+ if (x_display_list)
return x_display_list;
- error ("Be windowing not initialized");
+ return haiku_term_init ();
}
- error ("Be displays can only be named \"be\"");
+ error ("Haiku displays can only be named \"be\"");
}
static struct haiku_display_info *
@@ -321,14 +386,14 @@ check_haiku_display_info (Lisp_Object object)
else if (x_display_list)
dpyinfo = x_display_list;
else
- error ("Be windowing not present");
+ 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 Be display", t->id);
+ error ("Terminal %d is not a Haiku display", t->id);
dpyinfo = t->display_info.haiku;
}
@@ -396,8 +461,8 @@ haiku_set_child_frame_border_width (struct frame *f,
}
static void
-haiku_set_parent_frame (struct frame *f,
- Lisp_Object new_value, Lisp_Object old_value)
+haiku_set_parent_frame (struct frame *f, Lisp_Object new_value,
+ Lisp_Object old_value)
{
struct frame *p = NULL;
block_input ();
@@ -418,19 +483,68 @@ haiku_set_parent_frame (struct frame *f,
}
if (!NILP (old_value))
- EmacsWindow_unparent (FRAME_HAIKU_WINDOW (f));
+ {
+ 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);
@@ -439,15 +553,22 @@ haiku_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
static void
haiku_set_no_accept_focus (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
{
- block_input ();
if (!EQ (new_value, old_value))
FRAME_NO_ACCEPT_FOCUS (f) = !NILP (new_value);
+ block_input ();
if (FRAME_HAIKU_WINDOW (f))
- {
- BWindow_set_avoid_focus (FRAME_HAIKU_WINDOW (f),
- FRAME_NO_ACCEPT_FOCUS (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 ();
}
@@ -499,37 +620,34 @@ unwind_create_tip_frame (Lisp_Object frame)
tip_frame = Qnil;
}
-static void
-haiku_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
+static unsigned long
+haiku_decode_color (struct frame *f, Lisp_Object color_name)
{
- struct haiku_output *output = FRAME_OUTPUT_DATA (f);
- unsigned long old_fg;
+ Emacs_Color cdef;
- Emacs_Color color;
+ CHECK_STRING (color_name);
- if (haiku_get_color (SSDATA (arg), &color))
- {
- store_frame_param (f, Qforeground_color, oldval);
- unblock_input ();
- error ("Bad color");
- }
+ 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) = color.pixel;
+ FRAME_FOREGROUND_PIXEL (f) = fg;
+ output = FRAME_OUTPUT_DATA (f);
if (FRAME_HAIKU_WINDOW (f))
{
-
- block_input ();
if (output->cursor_color.pixel == old_fg)
- {
- output->cursor_color.pixel = old_fg;
- output->cursor_color.red = RED_FROM_ULONG (old_fg);
- output->cursor_color.green = GREEN_FROM_ULONG (old_fg);
- output->cursor_color.blue = BLUE_FROM_ULONG (old_fg);
- }
-
- unblock_input ();
+ haiku_query_color (fg, &output->cursor_color);
update_face_from_frame_parameter (f, Qforeground_color, arg);
@@ -538,35 +656,38 @@ haiku_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval
}
}
-static void
-unwind_popup (void)
-{
- if (!popup_activated_p)
- emacs_abort ();
- --popup_activated_p;
-}
-
static Lisp_Object
-haiku_create_frame (Lisp_Object parms, int ttip_p)
+haiku_create_frame (Lisp_Object parms)
{
- struct frame *f;
+ struct frame *f, *cascade_target;
Lisp_Object frame, tem;
Lisp_Object name;
bool minibuffer_only = false;
- bool face_change_before = face_change;
long window_prompting = 0;
- ptrdiff_t count = SPECPDL_INDEX ();
+ specpdl_ref count = SPECPDL_INDEX ();
Lisp_Object display;
struct haiku_display_info *dpyinfo = NULL;
struct kboard *kb;
+ if (x_display_list->focused_frame)
+ cascade_target = x_display_list->focused_frame;
+ else if (x_display_list->focus_event_frame)
+ cascade_target = x_display_list->focus_event_frame;
+ else
+ cascade_target = NULL;
+
+ /* Always cascade from the most toplevel frame. */
+
+ while (cascade_target && FRAME_PARENT_FRAME (cascade_target))
+ cascade_target = FRAME_PARENT_FRAME (cascade_target);
+
parms = Fcopy_alist (parms);
Vx_resource_name = Vinvocation_name;
display = gui_display_get_arg (dpyinfo, parms, Qterminal, 0, 0,
RES_TYPE_STRING);
- if (EQ (display, Qunbound))
+ if (BASE_EQ (display, Qunbound))
display = Qnil;
dpyinfo = check_haiku_display_info (display);
kb = dpyinfo->terminal->kboard;
@@ -577,15 +698,13 @@ haiku_create_frame (Lisp_Object parms, int ttip_p)
name = gui_display_get_arg (dpyinfo, parms, Qname, 0, 0,
RES_TYPE_STRING);
if (!STRINGP (name)
- && ! EQ (name, Qunbound)
+ && ! BASE_EQ (name, Qunbound)
&& ! NILP (name))
error ("Invalid frame name--not a string or nil");
if (STRINGP (name))
Vx_resource_name = name;
- block_input ();
-
/* 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. */
@@ -593,10 +712,8 @@ haiku_create_frame (Lisp_Object parms, int ttip_p)
tem = gui_display_get_arg (dpyinfo, parms, Qminibuffer,
"minibuffer", "Minibuffer",
RES_TYPE_SYMBOL);
- if (ttip_p)
- f = make_frame (0);
- else if (EQ (tem, Qnone) || NILP (tem))
- f = make_frame_without_minibuffer (Qnil, kb, display);
+ if (EQ (tem, Qnone) || NILP (tem))
+ f = make_frame_without_minibuffer (Qnil, kb, display);
else if (EQ (tem, Qonly))
{
f = make_minibuffer_frame ();
@@ -606,41 +723,30 @@ haiku_create_frame (Lisp_Object parms, int ttip_p)
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->pending_zoom_x = INT_MIN;
- f->output_data.haiku->pending_zoom_y = INT_MIN;
- f->output_data.haiku->pending_zoom_width = INT_MIN;
- f->output_data.haiku->pending_zoom_height = INT_MIN;
-
- if (ttip_p)
- f->wants_modeline = false;
+ 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) || ttip_p)
+ 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. */
- if (!ttip_p)
- record_unwind_protect (unwind_create_frame, frame);
- else
- record_unwind_protect (unwind_create_tip_frame, frame);
-
- FRAME_OUTPUT_DATA (f)->parent_desc = NULL;
- FRAME_OUTPUT_DATA (f)->explicit_parent = 0;
+ record_unwind_protect (unwind_create_frame, frame);
/* Set the name; the functions to which we pass f expect the name to
be set. */
- if (EQ (name, Qunbound) || NILP (name) || ! STRINGP (name))
+ if (BASE_EQ (name, Qunbound) || NILP (name) || ! STRINGP (name))
{
fset_name (f, Vinvocation_name);
f->explicit_name = 0;
@@ -660,8 +766,6 @@ haiku_create_frame (Lisp_Object parms, int ttip_p)
#endif
register_font_driver (&haikufont_driver, f);
- f->tooltip = ttip_p;
-
image_cache_refcount =
FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
@@ -670,21 +774,25 @@ haiku_create_frame (Lisp_Object parms, int ttip_p)
FRAME_RIF (f)->default_font_parameter (f, parms);
- unblock_input ();
+ 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 (ttip_p ? 1 : 2),
+ 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);
+ 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, !ttip_p ? Qt : Qnil,
+ 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,
@@ -694,13 +802,15 @@ haiku_create_frame (Lisp_Object parms, int ttip_p)
"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, ttip_p ? Qnil : Qt,
+ gui_default_parameter (f, parms, Qno_special_glyphs, Qnil,
NULL, NULL, RES_TYPE_BOOLEAN);
init_frame_faces (f);
@@ -714,120 +824,72 @@ haiku_create_frame (Lisp_Object parms, int ttip_p)
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);
- if (!ttip_p)
- {
- gui_default_parameter (f, parms, Qz_group, Qnil, NULL, NULL, RES_TYPE_SYMBOL);
- gui_default_parameter (f, parms, Qno_focus_on_map, Qnil,
- NULL, NULL, RES_TYPE_BOOLEAN);
- gui_default_parameter (f, parms, Qno_accept_focus, Qnil,
- NULL, NULL, RES_TYPE_BOOLEAN);
-
- /* The resources controlling the menu-bar, tool-bar, and tab-bar are
- processed specially at startup, and reflected in the mode
- variables; ignore them here. */
- gui_default_parameter (f, parms, Qmenu_bar_lines,
- NILP (Vmenu_bar_mode)
- ? make_fixnum (0) : make_fixnum (1),
- NULL, NULL, RES_TYPE_NUMBER);
- gui_default_parameter (f, parms, Qtab_bar_lines,
- NILP (Vtab_bar_mode)
- ? make_fixnum (0) : make_fixnum (1),
- NULL, NULL, RES_TYPE_NUMBER);
- gui_default_parameter (f, parms, Qtool_bar_lines,
- NILP (Vtool_bar_mode)
- ? make_fixnum (0) : make_fixnum (1),
- NULL, NULL, RES_TYPE_NUMBER);
- gui_default_parameter (f, parms, Qbuffer_predicate, Qnil, "bufferPredicate",
- "BufferPredicate", RES_TYPE_SYMBOL);
- gui_default_parameter (f, parms, Qtitle, Qnil, "title", "Title",
- RES_TYPE_STRING);
- }
+ 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);
- if (ttip_p)
- {
- /* No fringes on tip frame. */
- f->fringe_cols = 0;
- f->left_fringe_width = 0;
- f->right_fringe_width = 0;
- /* No dividers on tip frame. */
- f->right_divider_width = 0;
- f->bottom_divider_width = 0;
- }
-
tem = gui_display_get_arg (dpyinfo, parms, Qunsplittable, 0, 0,
RES_TYPE_BOOLEAN);
- f->no_split = minibuffer_only || (!EQ (tem, Qunbound) && !NILP (tem));
-
- /* Add `tooltip' frame parameter's default value. */
- if (NILP (Fframe_parameter (frame, Qtooltip)) && ttip_p)
- Fmodify_frame_parameters (frame, Fcons (Fcons (Qtooltip, Qt), Qnil));
-
-#define ASSIGN_CURSOR(cursor, be_cursor) \
- (FRAME_OUTPUT_DATA (f)->cursor = be_cursor)
-
- ASSIGN_CURSOR (text_cursor, BCursor_create_i_beam ());
- ASSIGN_CURSOR (nontext_cursor, BCursor_create_default ());
- ASSIGN_CURSOR (modeline_cursor, BCursor_create_modeline ());
- ASSIGN_CURSOR (hand_cursor, BCursor_create_grab ());
- ASSIGN_CURSOR (hourglass_cursor, BCursor_create_progress_cursor ());
- ASSIGN_CURSOR (horizontal_drag_cursor,
- BCursor_from_id (CURSOR_ID_RESIZE_EAST_WEST));
- ASSIGN_CURSOR (vertical_drag_cursor,
- BCursor_from_id (CURSOR_ID_RESIZE_NORTH_SOUTH));
- ASSIGN_CURSOR (left_edge_cursor,
- BCursor_from_id (CURSOR_ID_RESIZE_WEST));
- ASSIGN_CURSOR (top_left_corner_cursor,
- BCursor_from_id (CURSOR_ID_RESIZE_NORTH_WEST));
- ASSIGN_CURSOR (top_edge_cursor,
- BCursor_from_id (CURSOR_ID_RESIZE_NORTH));
- ASSIGN_CURSOR (top_right_corner_cursor,
- BCursor_from_id (CURSOR_ID_RESIZE_NORTH_EAST));
- ASSIGN_CURSOR (right_edge_cursor,
- BCursor_from_id (CURSOR_ID_RESIZE_EAST));
- ASSIGN_CURSOR (bottom_right_corner_cursor,
- BCursor_from_id (CURSOR_ID_RESIZE_SOUTH_EAST));
- ASSIGN_CURSOR (bottom_edge_cursor,
- BCursor_from_id (CURSOR_ID_RESIZE_SOUTH));
- ASSIGN_CURSOR (bottom_left_corner_cursor,
- BCursor_from_id (CURSOR_ID_RESIZE_SOUTH_WEST));
- ASSIGN_CURSOR (no_cursor,
- BCursor_from_id (CURSOR_ID_NO_CURSOR));
-
- ASSIGN_CURSOR (current_cursor, FRAME_OUTPUT_DATA (f)->text_cursor);
-#undef ASSIGN_CURSOR
-
-
- if (ttip_p)
- f->no_split = true;
+ 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"));
- if (!minibuffer_only && !ttip_p && FRAME_EXTERNAL_MENU_BAR (f))
+ block_input ();
+ if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
initialize_frame_menubar (f);
-
- FRAME_OUTPUT_DATA (f)->window_desc = FRAME_OUTPUT_DATA (f)->window;
+ unblock_input ();
Vframe_list = Fcons (frame, Vframe_list);
- Lisp_Object parent_frame = gui_display_get_arg (dpyinfo, parms, Qparent_frame, NULL, NULL,
+ Lisp_Object parent_frame = gui_display_get_arg (dpyinfo, parms,
+ Qparent_frame, NULL, NULL,
RES_TYPE_SYMBOL);
- if (EQ (parent_frame, Qunbound)
+ 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);
@@ -835,106 +897,325 @@ haiku_create_frame (Lisp_Object parms, int ttip_p)
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);
- if (ttip_p)
- {
- gui_default_parameter (f, parms, Qundecorated, Qt, NULL, NULL, RES_TYPE_BOOLEAN);
- gui_default_parameter (f, parms, Qno_accept_focus, Qt, NULL, NULL,
- RES_TYPE_BOOLEAN);
- }
- else
- {
- 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, Qfullscreen, Qnil,
- "fullscreen", "Fullscreen", 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);
- if (ttip_p)
- {
- 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);
- }
- }
-
- if (ttip_p)
- face_change = face_change_before;
-
f->can_set_window_size = true;
adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f),
- 0, true, ttip_p ? Qtip_frame : Qx_create_frame_2);
+ 0, true, Qx_create_frame_2);
- if (!FRAME_OUTPUT_DATA (f)->explicit_parent && !ttip_p)
- {
- Lisp_Object visibility;
+ Lisp_Object visibility;
- visibility = gui_display_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
- RES_TYPE_SYMBOL);
- if (EQ (visibility, Qunbound))
- visibility = Qt;
- if (EQ (visibility, Qicon))
- haiku_iconify_frame (f);
- else if (!NILP (visibility))
- haiku_visualize_frame (f);
- else /* Qnil */
- {
- f->was_invisible = true;
- }
- }
-
- if (!ttip_p)
+ 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 */
{
- 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);
+ 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;
- if (ttip_p)
- adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f),
- 0, true, Qtip_frame);
+ 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,
@@ -959,7 +1240,11 @@ compute_tip_xy (struct frame *f,
/* Default min and max values. */
min_x = 0;
min_y = 0;
- BScreen_px_dim (&max_x, &max_y);
+
+ 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);
@@ -1005,16 +1290,17 @@ compute_tip_xy (struct frame *f,
static Lisp_Object
haiku_hide_tip (bool delete)
{
+ Lisp_Object it, frame;
+
if (!NILP (tip_timer))
{
call1 (Qcancel_timer, tip_timer);
tip_timer = Qnil;
}
- Lisp_Object it, frame;
FOR_EACH_FRAME (it, frame)
- if (FRAME_WINDOW_P (XFRAME (frame)) &&
- FRAME_HAIKU_VIEW (XFRAME (frame)))
+ if (FRAME_WINDOW_P (XFRAME (frame))
+ && FRAME_HAIKU_VIEW (XFRAME (frame)))
BView_set_tooltip (FRAME_HAIKU_VIEW (XFRAME (frame)), NULL);
if (NILP (tip_frame)
@@ -1023,10 +1309,9 @@ haiku_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);
@@ -1065,14 +1350,34 @@ haiku_set_undecorated (struct frame *f, Lisp_Object new_value,
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;
- int nlines;
+
if (TYPE_RANGED_FIXNUMP (int, value))
nlines = XFIXNUM (value);
else
@@ -1080,9 +1385,6 @@ haiku_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval
fset_redisplay (f);
- FRAME_MENU_BAR_LINES (f) = 0;
- FRAME_MENU_BAR_HEIGHT (f) = 0;
-
if (nlines)
{
FRAME_EXTERNAL_MENU_BAR (f) = 1;
@@ -1091,11 +1393,14 @@ haiku_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval
}
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;
- if (FRAME_HAIKU_P (f))
- FRAME_HAIKU_MENU_BAR (f) = 0;
+ FRAME_HAIKU_MENU_BAR (f) = 0;
}
adjust_frame_glyphs (f);
@@ -1109,112 +1414,129 @@ haiku_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval
static Lisp_Object
frame_geometry (Lisp_Object frame, Lisp_Object attribute)
{
- struct frame *f = decode_live_frame (frame);
- check_window_system (f);
+ 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 (f->left_pos, f->top_pos,
- f->left_pos, f->top_pos);
+ return list4i (outer_x, outer_y,
+ outer_x + outer_width,
+ outer_y + outer_height);
else if (EQ (attribute, Qnative_edges))
- return list4i (f->left_pos, f->top_pos,
- f->left_pos + FRAME_PIXEL_WIDTH (f),
- f->top_pos + FRAME_PIXEL_HEIGHT (f));
+ 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 (f->left_pos + FRAME_INTERNAL_BORDER_WIDTH (f),
- f->top_pos + FRAME_INTERNAL_BORDER_WIDTH (f) +
- FRAME_MENU_BAR_HEIGHT (f) + FRAME_TOOL_BAR_HEIGHT (f),
- f->left_pos - FRAME_INTERNAL_BORDER_WIDTH (f) +
- FRAME_PIXEL_WIDTH (f),
- f->top_pos + FRAME_PIXEL_HEIGHT (f) -
- FRAME_INTERNAL_BORDER_WIDTH (f));
+ 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 (f->left_pos),
- make_fixnum (f->top_pos))),
- Fcons (Qouter_size,
- Fcons (make_fixnum (FRAME_PIXEL_WIDTH (f)),
- make_fixnum (FRAME_PIXEL_HEIGHT (f)))),
- Fcons (Qexternal_border_size,
- Fcons (make_fixnum (0), make_fixnum (0))),
- Fcons (Qtitle_bar_size,
- Fcons (make_fixnum (0), make_fixnum (0))),
- Fcons (Qmenu_bar_external, Qnil),
- Fcons (Qmenu_bar_size, Fcons (make_fixnum (FRAME_PIXEL_WIDTH (f) -
- (FRAME_INTERNAL_BORDER_WIDTH (f) * 2)),
- make_fixnum (FRAME_MENU_BAR_HEIGHT (f)))),
- Fcons (Qtool_bar_external, Qnil),
- Fcons (Qtool_bar_position, Qtop),
- Fcons (Qtool_bar_size, Fcons (make_fixnum (FRAME_PIXEL_WIDTH (f) -
- (FRAME_INTERNAL_BORDER_WIDTH (f) * 2)),
- make_fixnum (FRAME_TOOL_BAR_HEIGHT (f)))),
- Fcons (Qinternal_border_width, make_fixnum (FRAME_INTERNAL_BORDER_WIDTH (f))));
+ 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)
{
- CHECK_STRING (arg);
+ unsigned long background;
- block_input ();
- Emacs_Color color;
+ background = haiku_decode_color (f, arg);
- if (haiku_get_color (SSDATA (arg), &color))
- {
- store_frame_param (f, Qbackground_color, oldval);
- unblock_input ();
- error ("Bad color");
- }
-
- FRAME_OUTPUT_DATA (f)->cursor_fg = color.pixel;
- FRAME_BACKGROUND_PIXEL (f) = color.pixel;
+ FRAME_OUTPUT_DATA (f)->cursor_fg = background;
+ FRAME_BACKGROUND_PIXEL (f) = background;
if (FRAME_HAIKU_VIEW (f))
{
- struct face *defface;
-
- BView_draw_lock (FRAME_HAIKU_VIEW (f));
- BView_SetViewColor (FRAME_HAIKU_VIEW (f), color.pixel);
+ 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));
- defface = FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID);
- if (defface)
- {
- defface->background = color.pixel;
- update_face_from_frame_parameter (f, Qbackground_color, arg);
- clear_frame (f);
- }
- }
+ FRAME_OUTPUT_DATA (f)->cursor_fg = background;
+ update_face_from_frame_parameter (f, Qbackground_color, arg);
- if (FRAME_VISIBLE_P (f))
- SET_FRAME_GARBAGED (f);
- unblock_input ();
+ if (FRAME_VISIBLE_P (f))
+ redraw_frame (f);
+ }
}
void
haiku_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
- CHECK_STRING (arg);
+ unsigned long fore_pixel, pixel;
- block_input ();
- Emacs_Color color;
+ pixel = haiku_decode_color (f, arg);
- if (haiku_get_color (SSDATA (arg), &color))
+ if (!NILP (Vx_cursor_fore_pixel))
{
- store_frame_param (f, Qcursor_color, oldval);
- unblock_input ();
- error ("Bad color");
+ 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));
- FRAME_CURSOR_COLOR (f) = color;
if (FRAME_VISIBLE_P (f))
{
- gui_update_cursor (f, 0);
- gui_update_cursor (f, 1);
+ gui_update_cursor (f, false);
+ gui_update_cursor (f, true);
}
+
update_face_from_frame_parameter (f, Qcursor_color, arg);
- unblock_input ();
}
void
@@ -1228,11 +1550,7 @@ haiku_get_pixel (haiku bitmap, int x, int y)
{
unsigned char *data;
int32_t bytes_per_row;
- int mono_p;
- int left;
- int right;
- int top;
- int bottom;
+ int mono_p, left, right, top, bottom, byte;
data = BBitmap_data (bitmap);
BBitmap_dimensions (bitmap, &left, &top, &right, &bottom,
@@ -1244,20 +1562,17 @@ haiku_get_pixel (haiku bitmap, int x, int y)
if (!mono_p)
return ((uint32_t *) (data + (bytes_per_row * y)))[x];
- int byte = y * bytes_per_row + x / 8;
+ 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;
+ unsigned char *data, *byte;
int32_t bytes_per_row;
- int mono_p;
- int left;
- int right;
- int top;
- int bottom;
+ int mono_p, left, right, top, bottom;
+ ptrdiff_t off, bit, xoff;
data = BBitmap_data (bitmap);
BBitmap_dimensions (bitmap, &left, &top, &right, &bottom,
@@ -1268,11 +1583,11 @@ haiku_put_pixel (haiku bitmap, int x, int y, unsigned long pixel)
if (mono_p)
{
- ptrdiff_t off = y * bytes_per_row;
- ptrdiff_t bit = x % 8;
- ptrdiff_t xoff = x / 8;
+ off = y * bytes_per_row;
+ bit = x % 8;
+ xoff = x / 8;
- unsigned char *byte = data + off + xoff;
+ byte = data + off + xoff;
if (!pixel)
*byte &= ~(1 << bit);
else
@@ -1301,6 +1616,7 @@ haiku_free_frame_resources (struct frame *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)
@@ -1339,24 +1655,8 @@ haiku_free_frame_resources (struct frame *f)
if (window)
BWindow_quit (window);
- /* Free cursors */
-
- BCursor_delete (f->output_data.haiku->text_cursor);
- BCursor_delete (f->output_data.haiku->nontext_cursor);
- BCursor_delete (f->output_data.haiku->modeline_cursor);
- BCursor_delete (f->output_data.haiku->hand_cursor);
- BCursor_delete (f->output_data.haiku->hourglass_cursor);
- BCursor_delete (f->output_data.haiku->horizontal_drag_cursor);
- BCursor_delete (f->output_data.haiku->vertical_drag_cursor);
- BCursor_delete (f->output_data.haiku->left_edge_cursor);
- BCursor_delete (f->output_data.haiku->top_left_corner_cursor);
- BCursor_delete (f->output_data.haiku->top_edge_cursor);
- BCursor_delete (f->output_data.haiku->top_right_corner_cursor);
- BCursor_delete (f->output_data.haiku->right_edge_cursor);
- BCursor_delete (f->output_data.haiku->bottom_right_corner_cursor);
- BCursor_delete (f->output_data.haiku->bottom_edge_cursor);
- BCursor_delete (f->output_data.haiku->bottom_left_corner_cursor);
- BCursor_delete (f->output_data.haiku->no_cursor);
+ 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;
@@ -1370,13 +1670,11 @@ haiku_iconify_frame (struct frame *frame)
if (FRAME_ICONIFIED_P (frame))
return;
- block_input ();
-
SET_FRAME_VISIBLE (frame, false);
SET_FRAME_ICONIFIED (frame, true);
+ block_input ();
BWindow_iconify (FRAME_HAIKU_WINDOW (frame));
-
unblock_input ();
}
@@ -1418,13 +1716,15 @@ haiku_unvisualize_frame (struct frame *f)
}
void
-haiku_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
+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))
@@ -1472,28 +1772,33 @@ check_x_display_info (Lisp_Object object)
return check_haiku_display_info (object);
}
-/* Rename frame F to NAME. If NAME is nil, set F's name to "GNU
- Emacs". If EXPLICIT_P is non-zero, that indicates Lisp code is
- setting the name, not redisplay; in that case, set F's name to NAME
- and set F->explicit_name; if NAME is nil, clear F->explicit_name.
+/* 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 = 24;
+ update_mode_lines = 37;
f->explicit_name = !NILP (name);
}
else if (f->explicit_name)
return;
+ dpyinfo = FRAME_DISPLAY_INFO (f);
+
if (NILP (name))
- name = build_unibyte_string ("GNU Emacs");
+ name = dpyinfo->default_name;
if (!NILP (Fstring_equal (name, f->name)))
return;
@@ -1512,27 +1817,304 @@ haiku_set_inhibit_double_buffering (struct frame *f,
Lisp_Object old_value)
{
block_input ();
-#ifndef USE_BE_CAIRO
if (FRAME_HAIKU_WINDOW (f))
{
+#ifndef USE_BE_CAIRO
if (NILP (new_value))
- {
#endif
- EmacsView_set_up_double_buffering (FRAME_HAIKU_VIEW (f));
- if (!NILP (old_value))
- {
- SET_FRAME_GARBAGED (f);
- expose_frame (f, 0, 0, 0, 0);
- }
+ 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",
@@ -1563,19 +2145,15 @@ the mouse cursor position in pixels relative to a position (0, 0) of the
selected frame's display. */)
(void)
{
- if (!x_display_list)
- return Qnil;
-
struct frame *f = SELECTED_FRAME ();
+ void *view;
+ int x, y;
- if (FRAME_INITIAL_P (f) || !FRAME_HAIKU_P (f)
- || !FRAME_HAIKU_VIEW (f))
+ if (FRAME_INITIAL_P (f) || !FRAME_HAIKU_P (f))
return Qnil;
block_input ();
- void *view = FRAME_HAIKU_VIEW (f);
-
- int x, y;
+ view = FRAME_HAIKU_VIEW (f);
BView_get_mouse (view, &x, &y);
BView_convert_to_screen (view, &x, &y);
unblock_input ();
@@ -1587,7 +2165,9 @@ DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
doc: /* SKIP: real doc in xfns.c. */)
(Lisp_Object terminal)
{
- return Qt;
+ 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,
@@ -1595,6 +2175,7 @@ DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
(Lisp_Object color, Lisp_Object frame)
{
Emacs_Color col;
+
CHECK_STRING (color);
decode_window_system_frame (frame);
@@ -1606,17 +2187,19 @@ DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
(Lisp_Object color, Lisp_Object frame)
{
Emacs_Color col;
+ int rc;
+
CHECK_STRING (color);
decode_window_system_frame (frame);
block_input ();
- if (haiku_get_color (SSDATA (color), &col))
- {
- unblock_input ();
- return Qnil;
- }
+ rc = haiku_get_color (SSDATA (color), &col);
unblock_input ();
- return list3i (lrint (col.red), lrint (col.green), lrint (col.blue));
+
+ 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,
@@ -1624,25 +2207,34 @@ DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
doc: /* SKIP: real doc in xfns.c. */)
(Lisp_Object terminal)
{
- return Qnil;
+ 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. */)
+ 1, 3, 0, doc: /* SKIP: real doc in xfns.c. */)
(Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed)
{
- struct haiku_display_info *dpy_info;
CHECK_STRING (display);
if (NILP (Fstring_equal (display, build_string ("be"))))
- !NILP (must_succeed) ? fatal ("Bad display") : error ("Bad display");
- dpy_info = haiku_term_init ();
+ {
+ if (!NILP (must_succeed))
+ fatal ("Invalid display %s", SDATA (display));
+ else
+ signal_error ("Invalid display", display);
+ }
- if (!dpy_info)
- !NILP (must_succeed) ? fatal ("Display not responding") :
- error ("Display not responding");
+ 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;
}
@@ -1652,10 +2244,10 @@ DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
(Lisp_Object terminal)
{
+ int width, height;
check_haiku_display_info (terminal);
- int width, height;
- BScreen_px_dim (&width, &height);
+ be_get_screen_dimensions (&width, &height);
return make_fixnum (width);
}
@@ -1665,11 +2257,11 @@ DEFUN ("x-display-pixel-height", Fx_display_pixel_height, Sx_display_pixel_heigh
(Lisp_Object terminal)
{
+ int width, height;
check_haiku_display_info (terminal);
- int width, height;
- BScreen_px_dim (&width, &height);
- return make_fixnum (width);
+ 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,
@@ -1677,10 +2269,9 @@ DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1,
(Lisp_Object terminal)
{
struct haiku_display_info *dpyinfo = check_haiku_display_info (terminal);
-
int width, height;
- BScreen_px_dim (&width, &height);
+ be_get_screen_dimensions (&width, &height);
return make_fixnum (height / (dpyinfo->resy / 25.4));
}
@@ -1690,11 +2281,10 @@ DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
(Lisp_Object terminal)
{
struct haiku_display_info *dpyinfo = check_haiku_display_info (terminal);
-
int width, height;
- BScreen_px_dim (&width, &height);
- return make_fixnum (height / (dpyinfo->resy / 25.4));
+ be_get_screen_dimensions (&width, &height);
+ return make_fixnum (width / (dpyinfo->resx / 25.4));
}
DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
@@ -1702,7 +2292,7 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
doc: /* SKIP: real doc in xfns.c. */)
(Lisp_Object parms)
{
- return haiku_create_frame (parms, 0);
+ return haiku_create_frame (parms);
}
DEFUN ("x-display-visual-class", Fx_display_visual_class,
@@ -1710,16 +2300,20 @@ DEFUN ("x-display-visual-class", Fx_display_visual_class,
doc: /* SKIP: real doc in xfns.c. */)
(Lisp_Object terminal)
{
+ int planes;
+ bool grayscale_p;
+
check_haiku_display_info (terminal);
- int planes = be_get_display_planes ();
+ grayscale_p = be_is_display_grayscale ();
+ if (grayscale_p)
+ return Qstatic_gray;
+ planes = be_get_display_planes ();
if (planes == 8)
- return intern ("static-color");
- else if (planes == 16 || planes == 15)
- return intern ("pseudo-color");
+ return Qstatic_color;
- return intern ("direct-color");
+ return Qtrue_color;
}
DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
@@ -1727,31 +2321,30 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
(Lisp_Object string, Lisp_Object frame, Lisp_Object parms,
Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
{
- struct frame *tip_f;
+ 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;
- ptrdiff_t count = SPECPDL_INDEX ();
- ptrdiff_t count_1;
+ 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;
- decode_window_system_frame (frame);
+ 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);
@@ -1763,7 +2356,10 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
else
CHECK_FIXNUM (dy);
- if (haiku_use_system_tooltips)
+ tip_dx = dx;
+ tip_dy = dy;
+
+ if (use_system_tooltips)
{
int root_x, root_y;
CHECK_STRING (string);
@@ -1796,8 +2392,8 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
reliable way to get it. */
compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
BView_convert_from_screen (FRAME_HAIKU_VIEW (f), &root_x, &root_y);
- BView_set_and_show_sticky_tooltip (FRAME_HAIKU_VIEW (f), SSDATA (string),
- root_x, root_y);
+ be_show_sticky_tooltip (FRAME_HAIKU_VIEW (f), SSDATA (string),
+ root_x, root_y);
unblock_input ();
goto start_timer;
}
@@ -1806,24 +2402,21 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
{
if (FRAME_VISIBLE_P (XFRAME (tip_frame))
&& EQ (frame, tip_last_frame)
- && !NILP (Fequal_including_properties (string, tip_last_string))
- && !NILP (Fequal (parms, tip_last_parms)))
+ && !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))
{
- Lisp_Object timer = tip_timer;
-
+ call1 (Qcancel_timer, tip_timer);
tip_timer = Qnil;
- call1 (Qcancel_timer, timer);
}
block_input ();
compute_tip_xy (tip_f, parms, dx, dy, FRAME_PIXEL_WIDTH (tip_f),
FRAME_PIXEL_HEIGHT (tip_f), &root_x, &root_y);
- haiku_set_offset (tip_f, root_x, root_y, 1);
- haiku_visualize_frame (tip_f);
+ BWindow_set_offset (FRAME_HAIKU_WINDOW (tip_f), root_x, root_y);
unblock_input ();
goto start_timer;
@@ -1834,8 +2427,8 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
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. */
+ 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);
@@ -1861,8 +2454,9 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
call2 (Qassq_delete_all, parm, tip_last_parms);
}
- /* Now check if there's a parameter left in tip_last_parms with a
- non-nil value. */
+ /* 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);
@@ -1888,10 +2482,6 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
tip_last_string = string;
tip_last_parms = parms;
- /* Block input until the tip has been fully drawn, to avoid crashes
- when drawing tips in menus. */
- block_input ();
-
if (NILP (tip_frame) || !FRAME_LIVE_P (XFRAME (tip_frame)))
{
/* Add default values to frame parameters. */
@@ -1902,21 +2492,16 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
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);
+ 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
+ /* Create a frame for the tooltip, and record it in the global
variable tip_frame. */
-
- if (NILP (tip_frame = haiku_create_frame (parms, 1)))
- {
- /* Creating the tip frame failed. */
- unblock_input ();
- return unbind_to (count, Qnil);
- }
+ if (NILP (tip_frame = haiku_create_tip_frame (parms)))
+ /* Creating the tip frame failed. */
+ return unbind_to (count, Qnil);
}
tip_f = XFRAME (tip_frame);
@@ -1956,12 +2541,12 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
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) = WINDOW_TOTAL_COLS (w);
+ FRAME_TOTAL_COLS (tip_f) = w->total_cols;
adjust_frame_glyphs (tip_f);
- /* Insert STRING into the root window's buffer and fit the frame to
- the buffer. */
- count_1 = SPECPDL_INDEX ();
+ /* 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);
@@ -1981,22 +2566,39 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
/* 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);
- BWindow_resize (FRAME_HAIKU_WINDOW (tip_f), width, height);
- haiku_set_offset (tip_f, root_x, root_y, 1);
- BWindow_set_tooltip_decoration (FRAME_HAIKU_WINDOW (tip_f));
+
+ /* 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 (XFRAME (frame))->current_cursor);
- SET_FRAME_VISIBLE (tip_f, 1);
- BWindow_set_visible (FRAME_HAIKU_WINDOW (tip_f), 1);
+ 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;
- flush_frame (tip_f);
update_single_window (w);
+ flush_frame (tip_f);
set_buffer_internal_1 (old_buffer);
unbind_to (count_1, Qnil);
- unblock_input ();
windows_or_buffers_changed = old_windows_or_buffers_changed;
start_timer:
@@ -2094,8 +2696,7 @@ DEFUN ("x-double-buffered-p", Fx_double_buffered_p, Sx_double_buffered_p,
doc: /* SKIP: real doc in xfns.c. */)
(Lisp_Object frame)
{
- struct frame *f = decode_live_frame (frame);
- check_window_system (f);
+ struct frame *f = decode_window_system_frame (frame);
return EmacsView_double_buffered_p (FRAME_HAIKU_VIEW (f)) ? Qt : Qnil;
}
@@ -2105,13 +2706,14 @@ DEFUN ("x-display-backing-store", Fx_display_backing_store, Sx_display_backing_s
doc: /* SKIP: real doc in xfns.c. */)
(Lisp_Object terminal)
{
+ struct frame *f;
+
if (FRAMEP (terminal))
{
- CHECK_LIVE_FRAME (terminal);
- struct frame *f = decode_window_system_frame (terminal);
+ f = decode_window_system_frame (terminal);
- if (FRAME_HAIKU_VIEW (f) &&
- EmacsView_double_buffered_p (FRAME_HAIKU_VIEW (f)))
+ 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;
@@ -2202,16 +2804,21 @@ 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)
+ (Lisp_Object prompt, Lisp_Object frame, Lisp_Object dir,
+ Lisp_Object mustmatch, Lisp_Object dir_only_p, Lisp_Object save_text)
{
- ptrdiff_t idx;
- if (!x_display_list)
- error ("Be windowing not initialized");
+ 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);
+ {
+ CHECK_STRING (dir);
+ dir = ENCODE_FILE (dir);
+ }
if (!NILP (save_text))
CHECK_STRING (save_text);
@@ -2221,37 +2828,28 @@ Optional arg SAVE_TEXT, if non-nil, specifies some text to show in the entry fie
CHECK_STRING (prompt);
- CHECK_LIVE_FRAME (frame);
- check_window_system (XFRAME (frame));
-
- idx = SPECPDL_INDEX ();
- record_unwind_protect_void (unwind_popup);
-
- struct frame *f = XFRAME (frame);
-
- FRAME_DISPLAY_INFO (f)->focus_event_frame = f;
+ f = decode_window_system_frame (frame);
++popup_activated_p;
- char *fn = be_popup_file_dialog (!NILP (mustmatch) || !NILP (dir_only_p),
- !NILP (dir) ? SSDATA (ENCODE_UTF_8 (dir)) : NULL,
- !NILP (mustmatch), !NILP (dir_only_p),
- FRAME_HAIKU_WINDOW (f),
- !NILP (save_text) ? SSDATA (ENCODE_UTF_8 (save_text)) : NULL,
- SSDATA (ENCODE_UTF_8 (prompt)),
- block_input, unblock_input, maybe_quit);
-
- unbind_to (idx, Qnil);
+ 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;
- block_input ();
- BWindow_activate (FRAME_HAIKU_WINDOW (f));
- unblock_input ();
+ if (!file_name)
+ quit ();
- if (!fn)
- return Qnil;
+ value = build_string (file_name);
+ free (file_name);
- Lisp_Object p = build_string_from_utf8 (fn);
- free (fn);
- return p;
+ return DECODE_FILE (value);
}
DEFUN ("haiku-put-resource", Fhaiku_put_resource, Shaiku_put_resource,
@@ -2301,6 +2899,7 @@ Frames are listed from topmost (first) to bottommost (last). */)
if (NILP (sel))
return frames;
+
return Fcons (sel, frames);
}
@@ -2309,13 +2908,15 @@ DEFUN ("x-display-save-under", Fx_display_save_under,
doc: /* SKIP: real doc in xfns.c. */)
(Lisp_Object terminal)
{
+ struct frame *f;
check_haiku_display_info (terminal);
if (FRAMEP (terminal))
{
- struct frame *f = decode_window_system_frame (terminal);
- return FRAME_HAIKU_VIEW (f) && EmacsView_double_buffered_p (FRAME_HAIKU_VIEW (f)) ?
- Qt : Qnil;
+ f = decode_window_system_frame (terminal);
+ return ((FRAME_HAIKU_VIEW (f)
+ && EmacsView_double_buffered_p (FRAME_HAIKU_VIEW (f)))
+ ? Qt : Qnil);
}
return Qnil;
@@ -2330,13 +2931,10 @@ 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)
+ (Lisp_Object frame1, Lisp_Object frame2, Lisp_Object above)
{
- struct frame *f1 = decode_live_frame (frame1);
- struct frame *f2 = decode_live_frame (frame2);
-
- check_window_system (f1);
- check_window_system (f2);
+ struct frame *f1 = decode_window_system_frame (frame1);
+ struct frame *f2 = decode_window_system_frame (frame2);
block_input ();
@@ -2382,6 +2980,81 @@ Some window managers may refuse to restack windows. */)
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,
@@ -2400,7 +3073,7 @@ frame_parm_handler haiku_frame_parm_handlers[] =
gui_set_right_divider_width,
gui_set_bottom_divider_width,
haiku_set_menu_bar_lines,
- NULL, /* set mouse color */
+ haiku_set_mouse_color,
haiku_explicitly_set_name,
gui_set_scroll_bar_width,
gui_set_scroll_bar_height,
@@ -2421,7 +3094,7 @@ frame_parm_handler haiku_frame_parm_handlers[] =
gui_set_fullscreen,
gui_set_font_backend,
gui_set_alpha,
- NULL, /* set sticky */
+ haiku_set_sticky,
NULL, /* set tool bar pos */
haiku_set_inhibit_double_buffering,
haiku_set_undecorated,
@@ -2429,9 +3102,10 @@ frame_parm_handler haiku_frame_parm_handlers[] =
NULL, /* set skip taskbar */
haiku_set_no_focus_on_map,
haiku_set_no_accept_focus,
- NULL, /* set z group */
- NULL, /* set override redir */
- gui_set_no_special_glyphs
+ haiku_set_z_group,
+ haiku_set_override_redirect,
+ gui_set_no_special_glyphs,
+ gui_set_alpha_background,
};
void
@@ -2444,6 +3118,14 @@ syms_of_haikufns (void)
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);
@@ -2477,6 +3159,8 @@ syms_of_haikufns (void)
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);
@@ -2488,18 +3172,37 @@ syms_of_haikufns (void)
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_BOOL ("haiku-use-system-tooltips", haiku_use_system_tooltips,
- doc: /* When non-nil, Emacs will display tooltips using the App Kit.
-This can avoid a great deal of consing that does not play
-well with the Haiku memory allocator, but comes with the
-disadvantage of not being able to use special display properties
-within tooltips. */);
- haiku_use_system_tooltips = 1;
+ 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,
diff --git a/src/haikufont.c b/src/haikufont.c
index e08792be4b3..3e7f6f86dcb 100644
--- a/src/haikufont.c
+++ b/src/haikufont.c
@@ -29,6 +29,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "fontset.h"
#include "haikuterm.h"
#include "character.h"
+#include "coding.h"
#include "font.h"
#include "termchar.h"
#include "pdumper.h"
@@ -136,7 +137,7 @@ haikufont_apply_registry (struct haiku_font_pattern *pattern,
for (l = 0; uniquifier[l]; ++l);
- uint32_t *a = xmalloc (l * sizeof *a);
+ int *a = xmalloc (l * sizeof *a);
for (l = 0; uniquifier[l]; ++l)
a[l] = uniquifier[l];
@@ -148,6 +149,7 @@ haikufont_apply_registry (struct haiku_font_pattern *pattern,
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;
@@ -182,7 +184,7 @@ haikufont_get_fallback_entity (void)
ASET (ent, FONT_FOUNDRY_INDEX, Qhaiku);
ASET (ent, FONT_FAMILY_INDEX, Qnil);
ASET (ent, FONT_ADSTYLE_INDEX, Qnil);
- ASET (ent, FONT_REGISTRY_INDEX, Qutf_8);
+ 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));
@@ -206,8 +208,6 @@ haikufont_weight_to_lisp (int weight)
{
case HAIKU_THIN:
return Qthin;
- case HAIKU_ULTRALIGHT:
- return Qultra_light;
case HAIKU_EXTRALIGHT:
return Qextra_light;
case HAIKU_LIGHT:
@@ -222,8 +222,6 @@ haikufont_weight_to_lisp (int weight)
return Qbold;
case HAIKU_EXTRA_BOLD:
return Qextra_bold;
- case HAIKU_ULTRA_BOLD:
- return Qultra_bold;
case HAIKU_BOOK:
return Qbook;
case HAIKU_HEAVY:
@@ -244,14 +242,14 @@ haikufont_lisp_to_weight (Lisp_Object weight)
if (EQ (weight, Qthin))
return HAIKU_THIN;
if (EQ (weight, Qultra_light))
- return HAIKU_ULTRALIGHT;
+ 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))
+ if (EQ (weight, Qnormal) || EQ (weight, Qregular))
return HAIKU_REGULAR;
if (EQ (weight, Qsemi_bold))
return HAIKU_SEMI_BOLD;
@@ -260,7 +258,7 @@ haikufont_lisp_to_weight (Lisp_Object weight)
if (EQ (weight, Qextra_bold))
return HAIKU_EXTRA_BOLD;
if (EQ (weight, Qultra_bold))
- return HAIKU_ULTRA_BOLD;
+ return HAIKU_EXTRA_BOLD;
if (EQ (weight, Qbook))
return HAIKU_BOOK;
if (EQ (weight, Qheavy))
@@ -272,7 +270,7 @@ haikufont_lisp_to_weight (Lisp_Object weight)
if (EQ (weight, Qmedium))
return HAIKU_MEDIUM;
- emacs_abort ();
+ return HAIKU_REGULAR;
}
static Lisp_Object
@@ -295,15 +293,16 @@ haikufont_slant_to_lisp (enum haiku_font_slant slant)
static enum haiku_font_slant
haikufont_lisp_to_slant (Lisp_Object slant)
{
- if (EQ (slant, Qitalic) ||
- EQ (slant, Qreverse_italic))
+ if (EQ (slant, Qitalic)
+ || EQ (slant, Qreverse_italic))
return SLANT_ITALIC;
- if (EQ (slant, Qoblique) ||
- EQ (slant, Qreverse_oblique))
+ if (EQ (slant, Qoblique)
+ || EQ (slant, Qreverse_oblique))
return SLANT_OBLIQUE;
- if (EQ (slant, Qnormal))
+ if (EQ (slant, Qnormal) || EQ (slant, Qregular))
return SLANT_REGULAR;
- emacs_abort ();
+
+ return SLANT_REGULAR;
}
static Lisp_Object
@@ -347,7 +346,7 @@ haikufont_lisp_to_width (Lisp_Object lisp)
return CONDENSED;
if (EQ (lisp, Qsemi_condensed))
return SEMI_CONDENSED;
- if (EQ (lisp, Qnormal))
+ if (EQ (lisp, Qnormal) || EQ (lisp, Qregular))
return NORMAL_WIDTH;
if (EQ (lisp, Qexpanded))
return EXPANDED;
@@ -355,7 +354,8 @@ haikufont_lisp_to_width (Lisp_Object lisp)
return EXTRA_EXPANDED;
if (EQ (lisp, Qultra_expanded))
return ULTRA_EXPANDED;
- emacs_abort ();
+
+ return NORMAL_WIDTH;
}
static int
@@ -381,49 +381,129 @@ haikufont_maybe_handle_special_family (Lisp_Object family,
static Lisp_Object
haikufont_pattern_to_entity (struct haiku_font_pattern *ptn)
{
- Lisp_Object ent = font_make_entity ();
- ASET (ent, FONT_TYPE_INDEX, Qhaiku);
- ASET (ent, FONT_FOUNDRY_INDEX, Qhaiku);
- ASET (ent, FONT_FAMILY_INDEX, Qdefault);
- ASET (ent, FONT_ADSTYLE_INDEX, Qnil);
- ASET (ent, FONT_REGISTRY_INDEX, Qutf_8);
- ASET (ent, FONT_SIZE_INDEX, make_fixnum (0));
- ASET (ent, FONT_AVGWIDTH_INDEX, make_fixnum (0));
- ASET (ent, FONT_SPACING_INDEX, make_fixnum (FONT_SPACING_MONO));
- FONT_SET_STYLE (ent, FONT_WIDTH_INDEX, Qnormal);
- FONT_SET_STYLE (ent, FONT_WEIGHT_INDEX, Qnormal);
- FONT_SET_STYLE (ent, FONT_SLANT_INDEX, Qnormal);
+ 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 (ent, FONT_FAMILY_INDEX, intern (ptn->family));
+ ASET (entity, FONT_FAMILY_INDEX, intern (ptn->family));
else
- ASET (ent, FONT_FAMILY_INDEX, Qdefault);
+ ASET (entity, FONT_FAMILY_INDEX, Qdefault);
if (ptn->specified & FSPEC_STYLE)
- ASET (ent, FONT_ADSTYLE_INDEX, intern (ptn->style));
+ ASET (entity, FONT_ADSTYLE_INDEX, intern (ptn->style));
else
{
if (ptn->specified & FSPEC_WEIGHT)
- FONT_SET_STYLE (ent, FONT_WEIGHT_INDEX,
+ FONT_SET_STYLE (entity, FONT_WEIGHT_INDEX,
haikufont_weight_to_lisp (ptn->weight));
if (ptn->specified & FSPEC_SLANT)
- FONT_SET_STYLE (ent, FONT_SLANT_INDEX,
+ FONT_SET_STYLE (entity, FONT_SLANT_INDEX,
haikufont_slant_to_lisp (ptn->slant));
if (ptn->specified & FSPEC_WIDTH)
- FONT_SET_STYLE (ent, FONT_WIDTH_INDEX,
+ FONT_SET_STYLE (entity, FONT_WIDTH_INDEX,
haikufont_width_to_lisp (ptn->width));
}
if (ptn->specified & FSPEC_SPACING)
- ASET (ent, FONT_SPACING_INDEX,
- make_fixnum (ptn->mono_spacing_p ?
- FONT_SPACING_MONO : FONT_SPACING_PROPORTIONAL));
- return ent;
+ 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,
+haikufont_spec_or_entity_to_pattern (Lisp_Object ent, int list_p,
struct haiku_font_pattern *ptn)
{
Lisp_Object tem;
@@ -436,44 +516,47 @@ haikufont_spec_or_entity_to_pattern (Lisp_Object ent,
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))
+ 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))
+ 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))
+ if (!NILP (tem) && !EQ (tem, Qunspecified))
{
ptn->specified |= FSPEC_WIDTH;
ptn->width = haikufont_lisp_to_width (tem);
}
tem = AREF (ent, FONT_SPACING_INDEX);
- if (FIXNUMP (tem))
+ 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) &&
- (list_p && !haikufont_maybe_handle_special_family (tem, ptn)))
+ 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));
@@ -551,6 +634,13 @@ haikufont_spec_or_entity_to_pattern (Lisp_Object ent,
}
}
+ 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);
@@ -588,27 +678,29 @@ haikufont_match (struct frame *f, Lisp_Object font_spec)
static Lisp_Object
haikufont_list (struct frame *f, Lisp_Object font_spec)
{
- block_input ();
- Lisp_Object lst = Qnil;
+ 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. */
- Lisp_Object tem = assq_no_quit (QCotf, AREF (font_spec, FONT_EXTRA_INDEX));
+ tem = assq_no_quit (QCotf, AREF (font_spec, FONT_EXTRA_INDEX));
+
if (CONSP (tem) && !NILP (XCDR (tem)))
{
unblock_input ();
return Qnil;
}
- struct haiku_font_pattern ptn;
haikufont_spec_or_entity_to_pattern (font_spec, 1, &ptn);
- struct haiku_font_pattern *found = BFont_find (&ptn);
+ found = BFont_find (&ptn);
haikufont_done_with_query_pattern (&ptn);
if (found)
{
- for (struct haiku_font_pattern *pt = found;
- pt; pt = pt->next)
+ for (pt = found; pt; pt = pt->next)
lst = Fcons (haikufont_pattern_to_entity (pt), lst);
haiku_font_pattern_free (found);
}
@@ -668,10 +760,11 @@ haikufont_open (struct frame *f, Lisp_Object font_entity, int x)
struct haiku_font_pattern ptn;
struct font *font;
void *be_font;
- Lisp_Object font_object;
- Lisp_Object tem;
+ 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;
- block_input ();
if (x <= 0)
{
/* Get pixel size from frame instead. */
@@ -679,16 +772,45 @@ haikufont_open (struct frame *f, Lisp_Object font_entity, int x)
x = NILP (tem) ? 0 : XFIXNAT (tem);
}
- haikufont_spec_or_entity_to_pattern (font_entity, 1, &ptn);
+ 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 (BFont_open_pattern (&ptn, &be_font, x))
+ 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 ();
- return Qnil;
}
- haikufont_done_with_query_pattern (&ptn);
+ block_input ();
font_object = font_make_object (VECSIZE (struct haikufont_info),
font_entity, x);
@@ -706,6 +828,9 @@ haikufont_open (struct frame *f, Lisp_Object font_entity, int x)
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;
@@ -718,14 +843,10 @@ haikufont_open (struct frame *f, Lisp_Object font_entity, int x)
font_info->metrics = NULL;
font_info->metrics_nrows = 0;
- int px_size, min_width, max_width,
- avg_width, height, space_width, ascent,
- descent, underline_pos, underline_thickness;
-
- BFont_dat (be_font, &px_size, &min_width,
- &max_width, &avg_width, &height,
- &space_width, &ascent, &descent,
- &underline_pos, &underline_thickness);
+ 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;
@@ -752,22 +873,31 @@ haikufont_open (struct frame *f, Lisp_Object font_entity, int x)
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;
- struct haikufont_info *info = (struct haikufont_info *) font;
block_input ();
if (info && info->be_font)
BFont_close (info->be_font);
- for (int i = 0; i < info->metrics_nrows; i++)
- if (info->metrics[i])
- xfree (info->metrics[i]);
+ for (i = 0; i < info->metrics_nrows; i++)
+ {
+ if (info->metrics[i])
+ xfree (info->metrics[i]);
+ }
+
if (info->metrics)
xfree (info->metrics);
- for (int i = 0; i < 0x100; ++i)
- if (info->glyphs[i])
- xfree (info->glyphs[i]);
+
+ for (i = 0; i < 0x100; ++i)
+ {
+ if (info->glyphs[i])
+ xfree (info->glyphs[i]);
+ }
+
xfree (info->glyphs);
unblock_input ();
}
@@ -951,11 +1081,21 @@ haikufont_draw (struct glyph_string *s, int from, int to,
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);
- BView_draw_lock (view);
+ 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);
@@ -976,18 +1116,12 @@ haikufont_draw (struct glyph_string *s, int from, int to,
s->first_glyph->slice.glyphless.lower_yoff
- s->first_glyph->slice.glyphless.upper_yoff;
- BView_SetHighColor (view, s->hl == DRAW_CURSOR ?
- FRAME_CURSOR_COLOR (s->f).pixel : face->background);
-
- BView_FillRectangle (view, x, y - ascent, s->width, height);
+ haiku_draw_background_rect (s, s->face, x, y - ascent,
+ s->width, height);
s->background_filled_p = 1;
}
- if (s->hl == DRAW_CURSOR)
- BView_SetHighColor (view, FRAME_OUTPUT_DATA (s->f)->cursor_fg);
- else
- BView_SetHighColor (view, face->foreground);
-
+ BView_SetHighColor (view, foreground);
BView_MovePenTo (view, x, y);
BView_SetFont (view, ((struct haikufont_info *) info)->be_font);
@@ -999,12 +1133,13 @@ haikufont_draw (struct glyph_string *s, int from, int to,
else
{
ptrdiff_t b_len = 0;
- char *b = xmalloc (b_len);
+ 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 = xrealloc (b, b_len = (b_len + len));
+ b_len += len;
+
if (len == 1)
b[b_len - len] = mb[0];
else
@@ -1012,13 +1147,58 @@ haikufont_draw (struct glyph_string *s, int from, int to,
}
BView_DrawString (view, b, b_len);
- xfree (b);
}
- BView_draw_unlock (view);
+
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),
@@ -1032,9 +1212,111 @@ struct font_driver const haikufont_driver =
.prepare_face = haikufont_prepare_face,
.encode_char = haikufont_encode_char,
.text_extents = haikufont_text_extents,
- .shape = haikufont_shape
+ .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)
{
@@ -1054,10 +1336,22 @@ syms_of_haikufont (void)
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
index b744885a42b..0dc127e6b63 100644
--- a/src/haikugui.h
+++ b/src/haikugui.h
@@ -19,11 +19,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef _HAIKU_GUI_H_
#define _HAIKU_GUI_H_
-#ifdef _cplusplus
-extern "C"
-{
-#endif
-
typedef struct haiku_char_struct
{
int rbearing;
@@ -100,7 +95,109 @@ typedef haiku Drawable;
typedef haiku Window;
typedef int Display;
-#ifdef _cplusplus
-};
-#endif
+/* 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
index 4ffa214f1cf..af3021c5cd9 100644
--- a/src/haikuimage.c
+++ b/src/haikuimage.c
@@ -42,8 +42,10 @@ haiku_can_use_native_image_api (Lisp_Object type)
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))
@@ -52,6 +54,12 @@ haiku_can_use_native_image_api (Lisp_Object type)
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;
@@ -105,5 +113,4 @@ haiku_load_image (struct frame *f, struct image *img,
void
syms_of_haikuimage (void)
{
- DEFSYM (Qbmp, "bmp");
}
diff --git a/src/haikumenu.c b/src/haikumenu.c
index f335bdacb40..3f68eadfd93 100644
--- a/src/haikumenu.c
+++ b/src/haikumenu.c
@@ -29,37 +29,41 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "haiku_support.h"
static Lisp_Object *volatile menu_item_selection;
+static struct timespec menu_timer_timespec;
int popup_activated_p = 0;
-struct submenu_stack_cell
-{
- void *parent_menu;
- void *pane;
-};
-
static void
digest_menu_items (void *first_menu, int start, int menu_items_used,
- int mbar_p)
+ bool is_menu_bar)
{
void **menus, **panes;
- ssize_t menu_len = (menu_items_used + 1 - start) * sizeof *menus;
- ssize_t pane_len = (menu_items_used + 1 - start) * sizeof *panes;
+ 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;
- menus = alloca (menu_len);
- panes = alloca (pane_len);
+ USE_SAFE_ALLOCA;
- int i = start, menu_depth = 0;
+ 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);
-
- void *menu = first_menu;
-
menus[0] = first_menu;
- void *window = NULL;
- void *view = NULL;
+ window = NULL;
+ view = NULL;
+
if (FRAMEP (Vmenu_updating_frame) &&
FRAME_LIVE_P (XFRAME (Vmenu_updating_frame)) &&
FRAME_HAIKU_P (XFRAME (Vmenu_updating_frame)))
@@ -69,7 +73,7 @@ digest_menu_items (void *first_menu, int start, int menu_items_used,
}
if (view)
- BView_draw_lock (view);
+ BView_draw_lock (view, false, 0, 0, 0, 0);
while (i < menu_items_used)
{
@@ -88,9 +92,6 @@ digest_menu_items (void *first_menu, int start, int menu_items_used,
i += 1;
else if (EQ (AREF (menu_items, i), Qt))
{
- Lisp_Object pane_name, prefix;
- const char *pane_string;
-
if (menu_items_n_panes == 1)
{
i += MENU_ITEMS_PANE_LENGTH;
@@ -121,7 +122,6 @@ digest_menu_items (void *first_menu, int start, int menu_items_used,
}
else
{
- Lisp_Object item_name, enable, descrip, def, selected, help;
item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
@@ -142,22 +142,34 @@ digest_menu_items (void *first_menu, int start, int menu_items_used,
}
if (STRINGP (help) && STRING_MULTIBYTE (help))
- {
- help = ENCODE_UTF_8 (help);
- ASET (menu_items, i + MENU_ITEMS_ITEM_HELP, help);
- }
+ help = ENCODE_UTF_8 (help);
if (i + MENU_ITEMS_ITEM_LENGTH < menu_items_used &&
NILP (AREF (menu_items, i + MENU_ITEMS_ITEM_LENGTH)))
menu = BMenu_new_submenu (menu, SSDATA (item_name), !NILP (enable));
else if (NILP (def) && menu_separator_name_p (SSDATA (item_name)))
BMenu_add_separator (menu);
- else if (!mbar_p)
+ 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) ? aref_addr (menu_items, i) : NULL,
- !NILP (enable), !NILP (selected), 0, window,
+ !NILP (def) ? (void *) (intptr_t) i : NULL,
+ !NILP (enable), !NILP (selected), 1, window,
!NILP (descrip) ? SSDATA (descrip) : NULL,
- STRINGP (help) ? SSDATA (help) : NULL);
+ NULL);
else
BMenu_add_item (menu, SSDATA (item_name),
!NILP (def) ? (void *) (intptr_t) i : NULL,
@@ -171,6 +183,8 @@ digest_menu_items (void *first_menu, int start, int menu_items_used,
if (view)
BView_draw_unlock (view);
+
+ SAFE_FREE ();
}
static Lisp_Object
@@ -178,6 +192,11 @@ 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;
@@ -187,17 +206,15 @@ haiku_dialog_show (struct frame *f, Lisp_Object title,
return Qnil;
}
- Lisp_Object pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME);
+ 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 ();
- void *alert = BAlert_new (SSDATA (pane_name), NILP (header) ? HAIKU_INFO_ALERT :
- HAIKU_IDEA_ALERT);
-
- Lisp_Object vals[10];
+ alert = BAlert_new (SSDATA (pane_name), NILP (header) ? HAIKU_INFO_ALERT :
+ HAIKU_IDEA_ALERT);
while (i < menu_items_used)
{
@@ -217,7 +234,11 @@ haiku_dialog_show (struct frame *f, Lisp_Object title,
if (EQ (item_name, Qquote))
{
+ if (nb_buttons)
+ boundary_seen = true;
+
i++;
+ continue;
}
if (nb_buttons >= 9)
@@ -233,9 +254,11 @@ haiku_dialog_show (struct frame *f, Lisp_Object title,
if (!NILP (descrip) && STRING_MULTIBYTE (descrip))
descrip = ENCODE_UTF_8 (descrip);
- void *button = BAlert_add_button (alert, SSDATA (item_name));
+ 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));
@@ -244,15 +267,39 @@ haiku_dialog_show (struct frame *f, Lisp_Object title,
i += MENU_ITEMS_ITEM_LENGTH;
}
- int32_t val = BAlert_go (alert);
+ /* 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
+ else if (val < nb_buttons)
return vals[val];
- return Qnil;
+ /* 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
@@ -261,7 +308,7 @@ haiku_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents)
Lisp_Object title;
const char *error_name = NULL;
Lisp_Object selection;
- ptrdiff_t specpdl_count = SPECPDL_INDEX ();
+ specpdl_ref specpdl_count = SPECPDL_INDEX ();
check_window_system (f);
@@ -279,9 +326,7 @@ haiku_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents)
list_of_panes (list1 (contents));
/* Display them in a dialog box. */
- block_input ();
selection = haiku_dialog_show (f, title, header, &error_name);
- unblock_input ();
unbind_to (specpdl_count, Qnil);
discard_menu_items ();
@@ -291,16 +336,65 @@ haiku_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents)
return selection;
}
+static void
+haiku_menu_show_help (void *help, void *data)
+{
+ Lisp_Object *id = (Lisp_Object *) help;
+
+ if (help)
+ show_help_echo (id[MENU_ITEMS_ITEM_HELP],
+ Qnil, Qnil, Qnil);
+ else
+ show_help_echo (Qnil, Qnil, Qnil, Qnil);
+}
+
+static Lisp_Object
+haiku_process_pending_signals_for_menu_1 (void *ptr)
+{
+ menu_timer_timespec = timer_check ();
+
+ return Qnil;
+}
+
+static Lisp_Object
+haiku_process_pending_signals_for_menu_2 (enum nonlocal_exit exit, Lisp_Object error)
+{
+ menu_timer_timespec.tv_sec = 0;
+ menu_timer_timespec.tv_nsec = -1;
+
+ return Qnil;
+}
+
+static struct timespec
+haiku_process_pending_signals_for_menu (void)
+{
+ process_pending_signals ();
+
+ /* The original idea was to let timers throw so that timeouts can
+ work correctly, but there's no way to pop down a BPopupMenu
+ that's currently popped up. */
+ internal_catch_all (haiku_process_pending_signals_for_menu_1, NULL,
+ haiku_process_pending_signals_for_menu_2);
+
+ return menu_timer_timespec;
+}
+
Lisp_Object
haiku_menu_show (struct frame *f, int x, int y, int menuflags,
Lisp_Object title, const char **error_name)
{
- int i = 0, submenu_depth = 0;
- void *view = FRAME_HAIKU_VIEW (f);
- void *menu;
+ int i, submenu_depth, j;
+ void *view, *menu;
+ Lisp_Object *subprefix_stack;
+ Lisp_Object prefix, entry;
- Lisp_Object *subprefix_stack =
- alloca (menu_items_used * sizeof (Lisp_Object));
+ 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));
@@ -309,6 +403,8 @@ haiku_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;
}
@@ -324,15 +420,20 @@ haiku_menu_show (struct frame *f, int x, int y, int menuflags,
}
digest_menu_items (menu, 0, menu_items_used, 0);
BView_convert_to_screen (view, &x, &y);
- menu_item_selection = BMenu_run (menu, 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)
{
- Lisp_Object prefix, entry;
-
prefix = entry = Qnil;
i = 0;
while (i < menu_items_used)
@@ -366,8 +467,6 @@ haiku_menu_show (struct frame *f, int x, int y, int menuflags,
{
if (menuflags & MENU_KEYMAPS)
{
- int j;
-
entry = list1 (entry);
if (!NILP (prefix))
entry = Fcons (prefix, entry);
@@ -378,6 +477,8 @@ haiku_menu_show (struct frame *f, int x, int y, int menuflags,
block_input ();
BPopUpMenu_delete (menu);
unblock_input ();
+
+ SAFE_FREE ();
return entry;
}
i += MENU_ITEMS_ITEM_LENGTH;
@@ -394,20 +495,27 @@ haiku_menu_show (struct frame *f, int x, int y, int menuflags,
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 ();
- void *mbar = FRAME_HAIKU_MENU_BAR (f);
+ 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;
@@ -430,28 +538,38 @@ set_frame_menubar (struct frame *f, bool deep_p)
{
void *mbar = FRAME_HAIKU_MENU_BAR (f);
void *view = FRAME_HAIKU_VIEW (f);
-
- int first_time_p = 0;
+ 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;
- 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);
+ int count;
+ ptrdiff_t subitems, i;
+ int *submenu_start, *submenu_end, *submenu_n_panes;
+ Lisp_Object *submenu_names;
XSETFRAME (Vmenu_updating_frame, f);
if (!deep_p)
{
- FRAME_OUTPUT_DATA (f)->menu_up_to_date_p = 0;
items = FRAME_MENU_BAR_ITEMS (f);
Lisp_Object string;
@@ -490,6 +608,7 @@ set_frame_menubar (struct frame *f, bool deep_p)
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
@@ -525,29 +644,23 @@ set_frame_menubar (struct frame *f, bool deep_p)
/* 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;
- init_menu_items ();
- int i;
- int count = BMenu_count_items (mbar);
- int subitems = ASIZE (items) / 4;
-
- int *submenu_start, *submenu_end, *submenu_n_panes;
- Lisp_Object *submenu_names;
-
+ 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));
- for (i = 0; i < subitems; ++i)
+ init_menu_items ();
+ for (i = 0; i < subitems; i++)
{
Lisp_Object key, string, maps;
- key = AREF (items, i * 4);
- string = AREF (items, i * 4 + 1);
- maps = AREF (items, i * 4 + 2);
-
+ key = AREF (items, 4 * i);
+ string = AREF (items, 4 * i + 1);
+ maps = AREF (items, 4 * i + 2);
if (NILP (string))
break;
@@ -555,16 +668,42 @@ set_frame_menubar (struct frame *f, bool deep_p)
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;
}
- finish_menu_items ();
+
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;
@@ -580,31 +719,23 @@ set_frame_menubar (struct frame *f, bool deep_p)
}
unblock_input ();
- set_buffer_internal_1 (prev);
-
- FRAME_OUTPUT_DATA (f)->menu_up_to_date_p = 1;
+ /* The menu items are different, so store them in the frame. */
fset_menu_bar_vector (f, menu_items);
f->menu_bar_items_used = menu_items_used;
}
+
+ /* This undoes save_menu_items. */
unbind_to (specpdl_count, Qnil);
}
void
run_menu_bar_help_event (struct frame *f, int mb_idx)
{
- Lisp_Object frame;
- Lisp_Object vec;
- Lisp_Object help;
-
- block_input ();
- if (!FRAME_OUTPUT_DATA (f)->menu_up_to_date_p)
- {
- unblock_input ();
- return;
- }
+ Lisp_Object frame, vec, help;
XSETFRAME (frame, f);
+ block_input ();
if (mb_idx < 0)
{
kbd_buffer_store_help_event (frame, Qnil);
@@ -613,8 +744,8 @@ run_menu_bar_help_event (struct frame *f, int mb_idx)
}
vec = f->menu_bar_vector;
- if (mb_idx >= ASIZE (vec))
- emacs_abort ();
+ if ((mb_idx + MENU_ITEMS_ITEM_HELP) >= ASIZE (vec))
+ return;
help = AREF (vec, mb_idx + MENU_ITEMS_ITEM_HELP);
if (STRINGP (help) || NILP (help))
@@ -639,23 +770,65 @@ 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))
{
- if (!FRAME_OUTPUT_DATA (f)->menu_up_to_date_p)
- set_frame_menubar (f, 1);
+ 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)
{
- return call2 (Qpopup_menu, call0 (Qmouse_menu_bar_map),
- last_nonmenu_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 ();
- block_input ();
- BMenuBar_start_tracking (FRAME_HAIKU_MENU_BAR (f));
- unblock_input ();
+ if (!rc)
+ return;
- return Qnil;
+ FRAME_OUTPUT_DATA (f)->menu_bar_open_p = 1;
+ popup_activated_p += 1;
+ }
}
void
@@ -664,6 +837,7 @@ 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);
diff --git a/src/haikuselect.c b/src/haikuselect.c
index 2e619c69f7a..9d8c4a2cd16 100644
--- a/src/haikuselect.c
+++ b/src/haikuselect.c
@@ -23,152 +23,1077 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "coding.h"
#include "haikuselect.h"
#include "haikuterm.h"
+#include "haiku_support.h"
+#include "keyboard.h"
#include <stdlib.h>
-static Lisp_Object
-haiku_selection_data_1 (Lisp_Object clipboard)
-{
- Lisp_Object result = Qnil;
- char *targets[256];
+/* 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;
- block_input ();
+/* 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))
- BClipboard_primary_targets ((char **) &targets, 256);
- else if (EQ (clipboard, QSECONDARY))
- BClipboard_secondary_targets ((char **) &targets, 256);
- else if (EQ (clipboard, QCLIPBOARD))
- BClipboard_system_targets ((char **) &targets, 256);
- else
- {
- unblock_input ();
- signal_error ("Bad clipboard", clipboard);
- }
+ return CLIPBOARD_PRIMARY;
- for (int i = 0; targets[i]; ++i)
- {
- result = Fcons (build_unibyte_string (targets[i]),
- result);
- free (targets[i]);
- }
- unblock_input ();
+ if (EQ (clipboard, QSECONDARY))
+ return CLIPBOARD_SECONDARY;
- return result;
-}
+ if (EQ (clipboard, QCLIPBOARD))
+ return CLIPBOARD_CLIPBOARD;
-DEFUN ("haiku-selection-targets", Fhaiku_selection_targets,
- Shaiku_selection_targets, 1, 1, 0,
- doc: /* Find the types of data available from CLIPBOARD.
-CLIPBOARD should be the symbol `PRIMARY', `SECONDARY' or `CLIPBOARD'.
-Return the available types as a list of strings. */)
- (Lisp_Object clipboard)
-{
- return haiku_selection_data_1 (clipboard);
+ signal_error ("Invalid clipboard", clipboard);
}
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 MIME type denoting the type of the data to
-fetch. */)
+`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)
{
- CHECK_SYMBOL (clipboard);
- CHECK_STRING (name);
char *dat;
ssize_t len;
+ Lisp_Object str;
+ void *message;
+ enum haiku_clipboard clipboard_name;
+ int rc;
- block_input ();
- if (EQ (clipboard, QPRIMARY))
- dat = BClipboard_find_primary_selection_data (SSDATA (name), &len);
- else if (EQ (clipboard, QSECONDARY))
- dat = BClipboard_find_secondary_selection_data (SSDATA (name), &len);
- else if (EQ (clipboard, QCLIPBOARD))
- dat = BClipboard_find_system_data (SSDATA (name), &len);
- else
+ 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 ();
- signal_error ("Bad clipboard", clipboard);
- }
- unblock_input ();
- if (!dat)
- return Qnil;
+ if (!dat)
+ return Qnil;
- Lisp_Object str = make_unibyte_string (dat, len);
- Lisp_Object lispy_type = Qnil;
+ str = make_unibyte_string (dat, len);
- if (!strcmp (SSDATA (name), "text/utf-8") ||
- !strcmp (SSDATA (name), "text/plain"))
- {
- if (string_ascii_p (str))
- lispy_type = QSTRING;
- else
- lispy_type = QUTF8_STRING;
+ /* `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 (!NILP (lispy_type))
- Fput_text_property (make_fixnum (0), make_fixnum (len),
- Qforeign_selection, lispy_type, str);
+ if (rc)
+ signal_error ("Couldn't open clipboard", clipboard);
- block_input ();
- BClipboard_free_data (dat);
- unblock_input ();
+ 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,
- 3, 4, 0,
+ 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. If NAME is the string "text/utf-8" or the string
-"text/plain", encode it as UTF-8 before storing it into the clipboard.
-CLEAR, if non-nil, means to erase all the previous contents of the
-clipboard. */)
+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 ();
- /* It seems that Haiku applications counter-intuitively expect
- UTF-8 data in both text/utf-8 and text/plain. */
- if (!NILP (data) && STRING_MULTIBYTE (data) &&
- (!strcmp (SSDATA (name), "text/utf-8") ||
- !strcmp (SSDATA (name), "text/plain")))
- data = ENCODE_UTF_8 (data);
+ name = haiku_get_clipboard_name (selection);
+ value = be_clipboard_owner_p (name);
+ unblock_input ();
- char *dat = !NILP (data) ? SSDATA (data) : NULL;
- ptrdiff_t len = !NILP (data) ? SBYTES (data) : 0;
+ return value ? Qt : Qnil;
+}
- if (EQ (clipboard, QPRIMARY))
- BClipboard_set_primary_selection_data (SSDATA (name), dat, len,
- !NILP (clear));
- else if (EQ (clipboard, QSECONDARY))
- BClipboard_set_secondary_selection_data (SSDATA (name), dat, len,
- !NILP (clear));
- else if (EQ (clipboard, QCLIPBOARD))
- BClipboard_set_system_data (SSDATA (name), dat, len, !NILP (clear));
+/* 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)
{
- unblock_input ();
- signal_error ("Bad clipboard", clipboard);
+ 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");
@@ -176,7 +1101,31 @@ syms_of_haikuselect (void)
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_put);
- defsubr (&Shaiku_selection_targets);
+ 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
index 80f33c6ed25..61efeb9cd93 100644
--- a/src/haikuselect.h
+++ b/src/haikuselect.h
@@ -21,54 +21,58 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifdef __cplusplus
#include <cstdio>
+#else
+#include <stdio.h>
#endif
+#include <SupportDefs.h>
+
+enum haiku_clipboard
+ {
+ CLIPBOARD_PRIMARY,
+ CLIPBOARD_SECONDARY,
+ CLIPBOARD_CLIPBOARD
+ };
+
#ifdef __cplusplus
-#include <stdio.h>
extern "C"
{
- extern void init_haiku_select (void);
#endif
+/* 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);
- /* Whether or not the selection was recently changed. */
- extern int selection_state_flag;
-
- /* Find a string with the MIME type TYPE in the system clipboard. */
- extern char *
- BClipboard_find_system_data (const char *type, ssize_t *len);
-
- /* Ditto, but for the primary selection and not clipboard. */
- extern char *
- BClipboard_find_primary_selection_data (const char *type, ssize_t *len);
-
- /* Ditto, this time for the secondary selection. */
- extern char *
- BClipboard_find_secondary_selection_data (const char *type, ssize_t *len);
-
- extern void
- BClipboard_set_system_data (const char *type, const char *data, ssize_t len,
- bool clear);
-
- extern void
- BClipboard_set_primary_selection_data (const char *type, const char *data,
- ssize_t len, bool clear);
-
- extern void
- BClipboard_set_secondary_selection_data (const char *type, const char *data,
- ssize_t len, bool clear);
-
- extern void
- BClipboard_system_targets (char **buf, int len);
-
- extern void
- BClipboard_primary_targets (char **buf, int len);
-
- extern void
- BClipboard_secondary_targets (char **buf, int len);
-
- /* Free the returned data. */
- extern void BClipboard_free_data (void *ptr);
#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
index 2239770de95..bcb3af0e2c3 100644
--- a/src/haikuterm.c
+++ b/src/haikuterm.c
@@ -32,6 +32,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "haiku_support.h"
#include "thread.h"
#include "window.h"
+#include "haikuselect.h"
#include <math.h>
#include <stdlib.h>
@@ -40,20 +41,28 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <cairo.h>
#endif
-struct haiku_display_info *x_display_list = NULL;
-extern frame_parm_handler haiku_frame_parm_handlers[];
+/* 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;
-static int fringe_bitmap_fillptr = 0;
+/* The amount of fringe bitmaps in that list. */
+static int max_fringe_bmp;
+
+/* Alist of resources to their values. */
static Lisp_Object rdb;
-struct unhandled_event
-{
- struct unhandled_event *next;
- enum haiku_event_type type;
- uint8_t buffer[200];
-};
+/* 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)
@@ -88,25 +97,32 @@ static void
haiku_coords_from_parent (struct frame *f, int *x, int *y)
{
struct frame *p = FRAME_PARENT_FRAME (f);
- eassert (p);
- for (struct frame *parent = p; parent;
- parent = FRAME_PARENT_FRAME (parent))
- {
- *x -= parent->left_pos;
- *y -= parent->top_pos;
- }
+ *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)
{
- emacs_abort ();
+ error ("The Haiku terminal cannot be deleted");
}
static const char *
-get_string_resource (void *ignored, const char *name, const char *class)
+haiku_get_string_resource (void *ignored, const char *name,
+ const char *class)
{
+ const char *native;
+
if (!name)
return NULL;
@@ -115,26 +131,24 @@ get_string_resource (void *ignored, const char *name, const char *class)
if (!NILP (lval))
return SSDATA (XCDR (lval));
+ if ((native = be_find_setting (name)))
+ return native;
+
return NULL;
}
static void
haiku_update_size_hints (struct frame *f)
{
- int base_width, base_height;
- eassert (FRAME_HAIKU_P (f) && FRAME_HAIKU_WINDOW (f));
-
- base_width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, 0);
- base_height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, 0);
+ 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));
- BWindow_set_min_size (FRAME_HAIKU_WINDOW (f), base_width,
- base_height
- + FRAME_TOOL_BAR_HEIGHT (f)
- + FRAME_MENU_BAR_HEIGHT (f));
+ (frame_resize_pixelwise
+ ? 1 : FRAME_COLUMN_WIDTH (f)),
+ (frame_resize_pixelwise
+ ? 1 : FRAME_LINE_HEIGHT (f)));
unblock_input ();
}
@@ -154,8 +168,12 @@ haiku_clip_to_string (struct glyph_string *s)
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_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)
@@ -168,8 +186,12 @@ haiku_clip_to_string (struct glyph_string *s)
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_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);
+ }
}
}
@@ -178,6 +200,8 @@ 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
@@ -186,7 +210,7 @@ haiku_flip_buffers (struct frame *f)
void *view = FRAME_OUTPUT_DATA (f)->view;
block_input ();
- BView_draw_lock (view);
+ BView_draw_lock (view, false, 0, 0, 0, 0);
FRAME_DIRTY_P (f) = 0;
EmacsView_flip_and_blit (view);
BView_draw_unlock (view);
@@ -201,6 +225,13 @@ haiku_frame_up_to_date (struct frame *f)
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 ();
}
@@ -217,7 +248,7 @@ haiku_clear_frame_area (struct frame *f, int x, int y,
{
void *vw = FRAME_HAIKU_VIEW (f);
block_input ();
- BView_draw_lock (vw);
+ 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));
@@ -231,14 +262,18 @@ 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);
+ 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) + 1,
- FRAME_PIXEL_HEIGHT (f) + 1);
+ 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) + 1,
- FRAME_PIXEL_HEIGHT (f) + 1);
+ BView_FillRectangle (view, 0, 0, FRAME_PIXEL_WIDTH (f) ,
+ FRAME_PIXEL_HEIGHT (f));
BView_EndClip (view);
BView_draw_unlock (view);
unblock_input ();
@@ -252,11 +287,16 @@ haiku_clear_frame (struct frame *f)
static Lisp_Object
haiku_new_font (struct frame *f, Lisp_Object font_object, int fontset)
{
- struct font *font = XFONT_OBJECT (font_object);
+ 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;
@@ -264,26 +304,22 @@ haiku_new_font (struct frame *f, Lisp_Object font_object, int fontset)
FRAME_BASELINE_OFFSET (f) = font->baseline_offset;
FRAME_COLUMN_WIDTH (f) = font->average_width;
- int ascent, descent;
get_font_ascent_descent (font, &ascent, &descent);
FRAME_LINE_HEIGHT (f) = ascent + descent;
FRAME_TAB_BAR_HEIGHT (f) = FRAME_TAB_BAR_LINES (f) * FRAME_LINE_HEIGHT (f);
- int unit = FRAME_COLUMN_WIDTH (f);
+ 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))
- {
- adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f),
- FRAME_LINES (f) * FRAME_LINE_HEIGHT (f),
- 3, false, Qfont);
+ if (FRAME_HAIKU_WINDOW (f) && !FRAME_TOOLTIP_P (f))
+ adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f),
+ FRAME_LINES (f) * FRAME_LINE_HEIGHT (f),
+ 3, false, Qfont);
- haiku_clear_under_internal_border (f);
- }
return font_object;
}
@@ -365,6 +401,137 @@ haiku_frame_raise_lower (struct frame *f, bool raise_p)
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. */
@@ -389,7 +556,7 @@ haiku_new_focus_frame (struct frame *frame)
x_display_list->focused_frame = frame;
- if (frame && frame->auto_raise)
+ if (frame && frame->auto_raise && !popup_activated_p)
haiku_frame_raise_lower (frame, 1);
}
unblock_input ();
@@ -410,20 +577,24 @@ haiku_query_frame_background_color (struct frame *f, Emacs_Color *bgcolor)
}
static bool
-haiku_defined_color (struct frame *f,
- const char *name,
- Emacs_Color *color,
- bool alloc,
- bool make_index)
+haiku_defined_color (struct frame *f, const char *name,
+ Emacs_Color *color, bool alloc, bool make_index)
{
- return !haiku_get_color (name, color);
+ 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)
+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;
@@ -444,51 +615,72 @@ haiku_draw_box_rect (struct glyph_string *s,
}
static void
-haiku_calculate_relief_colors (struct glyph_string *s,
- uint32_t *rgbout_w, uint32_t *rgbout_b,
- uint32_t *rgbout_c)
+haiku_calculate_relief_colors (struct glyph_string *s, uint32_t *rgbout_w,
+ uint32_t *rgbout_b)
{
- struct face *face = s->face;
-
- prepare_face_for_display (s->f, s->face);
+ 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;
- uint32_t rgbin = face->use_box_color_for_shadows_p
- ? face->box_color : face->background;
+ di = FRAME_OUTPUT_DATA (s->f);
if (s->hl == DRAW_CURSOR)
rgbin = FRAME_CURSOR_COLOR (s->f).pixel;
- double h, cs, l;
- rgb_color_hsl (rgbin, &h, &cs, &l);
+ if (di->relief_background != rgbin)
+ {
+ di->relief_background = rgbin & 0xffffffff;
- hsl_color_rgb (h, cs, fmin (1.0, fmax (0.2, l) * 0.6), rgbout_b);
- hsl_color_rgb (h, cs, fmin (1.0, fmax (0.2, l) * 1.2), rgbout_w);
- hsl_color_rgb (h, cs, fmin (1.0, fmax (0.2, l) * 1.8), rgbout_c);
+ 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, bool fancy_p)
+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;
- uint32_t color_black;
- uint32_t color_corner;
+ uint32_t color_white, color_black;
+ void *view;
- haiku_calculate_relief_colors (s, &color_white, &color_black,
- &color_corner);
+ view = FRAME_HAIKU_VIEW (s->f);
+ haiku_calculate_relief_colors (s, &color_white, &color_black);
- void *view = FRAME_HAIKU_VIEW (s->f);
BView_SetHighColor (view, raised_p ? color_white : color_black);
+
if (clip_rect)
- BView_ClipToRect (view, clip_rect->x, clip_rect->y, clip_rect->width,
- clip_rect->height);
+ {
+ 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);
+ 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, top_y,
+ vwidth, bottom_y - top_y + 1);
+
BView_SetHighColor (view, !raised_p ? color_white : color_black);
if (bot_p)
@@ -529,10 +721,10 @@ haiku_draw_relief_rect (struct glyph_string *s,
if (vwidth > 1 && right_p)
BView_StrokeLine (view, right_x, top_y, right_x, bottom_y);
- BView_SetHighColor (view, color_corner);
+ BView_SetHighColor (view, FRAME_BACKGROUND_PIXEL (s->f));
/* Omit corner pixels. */
- if (hwidth > 1 || vwidth > 1)
+ if (hwidth > 1 && vwidth > 1)
{
if (left_p && top_p)
BView_FillRectangle (view, left_x, top_y, 1, 1);
@@ -543,25 +735,46 @@ haiku_draw_relief_rect (struct glyph_string *s,
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 = 3, wave_length = 2;
- int y, dx, dy, odd, xmax;
+ 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;
-
- float ax, ay, bx, by;
xmax = x + width;
-
- void *view = FRAME_HAIKU_VIEW (s->f);
+ 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;
@@ -572,6 +785,8 @@ haiku_draw_underwave (struct glyph_string *s, int width, int x)
else
by += dy;
+ BView_SetPenSize (view, scale_y);
+
while (ax <= xmax)
{
BView_StrokeLine (view, ax, ay, bx, by);
@@ -579,27 +794,33 @@ haiku_draw_underwave (struct glyph_string *s, int width, int x)
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,
- uint8_t dcol, int width, int x)
+ 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);
- BView_draw_lock (view);
if (face->underline)
{
if (s->hl == DRAW_CURSOR)
- BView_SetHighColor (view, FRAME_OUTPUT_DATA (s->f)->cursor_fg);
+ BView_SetHighColor (view, cursor_color);
else if (!face->underline_defaulted_p)
BView_SetHighColor (view, face->underline_color);
else
- BView_SetHighColor (view, dcol);
+ BView_SetHighColor (view, face->foreground);
if (face->underline == FACE_UNDER_WAVE)
haiku_draw_underwave (s, width, x);
@@ -608,22 +829,19 @@ haiku_draw_text_decoration (struct glyph_string *s, struct face *face,
unsigned long thickness, position;
int y;
- if (s->prev && s->prev && s->prev->hl == DRAW_MOUSE_FACE)
+ 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))
{
- struct face *prev_face = s->prev->face;
-
- if (prev_face && prev_face->underline == FACE_UNDER_LINE)
- {
- /* We use the same underline style as the previous one. */
- thickness = s->prev->underline_thickness;
- position = s->prev->underline_position;
- }
- else
- goto calculate_underline_metrics;
+ /* We use the same underline style as the previous one. */
+ thickness = s->prev->underline_thickness;
+ position = s->prev->underline_position;
}
else
{
- calculate_underline_metrics:;
struct font *font = font_for_underline_metrics (s);
unsigned long minimum_offset;
bool underline_at_descent_line;
@@ -639,12 +857,13 @@ haiku_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));
+ = (!(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)
@@ -652,7 +871,9 @@ haiku_draw_text_decoration (struct glyph_string *s, struct face *face,
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
@@ -692,11 +913,11 @@ haiku_draw_text_decoration (struct glyph_string *s, struct face *face,
{
unsigned long dy = 0, h = 1;
if (s->hl == DRAW_CURSOR)
- BView_SetHighColor (view, FRAME_OUTPUT_DATA (s->f)->cursor_fg);
+ BView_SetHighColor (view, cursor_color);
else if (!face->overline_color_defaulted_p)
BView_SetHighColor (view, face->overline_color);
else
- BView_SetHighColor (view, dcol);
+ BView_SetHighColor (view, face->foreground);
BView_FillRectangle (view, s->x, s->y + dy, s->width, h);
}
@@ -716,26 +937,22 @@ haiku_draw_text_decoration (struct glyph_string *s, struct face *face,
unsigned long dy = (glyph_height - h) / 2;
if (s->hl == DRAW_CURSOR)
- BView_SetHighColor (view, FRAME_OUTPUT_DATA (s->f)->cursor_fg);
+ BView_SetHighColor (view, cursor_color);
else if (!face->strike_through_color_defaulted_p)
BView_SetHighColor (view, face->strike_through_color);
else
- BView_SetHighColor (view, dcol);
+ BView_SetHighColor (view, face->foreground);
BView_FillRectangle (view, s->x, glyph_y + dy, s->width, h);
}
-
- BView_draw_unlock (view);
}
static void
-haiku_draw_string_box (struct glyph_string *s, int clip_p)
+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 haiku_rect clip_rect;
-
struct face *face = s->face;
last_x = ((s->row->full_width_p && !s->w->pseudo_window_p)
@@ -783,54 +1000,116 @@ haiku_draw_string_box (struct glyph_string *s, int clip_p)
&& (s->next == NULL
|| s->next->hl != s->hl)));
- get_glyph_string_clip_rect (s, &clip_rect);
-
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, &clip_rect);
+ 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,
- &clip_rect, 1);
-
- if (clip_p)
- {
- void *view = FRAME_HAIKU_VIEW (s->f);
-
- haiku_draw_text_decoration (s, face, face->foreground, s->width, s->x);
- BView_ClipToInverseRect (view, left_x, top_y, right_x - left_x + 1, hwidth);
- if (left_p)
- BView_ClipToInverseRect (view, left_x, top_y, vwidth, bottom_y - top_y + 1);
- BView_ClipToInverseRect (view, left_x, bottom_y - hwidth + 1,
- right_x - left_x + 1, hwidth);
- if (right_p)
- BView_ClipToInverseRect (view, right_x - vwidth + 1,
- top_y, vwidth, bottom_y - top_y + 1);
- }
+ NULL);
}
static void
haiku_draw_plain_background (struct glyph_string *s, struct face *face,
- int box_line_hwidth, int box_line_vwidth)
+ int x, int y, int width, int height)
{
void *view = FRAME_HAIKU_VIEW (s->f);
+ unsigned long cursor_color;
+
if (s->hl == DRAW_CURSOR)
- BView_SetHighColor (view, FRAME_CURSOR_COLOR (s->f).pixel);
+ {
+ 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);
+ face->background);
- BView_FillRectangle (view, s->x,
- s->y + box_line_hwidth,
- s->background_width,
- s->height - 2 * box_line_hwidth);
+ 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 box_line_hwidth, int box_line_vwidth)
+ 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
@@ -846,12 +1125,10 @@ haiku_maybe_draw_background (struct glyph_string *s, int force_p)
|| FONT_TOO_HIGH (s->font)
|| s->font_not_found_p || s->extends_to_end_of_line_p || force_p)
{
- if (!face->stipple)
- haiku_draw_plain_background (s, face, box_line_width,
- box_vline_width);
- else
- haiku_draw_stipple_background (s, face, box_line_width,
- box_vline_width);
+ 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;
}
}
@@ -907,6 +1184,8 @@ haiku_draw_glyph_string_foreground (struct glyph_string *s)
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;
@@ -938,6 +1217,7 @@ haiku_draw_glyphless_glyph_string_foreground (struct glyph_string *s)
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. */
@@ -1001,11 +1281,21 @@ haiku_draw_glyphless_glyph_string_foreground (struct glyph_string *s)
s->ybase + glyph->slice.glyphless.lower_yoff,
false);
}
+
if (glyph->u.glyphless.method != GLYPHLESS_DISPLAY_THIN_SPACE)
- BView_FillRectangle (FRAME_HAIKU_VIEW (s->f),
- x, s->ybase - glyph->ascent,
- glyph->pixel_width - 1,
- glyph->ascent + glyph->descent - 1);
+ {
+ 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;
}
}
@@ -1013,9 +1303,8 @@ haiku_draw_glyphless_glyph_string_foreground (struct glyph_string *s)
static void
haiku_draw_stretch_glyph_string (struct glyph_string *s)
{
- eassert (s->first_glyph->type == STRETCH_GLYPH);
-
struct face *face = s->face;
+ uint32_t bkg;
if (s->hl == DRAW_CURSOR && !x_stretch_cursor_p)
{
@@ -1047,7 +1336,10 @@ haiku_draw_stretch_glyph_string (struct glyph_string *s)
x -= width;
void *view = FRAME_HAIKU_VIEW (s->f);
- BView_SetHighColor (view, FRAME_CURSOR_COLOR (s->f).pixel);
+ 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)
@@ -1060,9 +1352,11 @@ haiku_draw_stretch_glyph_string (struct glyph_string *s)
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)
{
- uint32_t bkg;
if (s->row->mouse_face_p && cursor_in_mouse_face_p (s->w))
haiku_mouse_face_colors (s, NULL, &bkg);
else
@@ -1071,6 +1365,16 @@ haiku_draw_stretch_glyph_string (struct glyph_string *s)
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)
@@ -1088,17 +1392,8 @@ haiku_draw_stretch_glyph_string (struct glyph_string *s)
}
if (background_width > 0)
- {
- void *view = FRAME_HAIKU_VIEW (s->f);
- uint32_t bkg;
- if (s->hl == DRAW_CURSOR)
- bkg = FRAME_CURSOR_COLOR (s->f).pixel;
- else
- bkg = s->face->background;
-
- BView_SetHighColor (view, bkg);
- BView_FillRectangle (view, x, s->y, background_width, s->height);
- }
+ haiku_draw_background_rect (s, s->face, s->x, s->y,
+ background_width, s->height);
}
s->background_filled_p = 1;
}
@@ -1107,7 +1402,6 @@ static void
haiku_start_clip (struct glyph_string *s)
{
void *view = FRAME_HAIKU_VIEW (s->f);
- BView_draw_lock (view);
BView_StartClip (view);
}
@@ -1116,7 +1410,6 @@ haiku_end_clip (struct glyph_string *s)
{
void *view = FRAME_HAIKU_VIEW (s->f);
BView_EndClip (view);
- BView_draw_unlock (view);
}
static void
@@ -1147,7 +1440,7 @@ static void
haiku_update_end (struct frame *f)
{
MOUSE_HL_INFO (f)->mouse_face_defer = false;
- flush_frame (f);
+ BWindow_Flush (FRAME_HAIKU_WINDOW (f));
}
static void
@@ -1173,14 +1466,16 @@ haiku_draw_composite_glyph_string_foreground (struct glyph_string *s)
/* Draw a rectangle for the composition if the font for the very
first character of the composition could not be loaded. */
-
if (s->font_not_found_p && !s->cmp_from)
{
if (s->hl == DRAW_CURSOR)
BView_SetHighColor (view, FRAME_OUTPUT_DATA (s->f)->cursor_fg);
else
BView_SetHighColor (view, s->face->foreground);
- BView_StrokeRectangle (view, s->x, s->y, s->width - 1, s->height - 1);
+
+ BView_SetPenSize (view, 1);
+ BView_StrokeRectangle (view, s->x, s->y,
+ s->width, s->height);
}
else if (!s->first_glyph->u.cmp.automatic)
{
@@ -1332,19 +1627,29 @@ haiku_draw_image_relief (struct glyph_string *s)
get_glyph_string_clip_rect (s, &r);
haiku_draw_relief_rect (s, x, y, x1, y1, thick, thick, raised_p,
- top_p, bot_p, left_p, right_p, &r, 0);
+ 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;
- int height, width;
+ 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)
@@ -1365,19 +1670,21 @@ haiku_draw_image_glyph_string (struct glyph_string *s)
if (s->slice.y == 0)
y += box_line_vwidth;
- void *view = FRAME_HAIKU_VIEW (s->f);
- void *bitmap = s->img->pixmap;
+ view = FRAME_HAIKU_VIEW (s->f);
+ bitmap = s->img->pixmap;
s->stippled_p = face->stipple != 0;
- BView_SetHighColor (view, face->background);
- BView_FillRectangle (view, x, y, width, height);
+ 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)
{
- struct haiku_rect nr;
- Emacs_Rectangle cr, ir, r;
-
get_glyph_string_clip_rect (s, &nr);
CONVERT_TO_EMACS_RECT (cr, nr);
x = s->x;
@@ -1399,45 +1706,91 @@ haiku_draw_image_glyph_string (struct glyph_string *s)
ir.height = s->slice.height;
r = ir;
- void *mask = s->img->mask;
+ mask = s->img->mask;
if (gui_intersect_rectangles (&cr, &ir, &r))
{
- if (s->img->have_be_transforms_p)
+ 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)
{
- bitmap = BBitmap_transform_bitmap (bitmap,
- s->img->mask,
- face->background,
- s->img->be_rotate,
- s->img->width,
- s->img->height);
- mask = NULL;
+ BView_StartClip (view);
+ BView_ClipToRect (view, r.x, r.y, r.width, r.height);
}
- BView_DrawBitmap (view, bitmap,
- s->slice.x + r.x - x,
- s->slice.y + r.y - y,
- r.width, r.height,
- r.x, r.y, r.width, r.height);
- if (mask)
+ 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_DrawMask (mask, view,
- s->slice.x + r.x - x,
- s->slice.y + r.y - y,
- r.width, r.height,
- r.x, r.y, r.width, r.height,
- face->background);
+ 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);
}
-
- if (s->img->have_be_transforms_p)
- BBitmap_free (bitmap);
+ 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->hl == DRAW_CURSOR)
+ if (!s->img->mask)
{
- BView_SetPenSize (view, 1);
- BView_SetHighColor (view, FRAME_CURSOR_COLOR (s->f).pixel);
- BView_StrokeRectangle (view, r.x, r.y, r.width, r.height);
+ /* 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);
+ }
}
}
@@ -1450,12 +1803,14 @@ haiku_draw_image_glyph_string (struct glyph_string *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);
- struct face *face = s->face;
- if (face != s->face)
- prepare_face_for_display (s->f, face);
+ s->stippled_p = s->hl != DRAW_CURSOR && face->stipple;
if (s->next && s->right_overhang && !s->for_overlaps)
{
@@ -1467,13 +1822,16 @@ haiku_draw_glyph_string (struct glyph_string *s)
width += next->width, next = next->next)
if (next->first_glyph->type != IMAGE_GLYPH)
{
- prepare_face_for_display (s->f, s->next->face);
- haiku_start_clip (s->next);
- haiku_clip_to_string (s->next);
+ 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 (s->next, 1);
+ haiku_maybe_draw_background (next, true);
else
- haiku_draw_stretch_glyph_string (s->next);
+ haiku_draw_stretch_glyph_string (next);
haiku_end_clip (s);
}
}
@@ -1489,7 +1847,7 @@ haiku_draw_glyph_string (struct glyph_string *s)
haiku_clip_to_string (s);
haiku_maybe_draw_background (s, 1);
box_filled_p = 1;
- haiku_draw_string_box (s, 0);
+ haiku_draw_string_box (s);
}
else if (!s->clip_head /* draw_glyphs didn't specify a clip mask. */
&& !s->clip_tail
@@ -1542,10 +1900,9 @@ haiku_draw_glyph_string (struct glyph_string *s)
if (!s->for_overlaps)
{
if (!box_filled_p && face->box != FACE_NO_BOX)
- haiku_draw_string_box (s, 1);
+ haiku_draw_string_box (s);
else
- haiku_draw_text_decoration (s, face, face->foreground,
- s->width, s->x);
+ haiku_draw_text_decoration (s, face, s->width, s->x);
if (s->prev)
{
@@ -1599,7 +1956,19 @@ haiku_draw_glyph_string (struct glyph_string *s)
}
}
}
+
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 ();
}
@@ -1633,13 +2002,18 @@ haiku_after_update_window_line (struct window *w,
if (face)
{
void *view = FRAME_HAIKU_VIEW (f);
- BView_draw_lock (view);
+ 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_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);
}
@@ -1657,118 +2031,243 @@ 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);
+ 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_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)
+haiku_draw_hollow_cursor (struct window *w, struct glyph_row *row)
{
- struct frame *f = XFRAME (WINDOW_FRAME (w));
-
- struct glyph *phys_cursor_glyph;
+ struct frame *f;
+ int x, y, wd, h;
struct glyph *cursor_glyph;
+ uint32_t foreground;
+ void *view;
- void *view = FRAME_HAIKU_VIEW (f);
-
- int fx, fy, h, cursor_height;
+ f = XFRAME (WINDOW_FRAME (w));
+ view = FRAME_HAIKU_VIEW (f);
- if (!on_p)
+ /* 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;
- if (cursor_type == NO_CURSOR)
- {
- w->phys_cursor_width = 0;
- return;
- }
+ /* Compute frame-relative coordinates for phys cursor. */
+ get_phys_cursor_geometry (w, row, cursor_glyph, &x, &y, &h);
+ wd = w->phys_cursor_width;
- w->phys_cursor_on_p = true;
- w->phys_cursor_type = cursor_type;
+ /* 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;
- phys_cursor_glyph = get_phys_cursor_glyph (w);
+ /* 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 (!phys_cursor_glyph)
- {
- if (glyph_row->exact_window_width_line_p
- && w->phys_cursor.hpos >= glyph_row->used[TEXT_AREA])
- {
- glyph_row->cursor_in_fringe_p = 1;
- draw_fringe_bitmap (w, glyph_row, 0);
- }
- return;
- }
+ /* 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);
+}
- get_phys_cursor_geometry (w, glyph_row, phys_cursor_glyph, &fx, &fy, &h);
+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_type == BAR_CURSOR)
+ /* 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)
{
- if (cursor_width < 1)
- cursor_width = max (FRAME_CURSOR_WIDTH (f), 1);
- if (cursor_width < w->phys_cursor_width)
- w->phys_cursor_width = cursor_width;
+ r = MATRIX_ROW (w->current_matrix, w->phys_cursor.vpos);
+ draw_phys_cursor_glyph (w, r, DRAW_CURSOR);
}
- else if (cursor_type == HBAR_CURSOR)
+ else
{
- cursor_height = (cursor_width < 1) ? lrint (0.25 * h) : cursor_width;
- if (cursor_height > glyph_row->height)
- cursor_height = glyph_row->height;
- if (h > cursor_height)
- fy += h - cursor_height;
- h = cursor_height;
- }
+ 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);
- BView_StartClip (view);
- BView_SetHighColor (view, FRAME_CURSOR_COLOR (f).pixel);
- haiku_clip_to_row (w, glyph_row, TEXT_AREA);
+ 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);
- switch (cursor_type)
+ 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)
{
- default:
- case DEFAULT_CURSOR:
- case NO_CURSOR:
- break;
- case HBAR_CURSOR:
- BView_FillRectangle (view, fx, fy, w->phys_cursor_width, h);
- break;
- case BAR_CURSOR:
- cursor_glyph = get_phys_cursor_glyph (w);
- if (cursor_glyph->resolved_level & 1)
- BView_FillRectangle (view, fx + cursor_glyph->pixel_width - w->phys_cursor_width,
- fy, w->phys_cursor_width, h);
- else
- BView_FillRectangle (view, fx, fy, w->phys_cursor_width, h);
- break;
- case HOLLOW_BOX_CURSOR:
- if (phys_cursor_glyph->type != IMAGE_GLYPH)
+ 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])))
{
- BView_SetPenSize (view, 1);
- BView_StrokeRectangle (view, fx, fy, w->phys_cursor_width, h);
+ glyph_row->cursor_in_fringe_p = true;
+ draw_fringe_bitmap (w, glyph_row, glyph_row->reversed_p);
}
else
- draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR);
- break;
- case FILLED_BOX_CURSOR:
- draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR);
+ {
+ 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 ();
+ }
+ }
}
- BView_EndClip (view);
- BView_draw_unlock (view);
}
static void
haiku_show_hourglass (struct frame *f)
{
- if (FRAME_OUTPUT_DATA (f)->hourglass_p)
+ if (FRAME_TOOLTIP_P (f)
+ || FRAME_OUTPUT_DATA (f)->hourglass_p)
return;
block_input ();
@@ -1783,7 +2282,8 @@ haiku_show_hourglass (struct frame *f)
static void
haiku_hide_hourglass (struct frame *f)
{
- if (!FRAME_OUTPUT_DATA (f)->hourglass_p)
+ if (FRAME_TOOLTIP_P (f)
+ || !FRAME_OUTPUT_DATA (f)->hourglass_p)
return;
block_input ();
@@ -1835,7 +2335,7 @@ haiku_draw_vertical_window_border (struct window *w,
face = FACE_FROM_ID_OR_NULL (f, VERTICAL_BORDER_FACE_ID);
void *view = FRAME_HAIKU_VIEW (f);
- BView_draw_lock (view);
+ BView_draw_lock (view, true, x, y_0, 1, y_1);
BView_StartClip (view);
if (face)
BView_SetHighColor (view, face->foreground);
@@ -1847,19 +2347,25 @@ haiku_draw_vertical_window_border (struct window *w,
static void
haiku_set_scroll_bar_default_width (struct frame *f)
{
- int unit = FRAME_COLUMN_WIDTH (f);
- FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = BScrollBar_default_size (0) + 1;
- FRAME_CONFIG_SCROLL_BAR_COLS (f) =
- (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) + unit - 1) / unit;
+ 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 = FRAME_LINE_HEIGHT (f);
- FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = BScrollBar_default_size (1) + 1;
- FRAME_CONFIG_SCROLL_BAR_LINES (f) =
- (FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) + height - 1) / height;
+ 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
@@ -1880,7 +2386,7 @@ haiku_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1)
: FRAME_FOREGROUND_PIXEL (f));
void *view = FRAME_HAIKU_VIEW (f);
- BView_draw_lock (view);
+ BView_draw_lock (view, true, x0, y0, x1 - x0 + 1, y1 - y0 + 1);
BView_StartClip (view);
if ((y1 - y0 > x1 - x0) && (x1 - x0 >= 3))
@@ -1899,11 +2405,11 @@ haiku_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1)
last pixels differently. */
{
BView_SetHighColor (view, color_first);
- BView_StrokeLine (f, x0, y0, x1 - 1, y0);
+ 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_StrokeLine (view, x0, y1, x1 - 1, y1);
+ BView_FillRectangle (view, x0, y1 - 1, x1 - x0, 1);
}
else
{
@@ -2041,15 +2547,17 @@ static struct scroll_bar *
haiku_scroll_bar_create (struct window *w, int left, int top,
int width, int height, bool horizontal_p)
{
- struct frame *f = XFRAME (WINDOW_FRAME (w));
+ struct frame *f;
Lisp_Object barobj;
+ struct scroll_bar *bar;
+ void *scroll_bar;
+ void *view;
- void *sb = NULL;
- void *vw = FRAME_HAIKU_VIEW (f);
+ f = XFRAME (WINDOW_FRAME (w));
+ view = FRAME_HAIKU_VIEW (f);
block_input ();
- struct scroll_bar *bar
- = ALLOCATE_PSEUDOVECTOR (struct scroll_bar, prev, PVEC_OTHER);
+ bar = ALLOCATE_PSEUDOVECTOR (struct scroll_bar, prev, PVEC_OTHER);
XSETWINDOW (bar->window, w);
bar->top = top;
@@ -2062,15 +2570,14 @@ haiku_scroll_bar_create (struct window *w, int left, int top,
bar->update = -1;
bar->horizontal = horizontal_p;
- sb = BScrollBar_make_for_view (vw, horizontal_p,
- left, top, left + width - 1,
- top + height - 1, bar);
-
- BView_publish_scroll_bar (vw, left, top, width, height);
+ 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 = sb;
+ bar->scroll_bar = scroll_bar;
XSETVECTOR (barobj, bar);
fset_scroll_bars (f, barobj);
@@ -2084,25 +2591,26 @@ haiku_scroll_bar_create (struct window *w, int left, int top,
static void
haiku_set_horizontal_scroll_bar (struct window *w, int portion, int whole, int position)
{
- eassert (WINDOW_HAS_HORIZONTAL_SCROLL_BAR (w));
Lisp_Object barobj;
struct scroll_bar *bar;
int top, height, left, width;
int window_x, window_width;
+ 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);
- BView_scroll_bar_update (bar->scroll_bar, portion, whole, position);
bar->update = position;
bar->position = position;
bar->total = whole;
@@ -2111,27 +2619,23 @@ haiku_set_horizontal_scroll_bar (struct window *w, int portion, int whole, int p
{
bar = XSCROLL_BAR (w->horizontal_scroll_bar);
- if (bar->left != left || bar->top != top ||
- bar->width != width || bar->height != height)
+ if (bar->left != left || bar->top != top
+ || bar->width != width || bar->height != height)
{
- void *view = FRAME_HAIKU_VIEW (WINDOW_XFRAME (w));
BView_forget_scroll_bar (view, bar->left, bar->top,
bar->width, bar->height);
BView_move_frame (bar->scroll_bar, left, top,
left + width - 1, top + height - 1);
BView_publish_scroll_bar (view, left, top, width, height);
+
bar->left = left;
bar->top = top;
bar->width = width;
bar->height = height;
}
-
- if (!bar->dragging)
- {
- BView_scroll_bar_update (bar->scroll_bar, portion, whole, position);
- BView_invalidate (bar->scroll_bar);
- }
}
+
+ haiku_set_horizontal_scroll_bar_thumb (bar, portion, position, whole);
bar->position = position;
bar->total = whole;
XSETVECTOR (barobj, bar);
@@ -2140,14 +2644,15 @@ haiku_set_horizontal_scroll_bar (struct window *w, int portion, int whole, int p
}
static void
-haiku_set_vertical_scroll_bar (struct window *w,
- int portion, int whole, int position)
+haiku_set_vertical_scroll_bar (struct window *w, int portion, int whole, int position)
{
- eassert (WINDOW_HAS_VERTICAL_SCROLL_BAR (w));
Lisp_Object barobj;
struct scroll_bar *bar;
int top, height, left, width;
int window_y, window_height;
+ void *view;
+
+ eassert (WINDOW_HAS_VERTICAL_SCROLL_BAR (w));
/* Get window dimensions. */
window_box (w, ANY_AREA, 0, &window_y, 0, &window_height);
@@ -2157,12 +2662,13 @@ haiku_set_vertical_scroll_bar (struct window *w,
/* Compute the left edge and the width of the scroll bar area. */
left = WINDOW_SCROLL_BAR_AREA_X (w);
width = WINDOW_SCROLL_BAR_AREA_WIDTH (w);
- block_input ();
+ 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);
- BView_scroll_bar_update (bar->scroll_bar, portion, whole, position);
bar->position = position;
bar->total = whole;
}
@@ -2170,30 +2676,23 @@ haiku_set_vertical_scroll_bar (struct window *w,
{
bar = XSCROLL_BAR (w->vertical_scroll_bar);
- if (bar->left != left || bar->top != top ||
- bar->width != width || bar->height != height)
+ if (bar->left != left || bar->top != top
+ || bar->width != width || bar->height != height)
{
- void *view = FRAME_HAIKU_VIEW (WINDOW_XFRAME (w));
BView_forget_scroll_bar (view, bar->left, bar->top,
bar->width, bar->height);
BView_move_frame (bar->scroll_bar, left, top,
left + width - 1, top + height - 1);
- flush_frame (WINDOW_XFRAME (w));
BView_publish_scroll_bar (view, left, top, width, height);
+
bar->left = left;
bar->top = top;
bar->width = width;
bar->height = height;
}
-
- if (!bar->dragging)
- {
- BView_scroll_bar_update (bar->scroll_bar, portion, whole, position);
- bar->update = position;
- BView_invalidate (bar->scroll_bar);
- }
}
+ haiku_set_scroll_bar_thumb (bar, portion, position, whole);
bar->position = position;
bar->total = whole;
@@ -2206,24 +2705,69 @@ static void
haiku_draw_fringe_bitmap (struct window *w, struct glyph_row *row,
struct draw_fringe_bitmap_params *p)
{
- void *view = FRAME_HAIKU_VIEW (XFRAME (WINDOW_FRAME (w)));
- struct face *face = p->face;
+ struct face *face;
+ struct frame *f;
+ struct haiku_bitmap_record *rec;
+ void *view, *bitmap;
+ uint32 col;
- BView_draw_lock (view);
+ 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_SetHighColor (view, face->background);
- BView_FillRectangle (view, p->bx, p->by, p->nx, p->ny);
+ 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 < fringe_bitmap_fillptr)
+ if (p->which
+ && p->which < max_fringe_bmp
+ && p->which < max_used_fringe_bitmap)
{
- void *bitmap = fringe_bmps[p->which];
+ bitmap = fringe_bmps[p->which];
- uint32_t col;
+ 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;
@@ -2243,31 +2787,36 @@ haiku_draw_fringe_bitmap (struct window *w, struct glyph_row *row,
}
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 >= fringe_bitmap_fillptr)
+ if (which >= max_fringe_bmp)
{
- int i = fringe_bitmap_fillptr;
- fringe_bitmap_fillptr = which + 20;
- fringe_bmps = !i ? xmalloc (fringe_bitmap_fillptr * sizeof (void *)) :
- xrealloc (fringe_bmps, fringe_bitmap_fillptr * sizeof (void *));
+ 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 < fringe_bitmap_fillptr)
+ while (i < max_fringe_bmp)
fringe_bmps[i++] = NULL;
}
+ block_input ();
fringe_bmps[which] = BBitmap_new (wd, h, 1);
- BBitmap_import_mono_bits (fringe_bmps[which], bits, wd, h);
+ 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 >= fringe_bitmap_fillptr)
+ if (which >= max_fringe_bmp)
return;
if (fringe_bmps[which])
@@ -2306,78 +2855,55 @@ haiku_scroll_run (struct window *w, struct run *run)
height = run->height;
}
- if (!height)
- return;
-
block_input ();
gui_clear_cursor (w);
- BView_draw_lock (view);
-#ifdef USE_BE_CAIRO
- if (EmacsView_double_buffered_p (view))
- {
-#endif
- BView_StartClip (view);
- BView_CopyBits (view, x, from_y, width, height,
- x, to_y, width, height);
- BView_EndClip (view);
-#ifdef USE_BE_CAIRO
- }
- else
- {
- EmacsWindow_begin_cr_critical_section (FRAME_HAIKU_WINDOW (f));
- cairo_surface_t *surface = FRAME_CR_SURFACE (f);
- cairo_surface_t *s
- = cairo_surface_create_similar (surface,
- cairo_surface_get_content (surface),
- width, height);
- cairo_t *cr = cairo_create (s);
- if (surface)
- {
- cairo_set_source_surface (cr, surface, -x, -from_y);
- cairo_paint (cr);
- cairo_destroy (cr);
-
- cr = haiku_begin_cr_clip (f, NULL);
- cairo_save (cr);
- cairo_set_source_surface (cr, s, x, to_y);
- cairo_set_operator (cr, CAIRO_OPERATOR_SOURCE);
- cairo_rectangle (cr, x, to_y, width, height);
- cairo_fill (cr);
- cairo_restore (cr);
- cairo_surface_destroy (s);
- haiku_end_cr_clip (cr);
- }
- EmacsWindow_end_cr_critical_section (FRAME_HAIKU_WINDOW (f));
- }
-#endif
+
+ 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 ();
- Lisp_Object frame, tail;
- struct frame *f1 = NULL;
+
FOR_EACH_FRAME (tail, frame)
- XFRAME (frame)->mouse_moved = false;
+ {
+ if (FRAME_HAIKU_P (XFRAME (frame)))
+ XFRAME (frame)->mouse_moved = false;
+ }
- if (gui_mouse_grabbed (x_display_list) && !EQ (track_mouse, Qdropping))
+ 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_TOOLTIP_P (f1))
- f1 = ((EQ (track_mouse, Qdropping) && gui_mouse_grabbed (x_display_list))
- ? x_display_list->last_mouse_frame
- : NULL);
-
- if (!f1 && insist > 0)
+ if (!f1 && FRAME_HAIKU_P (SELECTED_FRAME ()))
f1 = SELECTED_FRAME ();
if (!f1 || (!FRAME_HAIKU_P (f1) && (insist > 0)))
@@ -2386,26 +2912,37 @@ haiku_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window,
!FRAME_TOOLTIP_P (XFRAME (frame)))
f1 = XFRAME (frame);
- if (FRAME_TOOLTIP_P (f1))
+ if (f1 && FRAME_TOOLTIP_P (f1))
f1 = NULL;
if (f1 && FRAME_HAIKU_P (f1))
{
- int sx, sy;
- void *view = FRAME_HAIKU_VIEW (f1);
+ view = FRAME_HAIKU_VIEW (f1);
+
if (view)
{
- BView_get_mouse (view, &sx, &sy);
-
- remember_mouse_glyph (f1, sx, sy, &x_display_list->last_mouse_glyph);
+ BView_get_mouse (view, &screen_x, &screen_y);
+ remember_mouse_glyph (f1, screen_x, screen_y,
+ &x_display_list->last_mouse_glyph);
x_display_list->last_mouse_glyph_frame = f1;
*bar_window = Qnil;
- *part = scroll_bar_above_handle;
- *fp = f1;
+ *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, sx);
- XSETINT (*y, sy);
+ XSETINT (*x, screen_x);
+ XSETINT (*y, screen_y);
}
}
@@ -2415,15 +2952,21 @@ haiku_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window,
static void
haiku_flush (struct frame *f)
{
- if (FRAME_VISIBLE_P (f))
+ /* This is needed for tooltip frames to work properly with double
+ buffering. */
+ if (FRAME_DIRTY_P (f) && !buffer_flipping_blocked_p ())
+ haiku_flip_buffers (f);
+
+ if (FRAME_VISIBLE_P (f) && !FRAME_TOOLTIP_P (f))
BWindow_Flush (FRAME_HAIKU_WINDOW (f));
}
static void
haiku_define_frame_cursor (struct frame *f, Emacs_Cursor cursor)
{
- if (f->tooltip)
+ if (FRAME_TOOLTIP_P (f))
return;
+
block_input ();
if (!f->pointer_invisible && FRAME_HAIKU_VIEW (f)
&& !FRAME_OUTPUT_DATA (f)->hourglass_p)
@@ -2433,20 +2976,13 @@ haiku_define_frame_cursor (struct frame *f, Emacs_Cursor cursor)
}
static void
-haiku_update_window_end (struct window *w, bool cursor_on_p,
- bool mouse_face_overwritten_p)
-{
-
-}
-
-static void
haiku_default_font_parameter (struct frame *f, Lisp_Object parms)
{
struct haiku_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
Lisp_Object font_param = gui_display_get_arg (dpyinfo, parms, Qfont, NULL, NULL,
RES_TYPE_STRING);
Lisp_Object font = Qnil;
- if (EQ (font_param, Qunbound))
+ if (BASE_EQ (font_param, Qunbound))
font_param = Qnil;
if (NILP (font_param))
@@ -2457,10 +2993,7 @@ haiku_default_font_parameter (struct frame *f, Lisp_Object parms)
struct haiku_font_pattern ptn;
ptn.specified = 0;
- if (f->tooltip)
- BFont_populate_plain_family (&ptn);
- else
- BFont_populate_fixed_family (&ptn);
+ BFont_populate_fixed_family (&ptn);
if (ptn.specified & FSPEC_FAMILY)
font = font_open_by_name (f, build_unibyte_string (ptn.family));
@@ -2510,8 +3043,8 @@ static struct redisplay_interface haiku_redisplay_interface =
gui_clear_end_of_line,
haiku_scroll_run,
haiku_after_update_window_line,
- NULL,
- haiku_update_window_end,
+ NULL, /* update_window_begin */
+ NULL, /* update_window_end */
haiku_flush,
gui_clear_window_mouse_face,
gui_get_glyph_overhangs,
@@ -2527,7 +3060,7 @@ static struct redisplay_interface haiku_redisplay_interface =
haiku_draw_window_cursor,
haiku_draw_vertical_window_border,
haiku_draw_window_divider,
- 0, /* shift glyphs for insert */
+ NULL, /* shift glyphs for insert */
haiku_show_hourglass,
haiku_hide_hourglass,
haiku_default_font_parameter,
@@ -2536,54 +3069,88 @@ static struct redisplay_interface haiku_redisplay_interface =
static void
haiku_make_fullscreen_consistent (struct frame *f)
{
- Lisp_Object lval = get_frame_param (f, Qfullscreen);
-
- if (!EQ (lval, Qmaximized) && FRAME_OUTPUT_DATA (f)->zoomed_p)
+ 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 if (EQ (lval, Qmaximized) && !FRAME_OUTPUT_DATA (f)->zoomed_p)
+ else
lval = Qnil;
store_frame_param (f, Qfullscreen, lval);
}
static void
-flush_dirty_back_buffers (void)
+haiku_flush_dirty_back_buffer_on (struct frame *f)
{
- block_input ();
- Lisp_Object tail, frame;
- FOR_EACH_FRAME (tail, frame)
+ 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)
{
- struct frame *f = XFRAME (frame);
- if (FRAME_LIVE_P (f) &&
- FRAME_HAIKU_P (f) &&
- FRAME_HAIKU_WINDOW (f) &&
- !FRAME_GARBAGED_P (f) &&
- !buffer_flipping_blocked_p () &&
- FRAME_DIRTY_P (f))
- haiku_flip_buffers (f);
+ 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;
}
- unblock_input ();
+
+ unbind_to (depth, Qnil);
}
static int
haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
{
- block_input ();
- int message_count = 0;
- static void *buf = NULL;
+ int message_count;
+ void *buf;
ssize_t b_size;
- struct unhandled_event *unhandled_events = NULL;
- int button_or_motion_p;
- int need_flush = 0;
+ 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;
- if (!buf)
- buf = xmalloc (200);
- haiku_read_size (&b_size);
+ buf = alloca (200);
+
+ block_input ();
+ haiku_read_size (&b_size, false);
while (b_size >= 0)
{
- enum haiku_event_type type;
- struct input_event inev, inev2;
-
if (b_size > 200)
emacs_abort ();
@@ -2595,7 +3162,6 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
inev2.arg = Qnil;
button_or_motion_p = 0;
-
haiku_read (&type, buf, b_size);
switch (type)
@@ -2620,12 +3186,35 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
if (!f)
continue;
- int width = lrint (b->px_widthf);
- int height = lrint (b->px_heightf);
+ 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;
- BView_draw_lock (FRAME_HAIKU_VIEW (f));
+ 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
@@ -2638,18 +3227,6 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
haiku_clear_under_internal_border (f);
}
- if (FRAME_OUTPUT_DATA (f)->pending_zoom_width != width ||
- FRAME_OUTPUT_DATA (f)->pending_zoom_height != height)
- {
- FRAME_OUTPUT_DATA (f)->zoomed_p = 0;
- haiku_make_fullscreen_consistent (f);
- }
- else
- {
- FRAME_OUTPUT_DATA (f)->zoomed_p = 1;
- FRAME_OUTPUT_DATA (f)->pending_zoom_width = INT_MIN;
- FRAME_OUTPUT_DATA (f)->pending_zoom_height = INT_MIN;
- }
break;
}
case FRAME_EXPOSED:
@@ -2661,7 +3238,6 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
continue;
expose_frame (f, b->x, b->y, b->width, b->height);
-
haiku_clear_under_internal_border (f);
break;
}
@@ -2670,7 +3246,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
struct haiku_key_event *b = buf;
Mouse_HLInfo *hlinfo = &x_display_list->mouse_highlight;
struct frame *f = haiku_window_to_frame (b->window);
- int non_ascii_p;
+
if (!f)
continue;
@@ -2683,20 +3259,26 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
{
clear_mouse_face (hlinfo);
hlinfo->mouse_face_hidden = true;
- need_flush = 1;
+ haiku_flush_dirty_back_buffer_on (f);
}
- inev.code = b->unraw_mb_char;
-
- BMapKey (b->kc, &non_ascii_p, &inev.code);
+ inev.code = b->keysym ? b->keysym : b->multibyte_char;
- if (non_ascii_p)
+ if (b->keysym)
inev.kind = NON_ASCII_KEYSTROKE_EVENT;
else
inev.kind = inev.code > 127 ? MULTIBYTE_CHAR_KEYSTROKE_EVENT :
ASCII_KEYSTROKE_EVENT;
- inev.modifiers = haiku_modifiers_to_emacs (b->modifiers);
+ 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;
}
@@ -2708,8 +3290,8 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
if (!f)
continue;
- if ((x_display_list->focus_event_frame != f && b->activated_p) ||
- (x_display_list->focus_event_frame == f && !b->activated_p))
+ 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)
@@ -2722,26 +3304,62 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
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_window_to_frame (b->window);
+ 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;
- Lisp_Object frame;
+ 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 = time (NULL);
+ x_display_list->last_mouse_movement_time = b->time / 1000;
button_or_motion_p = 1;
if (hlinfo->mouse_face_hidden)
{
hlinfo->mouse_face_hidden = false;
clear_mouse_face (hlinfo);
- need_flush = 1;
+ haiku_flush_dirty_back_buffer_on (f);
}
if (b->just_exited_p)
@@ -2754,18 +3372,47 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
clear_mouse_face (hlinfo);
hlinfo->mouse_face_mouse_frame = 0;
- need_flush = 1;
+ 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);
- help_echo_string = Qnil;
- gen_help_event (Qnil, frame, Qnil, Qnil, 0);
+
+ 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;
@@ -2773,18 +3420,17 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
previous_help_echo_string = help_echo_string;
help_echo_string = Qnil;
- /* A LeaveNotify event (well, the closest equivalent on Haiku, which
- is a B_MOUSE_MOVED event with `transit' set to B_EXITED_VIEW) might
- be sent out-of-order with regards to motion events from other
- windows, such as when the mouse pointer rapidly moves from an
- undecorated child frame to its parent. This can cause a failure to
- clear the mouse face on the former if an event for the latter is
- read by Emacs first and ends up showing the mouse face there.
+ /* 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.
- In case the `movement_locker' (also see the comment
- there) doesn't take care of the problem, work
- around it by clearing the mouse face now, if it is
- currently shown on a different frame. */
+ 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
@@ -2799,14 +3445,13 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
|| b->y < r.y || b->y >= r.y + r.height)
{
f->mouse_moved = true;
- dpyinfo->last_mouse_scroll_bar = NULL;
note_mouse_highlight (f, b->x, b->y);
remember_mouse_glyph (f, b->x, b->y,
&FRAME_DISPLAY_INFO (f)->last_mouse_glyph);
dpyinfo->last_mouse_glyph_frame = f;
- gen_help_event (help_echo_string, frame, help_echo_window,
- help_echo_object, help_echo_pos);
}
+ else
+ help_echo_string = previous_help_echo_string;
if (!NILP (Vmouse_autoselect_window))
{
@@ -2816,36 +3461,74 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
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)
- || (EQ (XWINDOW (window)->frame,
- XWINDOW (selected_window)->frame))))
+ || f == SELECTED_FRAME ()))
{
- inev.kind = SELECT_WINDOW_EVENT;
- inev.frame_or_window = window;
+ 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_window_to_frame (b->window);
+ 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 (!f)
+ if (popup_activated_p || !f)
continue;
- struct haiku_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
-
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 = time (NULL);
+ x_display_list->last_mouse_movement_time = b->time / 1000;
button_or_motion_p = 1;
/* Is this in the tab-bar? */
@@ -2863,7 +3546,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
{
tab_bar_arg = handle_tab_bar_click
(f, x, y, type == BUTTON_DOWN, inev.modifiers);
- need_flush = 1;
+ haiku_flush_dirty_back_buffer_on (f);
}
}
@@ -2875,43 +3558,79 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
int y = b->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)
+ && (type != BUTTON_UP
+ || f->last_tool_bar_item != -1));
if (tool_bar_p)
{
handle_tool_bar_click
(f, x, y, type == BUTTON_DOWN, inev.modifiers);
- need_flush = 1;
+ haiku_flush_dirty_back_buffer_on (f);
}
}
if (type == BUTTON_UP)
{
inev.modifiers |= up_modifier;
- dpyinfo->grabbed &= ~(1 << b->btn_no);
+ 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;
- dpyinfo->last_mouse_frame = f;
- dpyinfo->grabbed |= (1 << b->btn_no);
+ 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 (!(tab_bar_p && NILP (tab_bar_arg)) && !tool_bar_p)
+ 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;
- XSETINT (inev.x, b->x);
- XSETINT (inev.y, b->y);
+ 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);
+ }
- XSETFRAME (inev.frame_or_window, f);
break;
}
case ICONIFICATION:
@@ -2928,7 +3647,6 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
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. */
@@ -2952,40 +3670,36 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
{
struct haiku_move_event *b = buf;
struct frame *f = haiku_window_to_frame (b->window);
+ int top, left;
+ struct frame *p;
if (!f)
continue;
- if (FRAME_OUTPUT_DATA (f)->pending_zoom_x != b->x ||
- FRAME_OUTPUT_DATA (f)->pending_zoom_y != b->y)
- FRAME_OUTPUT_DATA (f)->zoomed_p = 0;
- else
- {
- FRAME_OUTPUT_DATA (f)->zoomed_p = 1;
- FRAME_OUTPUT_DATA (f)->pending_zoom_x = INT_MIN;
- FRAME_OUTPUT_DATA (f)->pending_zoom_y = INT_MIN;
- }
+ 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);
- if (b->x != f->left_pos || b->y != f->top_pos)
+ 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, b->x);
- XSETINT (inev.y, b->y);
+ XSETINT (inev.x, left);
+ XSETINT (inev.y, top);
- f->left_pos = b->x;
- f->top_pos = b->y;
+ f->left_pos = left;
+ f->top_pos = top;
- struct frame *p;
+ p = FRAME_PARENT_FRAME (f);
- if ((p = FRAME_PARENT_FRAME (f)))
- {
- void *window = FRAME_HAIKU_WINDOW (p);
- EmacsWindow_move_weak_child (window, b->window, b->x, b->y);
- }
+ if (p)
+ EmacsWindow_move_weak_child (FRAME_HAIKU_WINDOW (p),
+ b->window, left, top);
XSETFRAME (inev.frame_or_window, f);
}
@@ -2996,7 +3710,12 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
case SCROLL_BAR_VALUE_EVENT:
{
struct haiku_scroll_bar_value_event *b = buf;
- struct scroll_bar *bar = b->scroll_bar;
+ 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);
@@ -3008,21 +3727,76 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
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;
+ 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, b->position);
- XSETINT (inev.y, bar->total);
+ 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 = b->scroll_bar;
+ 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)
@@ -3035,13 +3809,28 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
{
struct haiku_wheel_move_event *b = buf;
struct frame *f = haiku_window_to_frame (b->window);
- int x, y;
+ 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;
@@ -3053,9 +3842,9 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
py = 0;
px += (b->delta_x
- * powf (FRAME_PIXEL_HEIGHT (f), 2.0f / 3.0f));
+ * powf (scroll_width, 2.0f / 3.0f));
py += (b->delta_y
- * powf (FRAME_PIXEL_HEIGHT (f), 2.0f / 3.0f));
+ * powf (scroll_height, 2.0f / 3.0f));
if (fabsf (py) >= FRAME_LINE_HEIGHT (f)
|| fabsf (px) >= FRAME_COLUMN_WIDTH (f)
@@ -3082,7 +3871,6 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
break;
}
-
case MENU_BAR_RESIZE:
{
struct haiku_menu_bar_resize_event *b = buf;
@@ -3091,11 +3879,15 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
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 + 1;
- FRAME_MENU_BAR_LINES (f) =
- (b->height + FRAME_LINE_HEIGHT (f)) / FRAME_LINE_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)
{
@@ -3104,6 +3896,21 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
}
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:
{
@@ -3115,18 +3922,6 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
if (type == MENU_BAR_OPEN)
{
- if (!FRAME_OUTPUT_DATA (f)->menu_up_to_date_p)
- {
- BView_draw_lock (FRAME_HAIKU_VIEW (f));
- /* This shouldn't be here, but nsmenu does it, so
- it should probably be safe. */
- int was_waiting_for_input_p = waiting_for_input;
- if (waiting_for_input)
- waiting_for_input = 0;
- set_frame_menubar (f, 1);
- waiting_for_input = was_waiting_for_input_p;
- BView_draw_unlock (FRAME_HAIKU_VIEW (f));
- }
FRAME_OUTPUT_DATA (f)->menu_bar_open_p = 1;
popup_activated_p += 1;
}
@@ -3134,6 +3929,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
{
if (!popup_activated_p)
emacs_abort ();
+
if (FRAME_OUTPUT_DATA (f)->menu_bar_open_p)
{
FRAME_OUTPUT_DATA (f)->menu_bar_open_p = 0;
@@ -3150,22 +3946,8 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
if (!f || !FRAME_EXTERNAL_MENU_BAR (f))
continue;
- if (FRAME_OUTPUT_DATA (f)->menu_up_to_date_p)
- find_and_call_menu_selection (f, f->menu_bar_items_used,
- f->menu_bar_vector, b->ptr);
- break;
- }
- case FILE_PANEL_EVENT:
- {
- if (!popup_activated_p)
- continue;
-
- struct unhandled_event *ev = xmalloc (sizeof *ev);
- ev->next = unhandled_events;
- ev->type = type;
- memcpy (&ev->buffer, buf, 200);
-
- unhandled_events = ev;
+ find_and_call_menu_selection (f, f->menu_bar_items_used,
+ f->menu_bar_vector, b->ptr);
break;
}
case MENU_BAR_HELP_EVENT:
@@ -3176,96 +3958,137 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
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)
+ if (!f || !FRAME_EXTERNAL_MENU_BAR (f)
+ || !FRAME_OUTPUT_DATA (f)->menu_bar_open_p)
continue;
run_menu_bar_help_event (f, b->mb_idx);
-
break;
}
case ZOOM_EVENT:
{
struct haiku_zoom_event *b = buf;
-
struct frame *f = haiku_window_to_frame (b->window);
if (!f)
continue;
- FRAME_OUTPUT_DATA (f)->pending_zoom_height = b->height;
- FRAME_OUTPUT_DATA (f)->pending_zoom_width = b->width;
- FRAME_OUTPUT_DATA (f)->pending_zoom_x = b->x;
- FRAME_OUTPUT_DATA (f)->pending_zoom_y = b->y;
+ if (b->fullscreen_mode == FULLSCREEN_MODE_MAXIMIZED)
+ f->want_fullscreen = FULLSCREEN_NONE;
+ else
+ f->want_fullscreen = FULLSCREEN_MAXIMIZED;
- FRAME_OUTPUT_DATA (f)->zoomed_p = 1;
- haiku_make_fullscreen_consistent (f);
+ FRAME_TERMINAL (f)->fullscreen_hook (f);
break;
}
- case REFS_EVENT:
+ case DRAG_AND_DROP_EVENT:
{
- struct haiku_refs_event *b = buf;
+ struct haiku_drag_and_drop_event *b = buf;
struct frame *f = haiku_window_to_frame (b->window);
if (!f)
- continue;
+ {
+ BMessage_delete (b->message);
+ continue;
+ }
inev.kind = DRAG_N_DROP_EVENT;
- inev.arg = build_string_from_utf8 (b->ref);
+ inev.arg = haiku_message_to_lisp (b->message);
XSETINT (inev.x, b->x);
XSETINT (inev.y, b->y);
XSETFRAME (inev.frame_or_window, f);
- /* There should be no problem with calling free here.
- free on Haiku is thread-safe. */
- free (b->ref);
+ 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);
+ haiku_read_size (&b_size, false);
if (inev.kind != NO_EVENT)
{
- if (inev.kind != HELP_EVENT)
+ if (inev.kind != HELP_EVENT && !inev.timestamp)
inev.timestamp = (button_or_motion_p
? x_display_list->last_mouse_movement_time
- : time (NULL));
+ : system_time () / 1000);
kbd_buffer_store_event_hold (&inev, hold_quit);
++message_count;
}
if (inev2.kind != NO_EVENT)
{
- if (inev2.kind != HELP_EVENT)
+ if (inev2.kind != HELP_EVENT && !inev.timestamp)
inev2.timestamp = (button_or_motion_p
? x_display_list->last_mouse_movement_time
- : time (NULL));
+ : system_time () / 1000);
kbd_buffer_store_event_hold (&inev2, hold_quit);
++message_count;
}
}
- for (struct unhandled_event *ev = unhandled_events; ev;)
+ if (do_help && !(hold_quit && hold_quit->kind != NO_EVENT))
{
- haiku_write_without_signal (ev->type, &ev->buffer);
- struct unhandled_event *old = ev;
- ev = old->next;
- xfree (old);
- }
+ Lisp_Object help_frame = Qnil;
- if (need_flush)
- flush_dirty_back_buffers ();
+ 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)
{
@@ -3286,6 +4109,99 @@ haiku_free_pixmap (struct frame *f, Emacs_Pixmap 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)
@@ -3294,21 +4210,7 @@ haiku_beep (struct frame *f)
if (view)
{
block_input ();
- BView_draw_lock (view);
- if (!EmacsView_double_buffered_p (view))
- {
- BView_SetHighColorForVisibleBell (view, FRAME_FOREGROUND_PIXEL (f));
- BView_FillRectangleForVisibleBell (view, 0, 0, FRAME_PIXEL_WIDTH (f),
- FRAME_PIXEL_HEIGHT (f));
- SET_FRAME_GARBAGED (f);
- expose_frame (f, 0, 0, 0, 0);
- }
- else
- {
- EmacsView_do_visible_bell (view, FRAME_FOREGROUND_PIXEL (f));
- haiku_flip_buffers (f);
- }
- BView_draw_unlock (view);
+ haiku_flash (f);
unblock_input ();
}
}
@@ -3321,12 +4223,12 @@ haiku_toggle_invisible_pointer (struct frame *f, bool invisible_p)
{
void *view = FRAME_HAIKU_VIEW (f);
- if (view)
+ 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);
+ 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 ();
}
@@ -3335,22 +4237,32 @@ haiku_toggle_invisible_pointer (struct frame *f, bool invisible_p)
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)
- {
- EmacsWindow_make_fullscreen (FRAME_HAIKU_WINDOW (f), 0);
- BWindow_zoom (FRAME_HAIKU_WINDOW (f));
- }
+ mode = FULLSCREEN_MODE_MAXIMIZED;
else if (f->want_fullscreen == FULLSCREEN_BOTH)
- EmacsWindow_make_fullscreen (FRAME_HAIKU_WINDOW (f), 1);
- else if (f->want_fullscreen == FULLSCREEN_NONE)
- {
- EmacsWindow_make_fullscreen (FRAME_HAIKU_WINDOW (f), 0);
- EmacsWindow_unzoom (FRAME_HAIKU_WINDOW (f));
- }
+ 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 *
@@ -3371,7 +4283,7 @@ haiku_create_terminal (struct haiku_display_info *dpyinfo)
terminal->frame_visible_invisible_hook = haiku_set_frame_visible_invisible;
terminal->set_frame_offset_hook = haiku_set_offset;
terminal->delete_terminal_hook = haiku_delete_terminal;
- terminal->get_string_resource_hook = get_string_resource;
+ terminal->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;
@@ -3400,6 +4312,9 @@ haiku_create_terminal (struct haiku_display_info *dpyinfo)
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;
}
@@ -3409,36 +4324,34 @@ haiku_term_init (void)
{
struct haiku_display_info *dpyinfo;
struct terminal *terminal;
-
- Lisp_Object color_file, color_map;
+ Lisp_Object color_file, color_map, system_name;
+ ptrdiff_t nbytes;
+ void *name_buffer;
block_input ();
- Fset_input_interrupt_mode (Qnil);
+ Fset_input_interrupt_mode (Qt);
baud_rate = 19200;
-
dpyinfo = xzalloc (sizeof *dpyinfo);
-
haiku_io_init ();
- if (port_application_to_emacs < B_OK)
+ 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 ();
-
- BScreen_res (&dpyinfo->resx, &dpyinfo->resy);
-
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);
@@ -3456,6 +4369,45 @@ haiku_term_init (void)
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;
@@ -3477,7 +4429,10 @@ put_xrm_resource (Lisp_Object name, Lisp_Object val)
void
haiku_clear_under_internal_border (struct frame *f)
{
- if (FRAME_INTERNAL_BORDER_WIDTH (f) > 0)
+ 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);
@@ -3493,8 +4448,10 @@ haiku_clear_under_internal_border (struct frame *f)
: 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);
+ 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));
@@ -3519,15 +4476,24 @@ void
mark_haiku_display (void)
{
if (x_display_list)
- mark_object (x_display_list->color_map);
+ {
+ 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 ();
- void *view = FRAME_HAIKU_VIEW (WINDOW_XFRAME (XWINDOW (bar->window)));
- BView_forget_scroll_bar (view, bar->left, bar->top, bar->width, bar->height);
+ 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);
@@ -3536,7 +4502,6 @@ haiku_scroll_bar_remove (struct scroll_bar *bar)
wset_horizontal_scroll_bar (XWINDOW (bar->window), Qnil);
else
wset_vertical_scroll_bar (XWINDOW (bar->window), Qnil);
-
unblock_input ();
};
@@ -3544,6 +4509,22 @@ 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;
@@ -3568,22 +4549,54 @@ haiku_set_offset (struct frame *frame, int x, int y,
cairo_t *
haiku_begin_cr_clip (struct frame *f, struct glyph_string *s)
{
- cairo_surface_t *surface = FRAME_CR_SURFACE (f);
- if (!surface)
+ cairo_t *cr = FRAME_CR_CONTEXT (f);
+
+ if (!cr)
return NULL;
- cairo_t *context = cairo_create (surface);
- return context;
+ cairo_save (cr);
+ return cr;
}
void
haiku_end_cr_clip (cairo_t *cr)
{
- cairo_destroy (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,
@@ -3644,7 +4657,6 @@ This is either one of the symbols `shift', `control', `command', and
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");
diff --git a/src/haikuterm.h b/src/haikuterm.h
index 3e39403ab4d..46a2218e492 100644
--- a/src/haikuterm.h
+++ b/src/haikuterm.h
@@ -32,16 +32,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "font.h"
#include "systime.h"
-#define C_FRAME struct frame *
-#define C_FONT struct font *
-#define C_TERMINAL struct terminal *
-
#define HAVE_CHAR_CACHE_MAX 65535
extern int popup_activated_p;
-extern void be_app_quit (void);
-
struct haikufont_info
{
struct font font;
@@ -58,13 +52,17 @@ struct haiku_bitmap_record
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;
- C_TERMINAL terminal;
+ struct terminal *terminal;
Lisp_Object name_list_element;
Lisp_Object color_map;
@@ -86,34 +84,53 @@ struct haiku_display_info
int n_planes;
int color_p;
- Window root_window;
Lisp_Object rdb;
+ Lisp_Object default_name;
Emacs_Cursor vertical_scroll_bar_cursor;
Emacs_Cursor horizontal_scroll_bar_cursor;
Mouse_HLInfo mouse_highlight;
- C_FRAME highlight_frame;
- C_FRAME last_mouse_frame;
- C_FRAME last_mouse_motion_frame;
+ struct frame *highlight_frame;
+ struct frame *last_mouse_frame;
+ struct frame *last_mouse_motion_frame;
int last_mouse_motion_x;
int last_mouse_motion_y;
struct haiku_rect last_mouse_glyph;
- void *last_mouse_scroll_bar;
-
haiku display;
double resx, resy;
Time last_mouse_movement_time;
+
+ Window root_window;
+
+ Emacs_Cursor text_cursor;
+ Emacs_Cursor nontext_cursor;
+ Emacs_Cursor modeline_cursor;
+ Emacs_Cursor hand_cursor;
+ Emacs_Cursor hourglass_cursor;
+ Emacs_Cursor horizontal_drag_cursor;
+ Emacs_Cursor vertical_drag_cursor;
+ Emacs_Cursor left_edge_cursor;
+ Emacs_Cursor top_left_corner_cursor;
+ Emacs_Cursor top_edge_cursor;
+ Emacs_Cursor top_right_corner_cursor;
+ Emacs_Cursor right_edge_cursor;
+ Emacs_Cursor bottom_right_corner_cursor;
+ Emacs_Cursor bottom_edge_cursor;
+ Emacs_Cursor bottom_left_corner_cursor;
+ Emacs_Cursor no_cursor;
};
struct haiku_output
{
+ struct haiku_display_info *display_info;
+
Emacs_Cursor text_cursor;
Emacs_Cursor nontext_cursor;
Emacs_Cursor modeline_cursor;
@@ -130,44 +147,67 @@ struct haiku_output
Emacs_Cursor bottom_edge_cursor;
Emacs_Cursor bottom_left_corner_cursor;
Emacs_Cursor no_cursor;
-
Emacs_Cursor current_cursor;
- struct haiku_display_info *display_info;
-
- int baseline_offset;
- int fontset;
-
Emacs_Color cursor_color;
- Window window_desc, parent_desc;
- char explicit_parent;
-
- int titlebar_height;
- int toolbar_height;
+ Window parent_desc;
haiku window;
haiku view;
haiku menubar;
- int menu_up_to_date_p;
- int zoomed_p;
+ int fontset;
+ int baseline_offset;
- int pending_zoom_x;
- int pending_zoom_y;
- int pending_zoom_width;
- int pending_zoom_height;
+ /* Whether or not the hourglass cursor is currently being
+ displayed. */
+ bool_bf hourglass_p : 1;
- int menu_bar_open_p;
+ /* Whether or not the menu bar is open. */
+ bool_bf menu_bar_open_p : 1;
- C_FONT font;
+ /* Whether or not there is data in a back buffer that hasn't been
+ displayed yet. */
+ bool_bf dirty_p : 1;
- int hourglass_p;
- uint32_t cursor_fg;
- bool dirty_p;
+ struct font *font;
/* The pending position we're waiting for. */
int pending_top, pending_left;
+
+ /* Whether or not adjust_frame_size and haiku_set_offset have yet
+ been called by haiku_create_frame. */
+ bool configury_done;
+
+ /* The default cursor foreground color. */
+ uint32_t cursor_fg;
+
+ /* 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
@@ -178,6 +218,15 @@ struct x_output
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. */
@@ -214,26 +263,32 @@ struct scroll_bar
/* 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)
+#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_SURFACE(f) \
- (FRAME_HAIKU_VIEW (f) ? EmacsView_cairo_surface (FRAME_HAIKU_VIEW (f)) : 0);
+#define FRAME_CR_CONTEXT(f) \
+ (FRAME_HAIKU_VIEW (f) \
+ ? EmacsView_cairo_context (FRAME_HAIKU_VIEW (f)) \
+ : NULL)
#endif
extern void syms_of_haikuterm (void);
@@ -248,49 +303,60 @@ 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 *f);
-extern void haiku_scroll_bar_remove (struct scroll_bar *bar);
-extern void haiku_clear_under_internal_border (struct frame *f);
-extern void haiku_set_name (struct frame *f, Lisp_Object name, bool explicit_p);
+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 *name, Emacs_Color *color);
-extern void haiku_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval);
-extern void haiku_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval);
-extern void haiku_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval);
-extern void haiku_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval);
-extern void haiku_change_tab_bar_height (struct frame *f, int height);
-extern void haiku_change_tool_bar_height (struct frame *f, int height);
+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 col, Emacs_Color *color);
+extern void haiku_query_color (uint32_t, Emacs_Color *);
-extern unsigned long haiku_get_pixel (haiku bitmap, int x, int y);
-extern void haiku_put_pixel (haiku bitmap, int x, int y, unsigned long pixel);
+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 *f, int x, int y, int menu_flags,
- Lisp_Object title, const char **error_name);
-extern Lisp_Object haiku_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents);
+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 *f);
+extern void initialize_frame_menubar (struct frame *);
-extern void run_menu_bar_help_event (struct frame *f, int mb_idx);
-extern void put_xrm_resource (Lisp_Object name, Lisp_Object val);
+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 type);
-extern int haiku_load_image (struct frame *f, struct image *img,
- Lisp_Object spec_file, Lisp_Object spec_data);
+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 *f, struct glyph_string *s);
+extern cairo_t *haiku_begin_cr_clip (struct frame *, struct glyph_string *);
-extern void
-haiku_end_cr_clip (cairo_t *cr);
+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 e7d347b7820..c0a7b85cb3b 100644
--- a/src/image.c
+++ b/src/image.c
@@ -542,8 +542,26 @@ image_create_bitmap_from_data (struct frame *f, char *bits,
#endif /* HAVE_PGTK */
#ifdef HAVE_HAIKU
- void *bitmap = BBitmap_new (width, height, 1);
- BBitmap_import_mono_bits (bitmap, bits, width, height);
+ 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);
@@ -563,6 +581,11 @@ image_create_bitmap_from_data (struct frame *f, char *bits,
#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;
@@ -588,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)
{
-#if defined (HAVE_NTGUI) || defined (HAVE_HAIKU)
+#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;
@@ -614,6 +668,9 @@ 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
@@ -633,7 +690,6 @@ image_create_bitmap_from_file (struct frame *f, Lisp_Object file)
dpyinfo->bitmaps[id - 1].img = bitmap;
dpyinfo->bitmaps[id - 1].refcount = 1;
dpyinfo->bitmaps[id - 1].file = xlispstrdup (file);
- //dpyinfo->bitmaps[id - 1].depth = 1;
dpyinfo->bitmaps[id - 1].height = gdk_pixbuf_get_width (bitmap);
dpyinfo->bitmaps[id - 1].width = gdk_pixbuf_get_height (bitmap);
dpyinfo->bitmaps[id - 1].pattern
@@ -688,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. */
@@ -720,6 +859,9 @@ free_bitmap_record (Display_Info *dpyinfo, Bitmap_Record *bm)
#ifdef HAVE_HAIKU
BBitmap_free (bm->img);
+
+ if (bm->stipple_bits)
+ xfree (bm->stipple_bits);
#endif
if (bm->file)
@@ -1177,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)
@@ -1792,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
@@ -2130,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));
}
}
}
@@ -2324,17 +2503,17 @@ compute_image_size (double width, double 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
single step, but the maths for each element is much more complex
and performing the steps separately makes for more readable code. */
-#ifndef HAVE_HAIKU
typedef double matrix3x3[3][3];
static void
@@ -2349,7 +2528,6 @@ matrix3x3_mult (matrix3x3 a, matrix3x3 b, matrix3x3 result)
result[i][j] = sum;
}
}
-#endif /* not HAVE_HAIKU */
static void
compute_image_rotation (struct image *img, double *rotation)
@@ -2374,6 +2552,22 @@ compute_image_rotation (struct image *img, double *rotation)
static void
image_set_transform (struct frame *f, struct image *img)
{
+ 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. */
@@ -2408,8 +2602,10 @@ image_set_transform (struct frame *f, struct image *img)
double rotation = 0.0;
compute_image_rotation (img, &rotation);
-#ifndef HAVE_HAIKU
-# if defined USE_CAIRO || defined HAVE_XRENDER || defined HAVE_NS
+ /* 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.
@@ -2423,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
@@ -2432,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
@@ -2447,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)
{
@@ -2475,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)
@@ -2495,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. */
@@ -2515,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;
@@ -2578,35 +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
-#else
- if (rotation != 0 &&
- rotation != 90 &&
- rotation != 180 &&
- rotation != 270 &&
- rotation != 360)
- {
- image_error ("No native support for rotation by %g degrees",
- make_float (rotation));
- return;
- }
-
- rotation = fmod (rotation, 360.0);
+# elif defined HAVE_HAIKU
+ /* Store the transform in the struct image for later. */
+ memcpy (&img->transform, &matrix, sizeof matrix);
- if (rotation == 90 || rotation == 270)
+ /* Also add the extra translations. */
+ if (rotate_flag)
{
- int w = width;
- width = height;
- height = w;
+ img->transform[0][2] = extra_tx;
+ img->transform[1][2] = extra_ty;
}
-
- img->have_be_transforms_p = rotation != 0 || (img->width != width) || (img->height != height);
- img->be_rotate = rotation;
- img->be_scale_x = 1.0 / (img->width / (double) width);
- img->be_scale_y = 1.0 / (img->height / (double) height);
- img->width = width;
- img->height = height;
-#endif /* not HAVE_HAIKU */
+#endif
}
#endif /* HAVE_IMAGEMAGICK || HAVE_NATIVE_TRANSFORMS */
@@ -2639,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)
@@ -2778,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. */
@@ -2804,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
}
@@ -2848,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)
@@ -2906,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?
@@ -3403,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
@@ -3455,6 +3778,8 @@ enum xbm_keyword_index
XBM_ALGORITHM,
XBM_HEURISTIC_MASK,
XBM_MASK,
+ XBM_DATA_WIDTH,
+ XBM_DATA_HEIGHT,
XBM_LAST
};
@@ -3476,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. */
@@ -3498,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
@@ -3509,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,
@@ -3531,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
@@ -3546,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;
@@ -3679,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;
@@ -3802,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);
@@ -3817,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
}
@@ -4001,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;
@@ -4119,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))
{
@@ -4633,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
@@ -5979,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,
@@ -6013,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. */
@@ -6057,25 +6444,23 @@ image_disable_image (struct frame *f, struct image *img)
{
#ifndef HAVE_NTGUI
#ifndef HAVE_NS /* TODO: NS support, however this not needed for toolbars */
-#ifndef HAVE_HAIKU
-#ifndef USE_CAIRO
+#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)
image_pixmap_draw_cross (f, img->mask, 0, 0, img->width, img->height,
MaskForeground (f));
-#endif /* !HAVE_HAIKU */
#endif /* !HAVE_NS */
#else
HDC hdc, bmpdc;
@@ -8603,116 +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 false;
+ 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 false;
+ image_error ("Cannot open `%s'", file);
+ return false;
+ }
}
- }
- else
- {
- if (!STRINGP (specified_data))
+ else
{
- image_error ("Invalid image data `%s'", specified_data);
- return false;
- }
+ 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 false;
+ if (NILP (specified_data))
+ image_error ("Error reading `%s'", img->spec);
+ else
+ image_error ("Error reading GIF data");
+ goto gif_error;
}
- }
- /* Before reading entire contents, check the declared image size. */
- if (!check_image_size (f, gif->SWidth, gif->SHeight))
+ 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;
+ }
+ }
+ }
+ else
{
- image_size_error ();
- goto gif_error;
+ /* 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");
+ 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);
- goto gif_error;
- }
- }
-
- 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;
@@ -8727,29 +9187,20 @@ gif_load (struct frame *f, struct image *img)
goto gif_error;
}
- /* 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");
- 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)
+ {
+ pixmap = xmalloc (width * height * sizeof (unsigned long));
+ if (cache)
+ cache->temp = pixmap;
+ }
+
/* Clear the part of the screen image not covered by the image.
Full animated GIF support requires more here (see the gif89 spec,
disposal methods). Let's simply assume that the part not covered
@@ -8764,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;
@@ -8801,7 +9248,18 @@ 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. */
@@ -8852,6 +9310,14 @@ gif_load (struct frame *f, struct image *img)
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)
gif_color_map = gif->SColorMap;
@@ -8891,8 +9357,8 @@ gif_load (struct frame *f, struct image *img)
int c = raster[y * subimg_width + x];
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];
}
}
}
@@ -8905,13 +9371,19 @@ gif_load (struct frame *f, struct image *img)
int c = raster[y * subimg_width + x];
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 ();
@@ -8940,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)
@@ -8952,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. */
@@ -8976,7 +9453,14 @@ gif_load (struct frame *f, struct image *img)
return true;
gif_error:
+ if (pixmap)
+ xfree (pixmap);
gif_close (gif, NULL);
+ if (cache)
+ {
+ cache->handle = NULL;
+ cache->temp = NULL;
+ }
return false;
}
@@ -8991,6 +9475,7 @@ gif_load (struct frame *f, struct image *img)
***********************************************************************/
#include "webp/decode.h"
+#include "webp/demux.h"
/* Indices of image specification fields in webp_format, below. */
@@ -9005,6 +9490,7 @@ enum webp_keyword_index
WEBP_ALGORITHM,
WEBP_HEURISTIC_MASK,
WEBP_MASK,
+ WEBP_INDEX,
WEBP_BACKGROUND,
WEBP_LAST
};
@@ -9023,6 +9509,7 @@ static const struct image_keyword webp_format[WEBP_LAST] =
{":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}
};
@@ -9055,20 +9542,41 @@ DEF_DLL_FN (VP8StatusCode, WebPGetFeaturesInternal,
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 library;
+ HMODULE library1, library2;
- if (!(library = w32_delayed_load (Qwebp)))
+ if (!((library1 = w32_delayed_load (Qwebp))
+ && (library2 = w32_delayed_load (Qwebpdemux))))
return false;
- LOAD_DLL_FN (library, WebPGetInfo);
- LOAD_DLL_FN (library, WebPGetFeaturesInternal);
- LOAD_DLL_FN (library, WebPDecodeRGBA);
- LOAD_DLL_FN (library, WebPDecodeRGB);
- LOAD_DLL_FN (library, WebPFree);
+ 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;
}
@@ -9077,6 +9585,14 @@ init_webp_functions (void)
#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) \
@@ -9084,9 +9600,26 @@ init_webp_functions (void)
#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. */
@@ -9096,6 +9629,9 @@ 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);
@@ -9139,6 +9675,9 @@ webp_load (struct frame *f, struct image *img)
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);
@@ -9162,19 +9701,90 @@ webp_load (struct frame *f, struct image *img)
goto webp_error1;
}
- /* Decode WebP data. */
- uint8_t *decoded;
+ uint8_t *decoded = NULL;
int width, height;
- if (features.has_alpha)
- /* Linear [r0, g0, b0, a0, r1, g1, b1, a1, ...] order. */
- decoded = WebPDecodeRGBA (contents, size, &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, &timestamp);
+ 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, &timestamp);
+ /* 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
- /* Linear [r0, g0, b0, r1, g1, b1, ...] order. */
- decoded = WebPDecodeRGB (contents, size, &width, &height);
+ {
+ /* 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 interpreting WebP image data");
+ image_error ("Error when decoding WebP image data");
goto webp_error1;
}
@@ -9193,7 +9803,8 @@ webp_load (struct frame *f, struct image *img)
/* 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_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);
@@ -9203,6 +9814,13 @@ webp_load (struct frame *f, struct image *img)
/* 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)
{
@@ -9217,7 +9835,7 @@ webp_load (struct frame *f, struct image *img)
image. WebP allows up to 256 levels of partial transparency.
We handle this like with PNG (which see), using the frame's
background color to combine the image with. */
- if (features.has_alpha)
+ if (features.has_alpha || anim)
{
if (mask_img)
PUT_PIXEL (mask_img, x, y, *p > 0 ? PIX_MASK_DRAW : PIX_MASK_RETAIN);
@@ -9248,14 +9866,24 @@ webp_load (struct frame *f, struct image *img)
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. */
- WebPFree (decoded);
- if (NILP (specified_data))
+ if (!anim)
+ WebPFree (decoded);
+ if (NILP (specified_data) && !anim)
xfree (contents);
return true;
webp_error2:
- WebPFree (decoded);
+ if (!anim)
+ WebPFree (decoded);
webp_error1:
if (NILP (specified_data))
@@ -9422,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
@@ -10673,11 +11301,16 @@ svg_load_image (struct frame *f, struct image *img, char *contents,
viewbox_height = dimension_data.height;
#endif
+#ifdef HAVE_NATIVE_TRANSFORMS
compute_image_size (viewbox_width, viewbox_height, img,
&width, &height);
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))
{
@@ -10878,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;
}
@@ -11020,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 ();
}
@@ -11093,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;
@@ -11196,10 +11829,7 @@ The list of capabilities can include one or more of the following:
|| 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 ()
@@ -11365,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");
@@ -11457,8 +12088,10 @@ non-numeric, there is no explicit limit on the size of images. */);
add_image_type (Qpng);
#endif
-#if defined (HAVE_WEBP)
+#if defined (HAVE_WEBP) || (defined (HAVE_NATIVE_IMAGE_API) \
+ && defined (HAVE_HAIKU))
DEFSYM (Qwebp, "webp");
+ DEFSYM (Qwebpdemux, "webpdemux");
add_image_type (Qwebp);
#endif
@@ -11490,6 +12123,12 @@ non-numeric, there is no explicit limit on the size of images. */);
#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");
@@ -11512,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 5c21cd8f99d..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 ();
@@ -2105,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))
@@ -2166,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;
@@ -2198,7 +2211,10 @@ whether or not it is currently displayed in some window. */)
}
else
it_overshoot_count =
- !(it.method == GET_FROM_IMAGE || it.method == GET_FROM_STRETCH);
+ /* If image_id is negative, it's a fringe bitmap, which by
+ definition doesn't affect display in the text area. */
+ !((it.method == GET_FROM_IMAGE && it.image_id >= 0)
+ || it.method == GET_FROM_STRETCH);
if (start_x_given)
{
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 ed374f16b53..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));
@@ -1738,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;
}
@@ -2180,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));
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 a9f3257282b..7c13ac96114 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -95,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;
@@ -290,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
@@ -336,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. */
@@ -386,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. */
@@ -682,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
@@ -774,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.
@@ -937,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)];
@@ -1052,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
{
@@ -1115,7 +1112,7 @@ command_loop (void)
/* End of file in -batch run causes exit here. */
if (noninteractive)
- Fkill_emacs (Qt);
+ Fkill_emacs (Qt, Qnil);
}
}
@@ -1230,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);
@@ -1308,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. */
@@ -1324,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));
@@ -1348,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);
@@ -1395,7 +1389,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;
@@ -1485,7 +1479,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))
@@ -1504,7 +1498,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
@@ -1533,8 +1534,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))
@@ -1570,9 +1569,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
@@ -1601,23 +1606,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. */
@@ -1631,7 +1646,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. */
@@ -1643,7 +1658,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;
@@ -1876,7 +1891,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);
@@ -1895,6 +1910,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
@@ -1936,17 +1954,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
@@ -2014,14 +2033,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
@@ -2191,7 +2224,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);
@@ -2224,7 +2257,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))
{
@@ -2393,7 +2426,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;
@@ -2431,6 +2463,7 @@ read_char (int commandflag, Lisp_Object map,
else
reread = false;
+ Vlast_event_device = Qnil;
if (CONSP (Vunread_command_events))
{
@@ -2551,7 +2584,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 ();
@@ -2635,7 +2668,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. */
@@ -2718,7 +2751,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);
@@ -2795,7 +2828,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);
@@ -2899,7 +2932,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))
@@ -3078,7 +3111,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;
@@ -3203,7 +3236,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),
@@ -3224,7 +3257,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
@@ -3282,6 +3315,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)))
@@ -3495,6 +3533,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)
@@ -3666,25 +3709,6 @@ kbd_buffer_store_buffered_event (union buffered_input_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, \
@@ -3709,7 +3733,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;
@@ -3731,6 +3755,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;
@@ -3748,6 +3773,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;
@@ -3806,6 +3832,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.
@@ -3818,7 +3864,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)
@@ -3844,6 +3895,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 (;;)
{
@@ -3869,10 +3922,18 @@ kbd_buffer_get_event (KBOARD **kbp,
#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 ();
@@ -3909,6 +3970,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;
@@ -3936,24 +4007,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 (&copy);
#else
+ pgtk_handle_selection_event (&copy);
+#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 (&copy);
+ }
+ 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:
@@ -4032,6 +4135,15 @@ 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))
@@ -4087,10 +4199,55 @@ kbd_buffer_get_event (KBOARD **kbp,
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
@@ -4113,9 +4270,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);
+ }
}
}
}
@@ -4123,12 +4286,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
@@ -4163,7 +4327,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! */
@@ -4182,14 +4355,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
@@ -4197,8 +4380,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)
{
@@ -4214,8 +4396,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 (&copy);
#else
+ pgtk_handle_selection_event (&copy);
+#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 (&copy);
+#else
/* We're getting selection request events, but we don't have
a window system. */
emacs_abort ();
@@ -4419,7 +4627,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
@@ -4473,6 +4681,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
@@ -4486,6 +4696,8 @@ timer_check (void)
else
idle_timers = Qnil;
+ turn_on_atimers (true);
+ unblock_input ();
Vinhibit_quit = tem;
do
@@ -5149,17 +5361,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
@@ -5182,6 +5396,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)
@@ -5367,7 +5595,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))
@@ -5410,9 +5638,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,
@@ -7033,7 +7268,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)
@@ -7832,7 +8070,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,
@@ -9282,7 +9520,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);
@@ -9499,7 +9737,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;
@@ -9856,7 +10094,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);
@@ -9980,7 +10218,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;
}
@@ -10435,7 +10673,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);
@@ -10903,7 +11141,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;
@@ -11210,7 +11448,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 ();
@@ -11221,7 +11459,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);
}
@@ -11649,6 +11887,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;
@@ -11842,7 +12084,6 @@ syms_of_keyboard (void)
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");
@@ -11943,6 +12184,8 @@ syms_of_keyboard (void)
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");
@@ -12064,6 +12307,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);
@@ -12221,18 +12475,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,
@@ -12262,6 +12519,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. */);
@@ -12384,12 +12652,26 @@ See also `pre-command-hook'. */);
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.
The elements of the list are event types that may have menu bar
@@ -12441,12 +12723,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
@@ -12516,17 +12801,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]]),
@@ -12618,6 +12892,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");
@@ -12632,11 +12914,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",
@@ -12721,6 +13004,30 @@ 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;
+
pdumper_do_now_and_after_load (syms_of_keyboard_for_pdumper);
}
@@ -12748,7 +13055,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'. */
@@ -12870,12 +13176,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 167b7d79e8f..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,8 +496,6 @@ 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);
diff --git a/src/keymap.c b/src/keymap.c
index ed69b1c4277..506b755e5da 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -395,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));
@@ -454,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
@@ -466,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))
{
@@ -487,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;
}
}
@@ -496,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
@@ -1025,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>)
@@ -1550,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;
@@ -1650,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);
@@ -2595,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. */
@@ -2719,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
@@ -2867,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. */
@@ -2881,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;
}
@@ -2894,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
@@ -2917,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);
}
@@ -2950,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 ();
}
@@ -2968,7 +2983,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);
}
else
{
@@ -2976,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);
@@ -2987,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)))
@@ -2996,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. */
@@ -3006,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;
}
@@ -3031,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 ());
@@ -3077,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);
@@ -3460,4 +3475,6 @@ that describe key bindings. That is why the default is nil. */);
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 f8fe2a69060..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,25 +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.
-
- On Haiku, the size of ptrdiff_t is inconsistent with the value of
- PTRDIFF_MAX. In that case, "t" should be sufficient. */
-
-#ifndef HAIKU
-#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
-#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
@@ -357,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)
@@ -367,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))
@@ -389,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)) \
@@ -434,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)
@@ -446,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)
@@ -608,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. */
@@ -989,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)
+struct Lisp_Symbol_With_Pos
{
- return make_lisp_symbol (&lispsym[index]);
-}
-
-INLINE bool
-c_symbol_p (struct Lisp_Symbol *sym)
-{
- char *bp = (char *) lispsym;
- char *sp = (char *) sym;
- if (PTRDIFF_MAX < INTPTR_MAX)
- return bp <= sp && sp < bp + sizeof lispsym;
- else
- {
- ptrdiff_t offset = sp - bp;
- return 0 <= offset && offset < sizeof lispsym;
- }
-}
-
-INLINE void
-(CHECK_SYMBOL) (Lisp_Object x)
-{
- lisp_h_CHECK_SYMBOL (x);
-}
+ union vectorlike_header header;
+ Lisp_Object sym; /* A symbol */
+ Lisp_Object pos; /* A fixnum */
+} GCALIGNED_STRUCT;
/* In the size word of a vector, this bit means the vector has been marked. */
@@ -1064,6 +1041,7 @@ enum pvec_type
PVEC_MARKER,
PVEC_OVERLAY,
PVEC_FINALIZER,
+ PVEC_SYMBOL_WITH_POS,
PVEC_MISC_PTR,
PVEC_USER_PTR,
PVEC_PROCESS,
@@ -1123,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. */
@@ -1254,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)
{
@@ -1496,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;
@@ -1559,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. */
@@ -1644,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
@@ -1720,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
@@ -2032,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
@@ -2093,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;
@@ -2124,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
@@ -2646,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)
{
@@ -3098,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);
@@ -3127,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 *);
@@ -3212,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. */
@@ -3240,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;
@@ -3265,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;
@@ -3278,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'
@@ -3340,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. */
@@ -3680,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);
@@ -3697,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);
@@ -3709,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 };
@@ -3858,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. */
@@ -3982,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. */
@@ -4076,7 +4410,8 @@ 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);
@@ -4171,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)
@@ -4219,23 +4555,11 @@ 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 *));
@@ -4247,24 +4571,28 @@ 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, ...);
@@ -4273,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
@@ -4403,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);
@@ -4511,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);
@@ -4619,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);
@@ -4676,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);
@@ -4767,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. */
@@ -4946,7 +5291,7 @@ extern void *record_xmalloc (size_t)
#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))
@@ -4984,9 +5329,9 @@ extern void *record_xmalloc (size_t)
#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)
@@ -5012,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);
}
@@ -5172,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
@@ -5189,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 2eff20f15df..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 != ';')
@@ -1170,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
@@ -1220,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;
@@ -1234,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
@@ -1553,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
@@ -1565,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
@@ -1629,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);
@@ -1657,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;
@@ -1728,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);
@@ -2165,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;
@@ -2175,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
@@ -2198,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);
@@ -2207,7 +2227,7 @@ 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);
@@ -2216,12 +2236,12 @@ readevalloop (Lisp_Object readcharfun,
&& !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");
@@ -2272,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)
@@ -2286,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);
@@ -2309,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)
@@ -2335,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);
}
@@ -2376,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))
@@ -2421,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 ();
@@ -2467,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,
@@ -2483,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)
@@ -2507,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)))))
@@ -2530,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;
@@ -2544,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
@@ -2572,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)
@@ -2620,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
@@ -2650,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;
@@ -2663,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':
@@ -2672,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':
@@ -2681,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':
@@ -2690,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':
@@ -2713,7 +2735,7 @@ 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 (! ASCII_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
@@ -2864,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);
}
@@ -2894,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);
}
@@ -2925,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 == '+')
@@ -2973,761 +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]);
+ }
- 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;
+ XSETPVECTYPE (XVECTOR (obj), PVEC_COMPILED);
+ 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);
- }
+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;
- 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;
+}
+
+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;
+}
- /* #@NUMBER is used to skip NUMBER following bytes.
- That's used in .elc files to skip over doc strings
- and function definitions. */
- if (c == '@')
+/* 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);
+ }
+
+ 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;
- if (ch == '\\')
+ 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;
+
+ case '"':
+ obj = read_string_literal (stackbuf, readcharfun);
+ break;
- if (ch < 0)
- end_of_file_error ();
+ 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
{
@@ -3744,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;
}
@@ -3755,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,
@@ -4089,212 +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))
- {
- if (!NILP (Vpurify_flag))
- doc_reference = 0;
- else if (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 == 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. */
@@ -4401,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));
@@ -4589,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))
{
@@ -4609,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
@@ -5090,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);
@@ -5123,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;
@@ -5234,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
@@ -5272,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");
@@ -5433,6 +5683,7 @@ 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,
diff --git a/src/macfont.m b/src/macfont.m
index f623c3ca2f5..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);
@@ -845,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}},
@@ -927,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);
@@ -2651,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
@@ -3570,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)
{
@@ -3997,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)
{
@@ -4131,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 18ecaf0b0ba..eeb0c9a7e5b 100644
--- a/src/menu.c
+++ b/src/menu.c
@@ -1118,10 +1118,10 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu)
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
@@ -1269,9 +1269,9 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu)
}
}
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
@@ -1391,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
@@ -1402,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
@@ -1602,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/minibuf.c b/src/minibuf.c
index d0e58b61f27..0fba334b22b 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. */
@@ -197,20 +201,12 @@ move_minibuffers_onto_frame (struct frame *of, bool for_deletion)
return;
if (FRAME_LIVE_P (f)
&& !EQ (f->minibuffer_window, of->minibuffer_window)
- && WINDOW_LIVE_P (f->minibuffer_window) /* F not a tootip frame */
+ && WINDOW_LIVE_P (f->minibuffer_window) /* F not a tooltip frame */
&& WINDOW_LIVE_P (of->minibuffer_window))
{
zip_minibuffer_stacks (f->minibuffer_window, of->minibuffer_window);
if (for_deletion && XFRAME (MB_frame) != of)
MB_frame = selected_frame;
- if (!for_deletion
- && MINI_WINDOW_P (XWINDOW (FRAME_SELECTED_WINDOW (of))))
- {
- Lisp_Object old_frame;
- XSETFRAME (old_frame, of);
- Fset_frame_selected_window (old_frame,
- Fframe_first_window (old_frame), Qnil);
- }
}
}
@@ -261,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
@@ -431,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;
}
@@ -578,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;
@@ -745,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. */
@@ -764,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;
@@ -833,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 ();
@@ -916,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. */
@@ -991,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);
@@ -1062,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
@@ -1112,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
@@ -1155,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);
@@ -1225,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
@@ -1292,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'.
@@ -1384,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
@@ -1483,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);
@@ -1567,36 +1579,47 @@ match_regexps (Lisp_Object string, Lisp_Object regexps,
}
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)
{
@@ -1670,7 +1693,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;
@@ -1767,10 +1791,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;
@@ -1806,11 +1830,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
@@ -1822,17 +1848,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
@@ -1901,7 +1931,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;
@@ -1980,6 +2011,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.
@@ -2077,10 +2111,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;
@@ -2108,12 +2143,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;
}
diff --git a/src/msdos.c b/src/msdos.c
index f126d28c985..1608245904c 100644
--- a/src/msdos.c
+++ b/src/msdos.c
@@ -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/msdos.h b/src/msdos.h
index 7e57c7c1102..24697bcf24b 100644
--- a/src/msdos.h
+++ b/src/msdos.h
@@ -22,6 +22,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <dpmi.h>
#include "termhooks.h" /* struct terminal */
+struct terminal;
+
+extern unsigned int _dos_commit(int);
+#define tcdrain(f) _dos_commit(f)
int dos_ttraw (struct tty_display_info *);
int dos_ttcooked (void);
@@ -57,6 +61,11 @@ ssize_t readlinkat (int, const char *, char *, size_t);
int fstatat (int, char const *, struct stat *, int);
int unsetenv (const char *);
int faccessat (int, const char *, int, int);
+int openat (int, const char *, int, int);
+int fchmodat (int, const char *, mode_t, int);
+int futimens (int, const struct timespec[2]);
+int utimensat (int, const char *, const struct timespec[2], int);
+
void msdos_fatal_signal (int);
void syms_of_msdos (void);
int pthread_sigmask (int, const sigset_t *, sigset_t *);
diff --git a/src/nsfns.m b/src/nsfns.m
index 11132a294a5..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;
@@ -352,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))
@@ -769,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]])
@@ -818,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;
}
@@ -891,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)
@@ -901,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;
}
@@ -1004,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,
@@ -1014,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);
@@ -1023,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)))
@@ -1050,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);
}
/*
@@ -1105,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);
@@ -1183,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))
@@ -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;
@@ -2669,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);
@@ -2681,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;
@@ -2700,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");
@@ -2736,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;
@@ -2814,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);
@@ -2833,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);
@@ -2847,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);
+ }
+
+ 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;
+ }
- [ns_tooltip setText: str];
- size = [ns_tooltip frame].size;
+ 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 ();
- /* 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->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;
- [ns_tooltip showAtX: root_x Y: root_y for: XFIXNUM (timeout)];
- unblock_input ();
+ 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);
}
@@ -2882,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
@@ -3183,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
@@ -3228,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);
@@ -3271,12 +3934,27 @@ 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
diff --git a/src/nsfont.m b/src/nsfont.m
index f3c8a82930b..b54118afe5d 100644
--- a/src/nsfont.m
+++ b/src/nsfont.m
@@ -1176,15 +1176,12 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y,
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);
-
- r.origin.y = s->y;
+ r.origin.x = x;
+ r.origin.y = y;
r.size.height = FONT_HEIGHT (font);
- for (int i = from; i < to; ++i)
- c[i] = s->char2b[i];
+ for (int i = 0; i < len; ++i)
+ c[i] = s->char2b[i + from];
/* Fill background if requested. */
if (with_background && !isComposite)
@@ -1210,8 +1207,6 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y,
}
/* set up for character rendering */
- r.origin.y = y;
-
if (s->hl == DRAW_CURSOR)
col = FRAME_BACKGROUND_COLOR (s->f);
else
@@ -1721,8 +1716,8 @@ ns_glyph_metrics (struct nsfont_info *font_info, unsigned int block)
metrics->rbearing = lrint (rb);
metrics->lbearing = lrint (lb);
- metrics->descent = NSMinY (r);
- metrics->ascent = NSMaxY (r);
+ metrics->descent = - NSMaxY (r);
+ metrics->ascent = - NSMinY (r);
}
unblock_input ();
}
@@ -1768,8 +1763,11 @@ syms_of_nsfont (void)
DEFSYM (Qcondensed, "condensed");
DEFSYM (Qexpanded, "expanded");
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/nsimage.m b/src/nsimage.m
index 2fff987f9fc..9cb5090dd0d 100644
--- a/src/nsimage.m
+++ b/src/nsimage.m
@@ -142,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 4d3c7528160..d02d7bae4b5 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];
@@ -135,9 +145,9 @@ ns_update_menubar (struct frame *f, bool deep_p)
#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. */
@@ -155,7 +165,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);
#endif
if (deep_p)
@@ -164,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);
@@ -413,7 +423,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
@@ -649,7 +659,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;
@@ -677,11 +688,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 */
@@ -739,15 +751,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];
@@ -758,6 +770,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
{
@@ -777,6 +828,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
{
}
@@ -790,10 +860,6 @@ prettify_key (const char *key)
{
return NSZeroRect;
}
-
-- (void)menu:(NSMenu *)menu willHighlightItem:(NSMenuItem *)item
-{
-}
#endif
@end /* EmacsMenu */
@@ -813,37 +879,35 @@ 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 ();
p.x = x; p.y = y;
- /* Don't GC due to a mysterious bug. */
- inhibit_garbage_collection ();
-
/* now parse stage 2 as in ns_update_menubar */
wv = make_widget_value ("contextmenu", NULL, true, Qnil);
wv->button_type = BUTTON_TYPE_NONE;
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;
@@ -973,8 +1037,6 @@ ns_menu_show (struct frame *f, int x, int y, int menuflags,
i += MENU_ITEMS_ITEM_LENGTH;
}
}
- }
-#endif
if (!NILP (title))
{
@@ -1009,6 +1071,8 @@ ns_menu_show (struct frame *f, int x, int y, int menuflags,
[[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow];
unbind_to (specpdl_count, Qnil);
unblock_input ();
+
+ SAFE_FREE ();
return tem;
}
@@ -1433,6 +1497,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];
@@ -1472,31 +1545,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);
@@ -1506,21 +1586,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;
}
@@ -1561,7 +1650,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;
@@ -1645,58 +1733,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;
- for (; CONSP (lst); lst = XCDR (lst))
+ i = MENU_ITEMS_PANE_LENGTH;
+ *error_name = NULL;
+
+ /* 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;
@@ -1705,7 +1800,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]];
@@ -1715,7 +1811,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;
@@ -1738,96 +1834,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
{
@@ -1845,11 +1940,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;
@@ -1869,13 +1964,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 13ca9b9c442..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. */
@@ -250,7 +248,7 @@ ns_get_foreign_selection (Lisp_Object symbol, Lisp_Object target)
NSString *type;
NSEnumerator *e = [[pb types] objectEnumerator];
- while (type = [e nextObject])
+ while ((type = [e nextObject]))
{
NSString *val = [typeLookup valueForKey:type];
if (val && ! [types containsObject:val])
@@ -559,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)
{
@@ -568,12 +785,18 @@ syms_of_nsselect (void)
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 f0276461231..7a097b32489 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -408,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
@@ -442,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;
@@ -485,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
@@ -571,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
@@ -594,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
@@ -684,6 +724,7 @@ typedef id instancetype;
int em_whole;
}
+- (void) mark;
- (instancetype) initFrame: (NSRect )r window: (Lisp_Object)win;
- (void)setFrame: (NSRect)r;
@@ -698,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;
@@ -1104,6 +1145,9 @@ 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);
@@ -1173,6 +1217,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);
@@ -1290,6 +1335,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__
@@ -1308,6 +1354,7 @@ 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)
@@ -1325,5 +1372,9 @@ enum NSWindowTabbingMode
#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 a15dc47a226..7f232e72922 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -79,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.
@@ -89,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.
@@ -101,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
@@ -163,7 +174,7 @@ 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
@@ -347,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;
}
}
@@ -429,28 +440,28 @@ 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); \
- }
+ 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. */
@@ -751,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];
@@ -788,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
}
@@ -1060,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
@@ -1127,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
}
@@ -1500,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)
@@ -1691,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
@@ -2270,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");
@@ -2296,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];
- 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;
- if (w && [[w delegate] isKindOfClass:[EmacsView class]])
- f = ((EmacsView *)[w delegate])->emacsframe;
+ if (w && [[w delegate] isKindOfClass: [EmacsView class]])
+ f = ((EmacsView *) [w delegate])->emacsframe;
+ else if (EQ (track_mouse, Qdrag_source))
+ break;
+
+ 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))
{
@@ -2340,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 ();
@@ -2916,6 +2972,14 @@ ns_draw_fringe_bitmap (struct window *w, struct glyph_row *row,
}
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];
@@ -3043,7 +3107,9 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row,
break;
case HOLLOW_BOX_CURSOR:
draw_phys_cursor_glyph (w, glyph_row, DRAW_NORMAL_TEXT);
- [NSBezierPath strokeRect: r];
+
+ /* This works like it does in PostScript, not X Windows. */
+ [NSBezierPath strokeRect: NSInsetRect (r, 0.5, 0.5)];
break;
case HBAR_CURSOR:
NSRectFill (r);
@@ -3265,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;
@@ -3286,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));
@@ -3299,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;
@@ -3308,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)
@@ -3405,36 +3478,35 @@ ns_draw_box (NSRect r, CGFloat hthickness, CGFloat vthickness,
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;
+ static NSColor *baseCol, *lightCol, *darkCol;
+ NSColor *newBaseCol;
NSRect inner;
+ NSBezierPath *p;
+
+ baseCol = nil;
+ lightCol = nil;
+ newBaseCol = nil;
+ p = nil;
NSTRACE ("ns_draw_relief");
/* set up colors */
if (s->face->use_box_color_for_shadows_p)
- {
- newBaseCol = [NSColor colorWithUnsignedLong:s->face->box_color];
- }
-/* 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);
- } */
+ newBaseCol = [NSColor colorWithUnsignedLong: s->face->box_color];
else
- {
- newBaseCol = [NSColor colorWithUnsignedLong:s->face->background];
- }
+ newBaseCol = [NSColor colorWithUnsignedLong: s->face->background];
+
+ if (s->hl == DRAW_CURSOR)
+ newBaseCol = FRAME_CURSOR_COLOR (s->f);
if (newBaseCol == nil)
newBaseCol = [NSColor grayColor];
@@ -3444,35 +3516,49 @@ ns_draw_relief (NSRect outer, int hthickness, int vthickness, char raised_p,
[baseCol release];
baseCol = [newBaseCol retain];
[lightCol release];
- lightCol = [[baseCol highlightWithLevel: 0.2] retain];
+ lightCol = [[baseCol highlightWithLevel: 0.4] retain];
[darkCol release];
- darkCol = [[baseCol shadowWithLevel: 0.3] retain];
+ darkCol = [[baseCol shadowWithLevel: 0.4] retain];
}
/* 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));
+ inner = outer;
+
+ if (left_p)
+ {
+ inner.origin.x += vthickness;
+ inner.size.width -= vthickness;
+ }
+
+ if (right_p)
+ inner.size.width -= vthickness;
+
+ if (top_p)
+ {
+ inner.origin.y += hthickness;
+ inner.size.height -= hthickness;
+ }
+
+ if (bottom_p)
+ inner.size.height -= hthickness;
[(raised_p ? lightCol : darkCol) 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];
@@ -3480,24 +3566,93 @@ ns_draw_relief (NSRect outer, int hthickness, int vthickness, char raised_p,
[(raised_p ? darkCol : lightCol) 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)];
+ }
+
+ [darkCol 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)];
+ }
}
@@ -3579,6 +3734,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
@@ -3605,7 +3761,7 @@ ns_maybe_dumpglyphs_background (struct glyph_string *s, char force_p)
NSRect r = NSMakeRect (s->x, s->y + box_line_width,
s->background_width,
- s->height-2*box_line_width);
+ s->height - 2 * box_line_width);
NSRectFill (r);
s->background_filled_p = 1;
@@ -3613,6 +3769,92 @@ ns_maybe_dumpglyphs_background (struct glyph_string *s, char force_p)
}
}
+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)
@@ -3624,8 +3866,6 @@ 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 = s->face;
NSColor *tdCol;
@@ -3719,51 +3959,29 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r)
if (s->hl == DRAW_CURSOR)
{
[FRAME_CURSOR_COLOR (s->f) set];
- tdCol = [NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND (face)];
+ tdCol = [NSColor colorWithUnsignedLong: NS_FACE_BACKGROUND (face)];
}
else
- {
- tdCol = [NSColor colorWithUnsignedLong:NS_FACE_FOREGROUND (face)];
- }
+ 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);
}
}
@@ -3919,6 +4137,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)
/* --------------------------------------------------------------------------
@@ -4032,9 +4329,7 @@ ns_draw_glyph_string (struct glyph_string *s)
else
ns_maybe_dumpglyphs_background
(s, s->first_glyph->type == COMPOSITE_GLYPH);
- /* ... */
- /* Not yet implemented. */
- /* ... */
+ ns_draw_glyphless_glyph_string_foreground (s);
break;
default:
@@ -4247,11 +4542,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;
@@ -4282,11 +4580,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
@@ -4325,11 +4626,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
-------------------------------------------------------------------------- */
@@ -4345,7 +4652,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);
@@ -4363,12 +4670,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
@@ -4486,6 +4793,15 @@ 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 (void)
@@ -4897,11 +5213,22 @@ ns_update_window_end (struct window *w, bool cursor_on_p,
}
#endif
-/* This and next define (many of the) public functions in this file. */
-/* gui_* are generic versions in xdisp.c that we, and other terms, get away
- with using despite presence in the "system dependent" redisplay
- interface. In addition, many of the ns_ methods have code that is
- shared with all terms, indicating need for further refactoring. */
+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 =
{
@@ -4918,7 +5245,7 @@ static struct redisplay_interface ns_redisplay_interface =
#else
ns_update_window_end,
#endif
- 0, /* flush_display */
+ ns_flush_display,
gui_clear_window_mouse_face,
gui_get_glyph_overhangs,
gui_fix_overlapping_area,
@@ -4939,6 +5266,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)
@@ -5294,6 +5654,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 ();
@@ -5305,20 +5675,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 ();
}
@@ -5333,6 +5704,10 @@ ns_term_shutdown (int sig)
- (id)init
{
+#ifdef NS_IMPL_GNUSTEP
+ NSNotificationCenter *notification_center;
+#endif
+
NSTRACE ("[EmacsApp init]");
if ((self = [super init]))
@@ -5345,6 +5720,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;
}
@@ -5357,11 +5740,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];
@@ -5545,6 +5928,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
/* **************************************************************************
@@ -5823,7 +6236,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;
}
@@ -5929,6 +6342,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
/* ==========================================================================
@@ -5965,42 +6495,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
{
@@ -6008,7 +6625,6 @@ not_in_argv (NSString *arg)
return YES;
}
-
- (void)resetCursorRects
{
NSRect visible = [self visibleRect];
@@ -6485,17 +7101,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
@@ -6688,7 +7311,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));
}
@@ -6763,6 +7387,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);
@@ -6791,6 +7418,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))))
@@ -6844,7 +7472,7 @@ not_in_argv (NSString *arg)
[self mouseMoved: e];
}
-#ifdef NS_IMPL_COCOA
+#if defined NS_IMPL_COCOA && defined MAC_OS_X_VERSION_10_7
- (void) magnifyWithEvent: (NSEvent *) event
{
NSPoint pt = [self convertPoint: [event locationInWindow] fromView: nil];
@@ -7064,6 +7692,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]");
@@ -7072,11 +7703,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);
}
@@ -7182,7 +7811,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
@@ -7846,8 +8475,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]];
@@ -7862,19 +8491,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
}
@@ -7882,18 +8504,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];
}
@@ -7902,19 +8514,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
@@ -7925,77 +8534,46 @@ not_in_argv (NSString *arg)
NSRect dstRect = NSMakeRect (dest.x, dest.y, NSWidth (srcRect),
NSHeight (srcRect));
- NSRect frame = [self frame];
-
- /* TODO: This check is an attempt to debug a rare graphical glitch
- on macOS and should be removed before the Emacs 28 release. */
- if (!NSContainsRect (frame, srcRect)
- || !NSContainsRect (frame, dstRect))
- {
- NSLog (@"[EmacsView copyRect:to:] Attempting to copy to or "
- "from an area outside the graphics buffer.");
- NSLog (@" Frame: (%f, %f) %f×%f",
- NSMinX (frame), NSMinY (frame),
- NSWidth (frame), NSHeight (frame));
- NSLog (@" Source: (%f, %f) %f×%f",
- NSMinX (srcRect), NSMinY (srcRect),
- NSWidth (srcRect), NSHeight (srcRect));
- NSLog (@" Destination: (%f, %f) %f×%f",
- NSMinX (dstRect), NSMinY (dstRect),
- NSWidth (dstRect), NSHeight (dstRect));
- }
-#ifdef NS_IMPL_COCOA
- if ([self wantsLayer])
- {
- 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
@@ -8050,36 +8628,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;
+}
+
+- (NSDragOperation) draggingUpdated: (id <NSDraggingInfo>) sender
+{
+#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));
--(BOOL)performDragOperation: (id <NSDraggingInfo>) sender
+ redisplay ();
+#endif
+
+ unbind_to (count, Qnil);
+ return NSDragOperationGeneric;
+}
+
+- (BOOL) performDragOperation: (id <NSDraggingInfo>) sender
{
- id pb;
+ 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];
@@ -8095,11 +8750,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;
@@ -8114,18 +8767,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])
@@ -8142,29 +8806,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;
- }
+ return NO;
- emacs_event->kind = DRAG_N_DROP_EVENT;
- XSETINT (emacs_event->x, x);
- XSETINT (emacs_event->y, y);
- emacs_event->modifiers = 0;
-
- 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;
}
@@ -8271,17 +8932,18 @@ 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:]");
@@ -8294,20 +8956,24 @@ not_in_argv (NSString *arg)
styleMask |= NSWindowStyleMaskResizable;
#endif
}
+ else if (f->tooltip)
+ styleMask = 0;
else
- styleMask = NSWindowStyleMaskTitled
- | NSWindowStyleMaskResizable
- | NSWindowStyleMaskMiniaturizable
- | NSWindowStyleMaskClosable;
-
- 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];
+ 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, width, height)
+ styleMask: styleMask
+ backing: NSBackingStoreBuffered
+ defer: YES
+ screen: screen];
if (self)
{
NSString *name;
@@ -8394,7 +9060,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);
@@ -8415,6 +9081,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];
}
@@ -8446,7 +9117,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)
@@ -8478,7 +9149,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. */
@@ -8503,11 +9174,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
@@ -8939,6 +9610,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 */
@@ -9106,6 +9924,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
{
@@ -9439,7 +10267,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
/* ==========================================================================
@@ -9847,6 +10675,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)
@@ -9871,6 +10719,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));
@@ -9878,117 +10727,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,
@@ -10058,6 +10907,16 @@ This variable is ignored on macOS < 10.7 and GNUstep. Default is t. */);
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);
@@ -10066,6 +10925,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);
@@ -10075,4 +10937,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 eeebb7ed0e8..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;
}
@@ -1070,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);
}
@@ -1211,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)
@@ -1384,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);
@@ -2068,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
@@ -2079,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. */
@@ -2854,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;
@@ -2877,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
@@ -2948,7 +2949,7 @@ dump_vectorlike (struct dump_context *ctx,
Lisp_Object lv,
dump_off offset)
{
-#if CHECK_STRUCTS && !defined HASH_pvec_type_19F6CF5169
+#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);
@@ -3032,6 +3033,8 @@ dump_vectorlike (struct dump_context *ctx,
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");
}
@@ -3755,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);
@@ -4044,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
@@ -4207,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
@@ -4925,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)
{
@@ -5540,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;
@@ -5613,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);
diff --git a/src/pgtkfns.c b/src/pgtkfns.c
index c604e2f1002..5c43e5f3607 100644
--- a/src/pgtkfns.c
+++ b/src/pgtkfns.c
@@ -38,13 +38,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "xsettings.h"
#include "atimer.h"
-
-#ifdef HAVE_PGTK
-
-/* Static variables to handle applescript execution. */
-static Lisp_Object as_script, *as_result;
-static int as_status;
-
static ptrdiff_t image_cache_refcount;
static int x_decode_color (struct frame *f, Lisp_Object color_name,
@@ -184,7 +177,7 @@ pgtk_display_info_for_name (Lisp_Object name)
static void
-x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
+pgtk_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
unsigned long fg, old_fg;
@@ -211,7 +204,7 @@ x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
static void
-x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
+pgtk_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
unsigned long bg;
@@ -235,7 +228,25 @@ x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
}
static void
-x_set_border_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
+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;
@@ -246,7 +257,7 @@ x_set_border_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
}
static void
-x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
+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;
@@ -349,7 +360,8 @@ pgtk_set_name (struct frame *f, Lisp_Object name, int explicit)
specified a name for the frame; the name will override any set by the
redisplay code. */
static void
-x_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
+pgtk_explicitly_set_name (struct frame *f, Lisp_Object arg,
+ Lisp_Object oldval)
{
pgtk_set_name (f, arg, true);
}
@@ -370,7 +382,7 @@ pgtk_implicitly_set_name (struct frame *f, Lisp_Object arg,
If NAME is nil, use the frame name as the title. */
static void
-x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
+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))
@@ -396,7 +408,7 @@ pgtk_set_doc_edited (void)
static void
-x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
+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;
@@ -442,7 +454,7 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
The frame's height doesn't change. */
static void
-x_set_tab_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
+pgtk_set_tab_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
{
int nlines;
@@ -456,13 +468,12 @@ x_set_tab_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
else
nlines = 0;
- x_change_tab_bar_height (f, nlines * FRAME_LINE_HEIGHT (f));
+ 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
-x_change_tab_bar_height (struct frame *f, int height)
+pgtk_change_tab_bar_height (struct frame *f, int height)
{
int unit = FRAME_LINE_HEIGHT (f);
int old_height = FRAME_TAB_BAR_HEIGHT (f);
@@ -534,7 +545,7 @@ x_change_tool_bar_height (struct frame *f, int height)
/* Toolbar support. */
static void
-x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
+pgtk_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
{
int nlines;
@@ -553,26 +564,33 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
}
static void
-x_set_child_frame_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
+pgtk_set_child_frame_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
- int border = check_int_nonnegative (arg);
+ 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_X_WINDOW (f))
+ if (FRAME_GTK_WIDGET (f))
{
- adjust_frame_size (f, -1, -1, 3, false, Qchild_frame_border_width);
+ adjust_frame_size (f, -1, -1, 3,
+ false, Qchild_frame_border_width);
pgtk_clear_under_internal_border (f);
}
}
-
}
static void
-x_set_internal_border_width (struct frame *f, Lisp_Object arg,
- Lisp_Object oldval)
+pgtk_set_internal_border_width (struct frame *f, Lisp_Object arg,
+ Lisp_Object oldval)
{
int border = check_int_nonnegative (arg);
@@ -589,13 +607,13 @@ x_set_internal_border_width (struct frame *f, Lisp_Object arg,
}
static void
-x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
+pgtk_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
bool result;
if (STRINGP (arg))
{
- if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
+ if (STRINGP (oldval) && BASE_EQ (Fstring_equal (oldval, arg), Qt))
return;
}
else if (!STRINGP (oldval) && NILP (oldval) == NILP (arg))
@@ -619,13 +637,13 @@ x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
}
static void
-x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
+pgtk_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
bool result;
if (STRINGP (arg))
{
- if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
+ if (STRINGP (oldval) && BASE_EQ (Fstring_equal (oldval, arg), Qt))
return;
}
else if (!NILP (arg) || NILP (oldval))
@@ -650,68 +668,19 @@ x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
unblock_input ();
}
-/* This is the same as the xfns.c definition. */
static void
-x_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
+pgtk_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
set_frame_cursor_types (f, arg);
}
-/* called to set mouse pointer color, but all other terms use it to
- initialize pointer types (and don't set the color ;) */
-static void
-x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
-{
-}
-
-
static void
-x_icon (struct frame *f, Lisp_Object parms)
-/* --------------------------------------------------------------------------
- Strangely-named function to set icon position parameters in frame.
- This is irrelevant under macOS, but might be needed under GNUstep,
- depending on the window manager used. Note, this is not a standard
- frame parameter-setter; it is called directly from x-create-frame.
- -------------------------------------------------------------------------- */
+pgtk_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
-#if 0
- Lisp_Object icon_x, icon_y;
- struct pgtk_display_info *dpyinfo = check_pgtk_display_info (Qnil);
-
- FRAME_X_OUTPUT (f)->icon_top = -1;
- FRAME_X_OUTPUT (f)->icon_left = -1;
-
- /* Set the position of the icon. */
- icon_x =
- gui_display_get_arg (dpyinfo, parms, Qicon_left, 0, 0, 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))
- {
- CHECK_NUMBER (icon_x);
- CHECK_NUMBER (icon_y);
- FRAME_X_OUTPUT (f)->icon_top = XFIXNUM (icon_y);
- FRAME_X_OUTPUT (f)->icon_left = XFIXNUM (icon_x);
- }
- else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
- error ("Both left and top icon corners of icon must be specified");
-#endif
}
-/**
- * x_set_undecorated:
- *
- * Set frame F's `undecorated' parameter. If non-nil, F's window-system
- * window is drawn without decorations, title, minimize/maximize boxes
- * and external borders. This usually means that the window cannot be
- * dragged, resized, iconified, maximized or deleted with the mouse. If
- * nil, draw the frame with all the elements listed above unless these
- * have been suspended via window manager settings.
- *
- * Some window managers may not honor this parameter.
- */
static void
-x_set_undecorated (struct frame *f, Lisp_Object new_value,
+pgtk_set_undecorated (struct frame *f, Lisp_Object new_value,
Lisp_Object old_value)
{
if (!EQ (new_value, old_value))
@@ -721,18 +690,8 @@ x_set_undecorated (struct frame *f, Lisp_Object new_value,
}
}
-/**
- * x_set_skip_taskbar:
- *
- * Set frame F's `skip-taskbar' parameter. If non-nil, this should
- * remove F's icon from the taskbar associated with the display of F's
- * window-system window and inhibit switching to F's window via
- * <Alt>-<TAB>. If nil, lift these restrictions.
- *
- * Some window managers may not honor this parameter.
- */
static void
-x_set_skip_taskbar (struct frame *f, Lisp_Object new_value,
+pgtk_set_skip_taskbar (struct frame *f, Lisp_Object new_value,
Lisp_Object old_value)
{
if (!EQ (new_value, old_value))
@@ -742,18 +701,9 @@ x_set_skip_taskbar (struct frame *f, Lisp_Object new_value,
}
}
-/**
- * x_set_override_redirect:
- *
- * Set frame F's `override_redirect' parameter which, if non-nil, hints
- * that the window manager doesn't want to deal with F. Usually, such
- * frames have no decorations and always appear on top of all frames.
- *
- * Some window managers may not honor this parameter.
- */
static void
-x_set_override_redirect (struct frame *f, Lisp_Object new_value,
- Lisp_Object old_value)
+pgtk_set_override_redirect (struct frame *f, Lisp_Object new_value,
+ Lisp_Object old_value)
{
if (!EQ (new_value, old_value))
{
@@ -768,9 +718,7 @@ x_set_override_redirect (struct frame *f, Lisp_Object new_value,
}
}
-/* Set icon from FILE for frame F. By using GTK functions the icon
- may be any format that GdkPixbuf knows about, i.e. not just bitmaps. */
-
+/* Set icon from FILE for frame F. */
bool
xg_set_icon (struct frame *f, Lisp_Object file)
{
@@ -862,6 +810,9 @@ pgtk_set_scroll_bar_foreground (struct frame *f, Lisp_Object new_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);
@@ -874,13 +825,10 @@ pgtk_set_scroll_bar_foreground (struct frame *f, Lisp_Object new_value,
if (!pgtk_parse_color (f, SSDATA (new_value), &rgb))
error ("Unknown color.");
- /* On pgtk, this frame parameter should be ignored, and honor gtk theme. */
-#if 0
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);
-#endif
update_face_from_frame_parameter (f, Qscroll_bar_foreground, new_value);
}
@@ -907,13 +855,13 @@ pgtk_set_scroll_bar_background (struct frame *f, Lisp_Object new_value,
if (!pgtk_parse_color (f, SSDATA (new_value), &rgb))
error ("Unknown color.");
- /* On pgtk, this frame parameter should be ignored, and honor gtk theme. */
-#if 0
+ /* 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);
-#endif
update_face_from_frame_parameter (f, Qscroll_bar_background, new_value);
}
@@ -992,58 +940,58 @@ unless TYPE is `png'. */)
return pgtk_cr_export_frames (frames, surface_type);
}
-
-/* Note: see frame.c for template, also where generic functions are impl */
-frame_parm_handler pgtk_frame_parm_handlers[] = {
- gui_set_autoraise, /* generic OK */
- gui_set_autolower, /* generic OK */
- x_set_background_color,
- x_set_border_color,
- gui_set_border_width,
- x_set_cursor_color,
- x_set_cursor_type,
- gui_set_font, /* generic OK */
- x_set_foreground_color,
- x_set_icon_name,
- x_set_icon_type,
- x_set_child_frame_border_width,
- x_set_internal_border_width, /* generic OK */
- gui_set_right_divider_width,
- gui_set_bottom_divider_width,
- x_set_menu_bar_lines,
- x_set_mouse_color,
- x_explicitly_set_name,
- gui_set_scroll_bar_width, /* generic OK */
- gui_set_scroll_bar_height, /* generic OK */
- x_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 */
- x_set_tab_bar_lines,
- x_set_tool_bar_lines,
- pgtk_set_scroll_bar_foreground,
- pgtk_set_scroll_bar_background,
- gui_set_screen_gamma, /* generic OK */
- gui_set_line_spacing, /* generic OK, sets f->extra_line_spacing to int */
- gui_set_left_fringe, /* generic OK */
- gui_set_right_fringe, /* generic OK */
- 0, /* x_set_wait_for_wm */
- gui_set_fullscreen, /* generic OK */
- gui_set_font_backend, /* generic OK */
- gui_set_alpha,
- pgtk_set_sticky,
- pgtk_set_tool_bar_position,
- 0, /* x_set_inhibit_double_buffering */
- x_set_undecorated,
- x_set_parent_frame,
- x_set_skip_taskbar,
- x_set_no_focus_on_map,
- x_set_no_accept_focus,
- x_set_z_group,
- x_set_override_redirect,
- gui_set_no_special_glyphs,
-};
+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
@@ -1075,7 +1023,7 @@ unwind_create_frame (Lisp_Object frame)
&& FRAME_IMAGE_CACHE (f)->refcount == image_cache_refcount)
FRAME_IMAGE_CACHE (f)->refcount++;
- x_free_frame_resources (f);
+ pgtk_free_frame_resources (f);
free_glyphs (f);
return Qt;
}
@@ -1120,7 +1068,7 @@ pgtk_default_font_parameter (struct frame *f, Lisp_Object parms)
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))
@@ -1208,7 +1156,7 @@ 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. */ )
+scale factor. */)
(Lisp_Object monitor_model, Lisp_Object scale_factor)
{
CHECK_STRING (monitor_model);
@@ -1259,7 +1207,7 @@ This function is an internal primitive--use `make-frame' instead. */ )
bool minibuffer_only = false;
bool undecorated = false, override_redirect = false;
long window_prompting = 0;
- ptrdiff_t count = SPECPDL_INDEX ();
+ specpdl_ref count = SPECPDL_INDEX ();
Lisp_Object display;
struct pgtk_display_info *dpyinfo = NULL;
Lisp_Object parent, parent_frame;
@@ -1273,10 +1221,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_pgtk_display_info (display);
kb = dpyinfo->terminal->kboard;
@@ -1287,7 +1235,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) && !NILP (name))
+ if (!STRINGP (name) && !BASE_EQ (name, Qunbound) && !NILP (name))
error ("Invalid frame name--not a string or nil");
if (STRINGP (name))
@@ -1297,7 +1245,7 @@ This function is an internal primitive--use `make-frame' instead. */ )
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_NUMBER (parent);
@@ -1323,7 +1271,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))
@@ -1337,7 +1285,7 @@ This function is an internal primitive--use `make-frame' instead. */ )
(tem =
(gui_display_get_arg
(dpyinfo, parms, Qundecorated, NULL, NULL, RES_TYPE_BOOLEAN)))
- && !(EQ (tem, Qunbound)))
+ && !(BASE_EQ (tem, Qunbound)))
undecorated = true;
FRAME_UNDECORATED (f) = undecorated;
@@ -1347,7 +1295,7 @@ This function is an internal primitive--use `make-frame' instead. */ )
(tem =
(gui_display_get_arg
(dpyinfo, parms, Qoverride_redirect, NULL, NULL, RES_TYPE_BOOLEAN)))
- && !(EQ (tem, Qunbound)))
+ && !(BASE_EQ (tem, Qunbound)))
override_redirect = true;
FRAME_OVERRIDE_REDIRECT (f) = override_redirect;
@@ -1359,9 +1307,6 @@ This function is an internal primitive--use `make-frame' instead. */ )
f->output_method = output_pgtk;
FRAME_X_OUTPUT (f) = xzalloc (sizeof *FRAME_X_OUTPUT (f));
-#if 0
- FRAME_X_OUTPUT (f)->icon_bitmap = -1;
-#endif
FRAME_FONTSET (f) = -1;
FRAME_X_OUTPUT (f)->white_relief.pixel = -1;
FRAME_X_OUTPUT (f)->black_relief.pixel = -1;
@@ -1426,7 +1371,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;
@@ -1459,12 +1404,8 @@ This function is an internal primitive--use `make-frame' instead. */ )
error ("Invalid frame font");
}
- /* Frame contents get displaced if an embedded X window has a border. */
-#if 0
- if (!FRAME_X_EMBEDDED_P (f))
-#endif
- gui_default_parameter (f, parms, Qborder_width, make_fixnum (0),
- "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
+ gui_default_parameter (f, parms, Qborder_width, make_fixnum (0),
+ "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
if (NILP (Fassq (Qinternal_border_width, parms)))
{
@@ -1473,7 +1414,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);
}
@@ -1490,14 +1431,13 @@ 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);
}
- gui_default_parameter (f, parms, Qchild_frame_border_width,
- make_fixnum (0),
+ 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),
@@ -1543,10 +1483,11 @@ This function is an internal primitive--use `make-frame' instead. */ )
init_frame_faces (f);
/* We have to call adjust_frame_size here since otherwise
- x_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.
+ 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
@@ -1554,14 +1495,12 @@ This function is an internal primitive--use `make-frame' instead. */ )
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);
+ 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);
+ 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),
@@ -1608,15 +1547,16 @@ This function is an internal primitive--use `make-frame' instead. */ )
RES_TYPE_BOOLEAN);
f->no_split = minibuffer_only || EQ (tem, Qt);
-#if 0
- x_icon_verify (f, parms);
-#endif
-
- /* Create the X widget or window. */
- /* x_window (f); */
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)
@@ -1639,11 +1579,6 @@ This function is an internal primitive--use `make-frame' instead. */ )
#undef INSTALL_CURSOR
- x_icon (f, parms);
-#if 0
- x_make_gc (f);
-#endif
-
/* Now consider the frame official. */
f->terminal->reference_count++;
FRAME_DISPLAY_INFO (f)->reference_count++;
@@ -1667,6 +1602,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))
{
@@ -1724,7 +1661,7 @@ This function is an internal primitive--use `make-frame' instead. */ )
badly we want them. This should be done after we have the menu
bar so that its size can be taken into account. */
block_input ();
- x_wm_set_size_hint (f, window_prompting, false);
+ xg_wm_set_size_hint (f, window_prompting, false);
unblock_input ();
adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f),
@@ -1741,22 +1678,39 @@ This function is an internal primitive--use `make-frame' instead. */ )
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);
+ = 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))
- pgtk_iconify_frame (f);
+ {
+ f->was_invisible = true;
+ pgtk_iconify_frame (f);
+ }
else
{
- if (EQ (visibility, Qunbound))
+ 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);
}
@@ -1798,29 +1752,10 @@ This function is an internal primitive--use `make-frame' instead. */ )
return unbind_to (count, frame);
}
-
-#if 0
-static int
-pgtk_window_is_ancestor (PGTKWindow * win, PGTKWindow * candidate)
-/* Test whether CANDIDATE is an ancestor window of WIN. */
-{
- if (candidate == NULL)
- return 0;
- else if (win == candidate)
- return 1;
- else
- return pgtk_window_is_ancestor (win,[candidate parentWindow]);
-}
-#endif
-
-/**
- * x_frame_restack:
- *
- * 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.
- */
+/* 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)
{
@@ -1829,7 +1764,6 @@ pgtk_frame_restack (struct frame *f1, struct frame *f2, bool 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
@@ -2109,7 +2043,7 @@ use `(length \(display-monitor-attributes-list TERMINAL))' instead. */)
DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
- doc: /* Return the height in millimeters of the the display TERMINAL.
+ 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.
@@ -2150,7 +2084,7 @@ for each physical monitor, use `display-monitor-attributes-list'. */)
DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
- doc: /* Return the width in millimeters of the the display TERMINAL.
+ 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.
@@ -2191,7 +2125,7 @@ for each physical monitor, use `display-monitor-attributes-list'. */)
DEFUN ("x-display-backing-store", Fx_display_backing_store, Sx_display_backing_store, 0, 1, 0,
- doc: /* Return an indication of whether the the display TERMINAL does backing store.
+ 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).
@@ -2204,7 +2138,7 @@ If omitted or nil, that stands for the selected frame's display. */)
DEFUN ("x-display-visual-class", Fx_display_visual_class, Sx_display_visual_class, 0, 1, 0,
- doc: /* Return the visual class of the the display TERMINAL.
+ 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'.
@@ -2246,7 +2180,6 @@ terminate Emacs if we can't open the connection. */)
CHECK_STRING (display);
- nxatoms_of_pgtkselect ();
dpyinfo = pgtk_term_init (display, SSDATA (Vx_resource_name));
if (dpyinfo == 0)
{
@@ -2291,27 +2224,6 @@ DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
return result;
}
-
-DEFUN ("pgtk-hide-others", Fpgtk_hide_others, Spgtk_hide_others, 0, 0, 0,
- doc: /* Hides all applications other than Emacs. */)
- (void)
-{
- check_window_system (NULL);
- return Qnil;
-}
-
-DEFUN ("pgtk-hide-emacs", Fpgtk_hide_emacs, Spgtk_hide_emacs, 1, 1, 0,
- doc: /* If ON is non-nil, the entire Emacs application is hidden.
-Otherwise if Emacs is hidden, it is unhidden.
-If ON is equal to `activate', Emacs is unhidden and becomes
-the active application. */)
- (Lisp_Object on)
-{
- check_window_system (NULL);
- return Qnil;
-}
-
-
DEFUN ("pgtk-font-name", Fpgtk_font_name, Spgtk_font_name, 1, 1, 0,
doc: /* Determine font PostScript or family name for font NAME.
NAME should be a string containing either the font name or an XLFD
@@ -2347,7 +2259,6 @@ check_x_display_info (Lisp_Object frame)
return check_pgtk_display_info (frame);
}
-
void
pgtk_set_scroll_bar_default_width (struct frame *f)
{
@@ -2395,9 +2306,8 @@ pgtk_get_string_resource (XrmDatabase rdb, const char *name,
return res;
}
-
Lisp_Object
-x_get_focus_frame (struct frame *frame)
+pgtk_get_focus_frame (struct frame *frame)
{
struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (frame);
Lisp_Object focus;
@@ -2409,13 +2319,6 @@ x_get_focus_frame (struct frame *frame)
return focus;
}
-/* ==========================================================================
-
- Lisp definitions that, for whatever reason, we can't alias as 'ns-XXX'.
-
- ========================================================================== */
-
-
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)
@@ -2447,7 +2350,6 @@ DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
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)
@@ -2456,7 +2358,6 @@ DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
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.
@@ -2468,7 +2369,6 @@ If omitted or nil, that stands for the selected frame's display. */)
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.
@@ -2514,7 +2414,6 @@ each physical monitor, use `display-monitor-attributes-list'. */)
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.
@@ -2766,7 +2665,7 @@ x_create_tip_frame (struct pgtk_display_info *dpyinfo, Lisp_Object parms, struct
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)
@@ -2778,7 +2677,7 @@ x_create_tip_frame (struct pgtk_display_info *dpyinfo, Lisp_Object parms, struct
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");
@@ -2796,9 +2695,6 @@ x_create_tip_frame (struct pgtk_display_info *dpyinfo, Lisp_Object parms, struct
counts etc. */
f->output_method = output_pgtk;
f->output_data.pgtk = xzalloc (sizeof *f->output_data.pgtk);
-#if 0
- f->output_data.pgtk->icon_bitmap = -1;
-#endif
FRAME_FONTSET (f) = -1;
f->output_data.pgtk->white_relief.pixel = -1;
f->output_data.pgtk->black_relief.pixel = -1;
@@ -2832,7 +2728,7 @@ x_create_tip_frame (struct pgtk_display_info *dpyinfo, Lisp_Object parms, struct
/* 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;
@@ -2873,7 +2769,7 @@ x_create_tip_frame (struct pgtk_display_info *dpyinfo, Lisp_Object parms, struct
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);
}
@@ -2924,10 +2820,6 @@ x_create_tip_frame (struct pgtk_display_info *dpyinfo, Lisp_Object parms, struct
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;
-#if 0
- x_make_gc (f);
-#endif
-
gui_default_parameter (f, parms, Qauto_raise, Qnil,
"autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
gui_default_parameter (f, parms, Qauto_lower, Qnil,
@@ -2936,6 +2828,8 @@ x_create_tip_frame (struct pgtk_display_info *dpyinfo, Lisp_Object parms, struct
"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)))
@@ -2966,7 +2860,7 @@ x_create_tip_frame (struct pgtk_display_info *dpyinfo, Lisp_Object parms, struct
Frame parameters may be changed if .Xdefaults contains
specifications for the default font. For example, if there is an
`Emacs.default.attributeBackground: pink', the `background-color'
- attribute of the frame get's set, which let's the internal border
+ 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);
@@ -3074,8 +2968,8 @@ compute_tip_xy (struct frame *f, Lisp_Object parms, Lisp_Object dx,
{
min_x = 0;
min_y = 0;
- max_x = x_display_pixel_width (FRAME_DISPLAY_INFO (f));
- max_y = x_display_pixel_height (FRAME_DISPLAY_INFO (f));
+ max_x = pgtk_display_pixel_width (FRAME_DISPLAY_INFO (f));
+ max_y = pgtk_display_pixel_height (FRAME_DISPLAY_INFO (f));
}
if (INTEGERP (top))
@@ -3114,7 +3008,7 @@ compute_tip_xy (struct frame *f, Lisp_Object parms, Lisp_Object dx,
/* Hide tooltip. Delete its frame if DELETE is true. */
static Lisp_Object
-x_hide_tip (bool delete)
+pgtk_hide_tip (bool delete)
{
if (!NILP (tip_timer))
{
@@ -3128,7 +3022,7 @@ x_hide_tip (bool delete)
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))
- || (!x_gtk_use_system_tooltips
+ || (!use_system_tooltips
&& !delete
&& FRAMEP (tip_frame)
&& FRAME_LIVE_P (XFRAME (tip_frame))
@@ -3139,10 +3033,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);
@@ -3161,7 +3054,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. */
@@ -3171,7 +3064,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
@@ -3206,7 +3099,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
@@ -3234,8 +3128,7 @@ 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;
AUTO_STRING (tip, " *tip*");
@@ -3253,9 +3146,8 @@ Text larger than the specified size is clipped. */)
return unbind_to (count, Qnil);
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);
@@ -3267,7 +3159,7 @@ Text larger than the specified size is clipped. */)
else
CHECK_FIXNUM (dy);
- if (x_gtk_use_system_tooltips)
+ if (use_system_tooltips)
{
bool ok;
@@ -3356,13 +3248,13 @@ Text larger than the specified size is clipped. */)
}
}
- x_hide_tip (delete);
+ pgtk_hide_tip (delete);
}
else
- x_hide_tip (true);
+ pgtk_hide_tip (true);
}
else
- x_hide_tip (true);
+ pgtk_hide_tip (true);
tip_last_frame = frame;
tip_last_string = string;
@@ -3430,7 +3322,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);
@@ -3489,7 +3381,7 @@ DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
Value is t if tooltip was open, nil otherwise. */)
(void)
{
- return x_hide_tip (!tooltip_reuse_hidden_frame);
+ return pgtk_hide_tip (!tooltip_reuse_hidden_frame);
}
/* Return geometric attributes of FRAME. According to the value of
@@ -3515,10 +3407,8 @@ frame_geometry (Lisp_Object frame, Lisp_Object attribute)
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);
- }
+ gtk_window_get_position (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
+ &left_pos, &top_pos);
else
{
GtkAllocation alloc;
@@ -3747,7 +3637,6 @@ visible. */)
(Lisp_Object frames)
{
Lisp_Object rest, tmp;
- int count;
if (!CONSP (frames))
frames = list1 (frames);
@@ -3766,7 +3655,7 @@ visible. */)
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);
@@ -3804,7 +3693,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);
@@ -3872,7 +3761,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");
@@ -3907,11 +3796,18 @@ nil, it defaults to the selected frame. */)
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);
- Lisp interface declaration
+ block_input ();
+ gtk_window_set_interactive_debugging (enable_debug);
+ unblock_input ();
- ========================================================================== */
+ return NILP (enable) ? Qnil : Qt;
+}
void
syms_of_pgtkfns (void)
@@ -3926,38 +3822,10 @@ syms_of_pgtkfns (void)
DEFSYM (Qresize_mode, "resize-mode");
DEFVAR_LISP ("x-cursor-fore-pixel", Vx_cursor_fore_pixel,
- doc: /* A string indicating the foreground color of the cursor box. */);
+ doc: /* SKIP: real doc in xfns.c. */);
Vx_cursor_fore_pixel = Qnil;
- DEFVAR_LISP ("pgtk-icon-type-alist", Vpgtk_icon_type_alist,
- doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames.
-If the title of a frame matches REGEXP, then IMAGE.tiff is
-selected as the image of the icon representing the frame when it's
-miniaturized. If an element is t, then Emacs tries to select an icon
-based on the filetype of the visited file.
-
-The images have to be installed in a folder called English.lproj in the
-Emacs folder. You have to restart Emacs after installing new icons.
-
-Example: Install an icon Gnus.tiff and execute the following code
-
-(setq pgtk-icon-type-alist
-(append pgtk-icon-type-alist
-\\='((\"^\\\\*\\\\(Group\\\\*$\\\\|Summary \\\\|Article\\\\*$\\\\)\"
-. \"Gnus\"))))
-
-When you miniaturize a Group, Summary or Article frame, Gnus.tiff will
-be used as the image of the icon representing the frame. */);
- Vpgtk_icon_type_alist = list1 (Qt);
-
-
- /* Provide x-toolkit also for GTK. Internally GTK does not use Xt so it
- is not an X toolkit in that sense (USE_X_TOOLKIT is not defined).
- But for a user it is a toolkit for X, and indeed, configure
- accepts --with-x-toolkit=gtk. */
- Fprovide (intern_c_string ("x-toolkit"), Qnil);
Fprovide (intern_c_string ("gtk"), Qnil);
- Fprovide (intern_c_string ("move-toolbar"), Qnil);
DEFVAR_LISP ("gtk-version-string", Vgtk_version_string,
doc: /* Version info for GTK+. */);
@@ -3984,7 +3852,6 @@ be used as the image of the icon representing the frame. */);
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);
@@ -4012,9 +3879,7 @@ be used as the image of the icon representing the frame. */);
defsubr (&Sx_open_connection);
defsubr (&Sx_close_connection);
defsubr (&Sx_display_list);
-
- defsubr (&Spgtk_hide_others);
- defsubr (&Spgtk_hide_emacs);
+ defsubr (&Sx_gtk_debug);
defsubr (&Sx_show_tip);
defsubr (&Sx_hide_tip);
@@ -4030,10 +3895,6 @@ be used as the image of the icon representing the frame. */);
defsubr (&Sx_file_dialog);
defsubr (&Sx_select_font);
- as_status = 0;
- as_script = Qnil;
- as_result = 0;
-
monitor_scale_factor_alist = Qnil;
staticpro (&monitor_scale_factor_alist);
@@ -4050,58 +3911,21 @@ be used as the image of the icon representing the frame. */);
/* 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: /* Non-nil means prompt with the old GTK file selection dialog.
-If nil or if the file selection dialog is not available, the new GTK file
-chooser is used instead. To turn off all file dialogs set the
-variable `use-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: /* If non-nil, the GTK file chooser will by default show hidden files.
-Note that this is just the default, there is a toggle button on the file
-chooser to show or not show hidden files on a case by case basis. */);
+ 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: /* If non-nil, the GTK file chooser will show additional help text.
-If more space for files in the file chooser dialog is wanted, set this to nil
-to turn the additional text off. */);
+ doc: /* SKIP: real doc in xfns.c. */);
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-max-tooltip-size", Vx_max_tooltip_size,
- doc: /* Maximum size for tooltips.
-Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
+ doc: /* SKIP: real doc in xfns.c. */);
Vx_max_tooltip_size = Fcons (make_fixnum (80), make_fixnum (40));
- 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
-default and usually works with most desktops. Some desktop environments
-(GNOME shell in particular when using the mutter window manager),
-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
-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
-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
-avoids, however, the unpleasant flicker induced by the hiding approach.
-
-This variable is considered a temporary workaround and will be hopefully
-eliminated in future versions of Emacs. */);
- x_gtk_resize_child_frames = Qnil;
-
-
DEFSYM (Qmono, "mono");
DEFSYM (Qassq_delete_all, "assq-delete-all");
@@ -4115,5 +3939,3 @@ eliminated in future versions of Emacs. */);
DEFSYM (Qreverse_portrait, "reverse-portrait");
DEFSYM (Qreverse_landscape, "reverse-landscape");
}
-
-#endif
diff --git a/src/pgtkim.c b/src/pgtkim.c
index 8577ba2116e..e1fffafb611 100644
--- a/src/pgtkim.c
+++ b/src/pgtkim.c
@@ -25,7 +25,9 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "pgtkterm.h"
static void
-im_context_commit_cb (GtkIMContext * imc, gchar * str, gpointer user_data)
+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;
@@ -39,21 +41,21 @@ im_context_commit_cb (GtkIMContext * imc, gchar * str, gpointer user_data)
}
static gboolean
-im_context_retrieve_surrounding_cb (GtkIMContext * imc, gpointer user_data)
+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,
+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)
+make_color_string (PangoAttrColor *pac)
{
char buf[256];
sprintf (buf, "#%02x%02x%02x",
@@ -62,7 +64,7 @@ make_color_string (PangoAttrColor * pac)
}
static void
-im_context_preedit_changed_cb (GtkIMContext * imc, gpointer user_data)
+im_context_preedit_changed_cb (GtkIMContext *imc, gpointer user_data)
{
struct pgtk_display_info *dpyinfo = user_data;
struct frame *f = dpyinfo->im.focused_frame;
@@ -149,7 +151,7 @@ im_context_preedit_changed_cb (GtkIMContext * imc, gpointer user_data)
}
static void
-im_context_preedit_end_cb (GtkIMContext * imc, gpointer user_data)
+im_context_preedit_end_cb (GtkIMContext *imc, gpointer user_data)
{
struct pgtk_display_info *dpyinfo = user_data;
struct frame *f = dpyinfo->im.focused_frame;
@@ -163,7 +165,7 @@ im_context_preedit_end_cb (GtkIMContext * imc, gpointer user_data)
}
static void
-im_context_preedit_start_cb (GtkIMContext * imc, gpointer user_data)
+im_context_preedit_start_cb (GtkIMContext *imc, gpointer user_data)
{
}
diff --git a/src/pgtkmenu.c b/src/pgtkmenu.c
index d1b1bfffb36..2eabf6ac1bc 100644
--- a/src/pgtkmenu.c
+++ b/src/pgtkmenu.c
@@ -43,7 +43,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <gtk/gtk.h>
/* Flag which when set indicates a dialog or menu has been posted by
- Xt on behalf of one of the widget sets. */
+ 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. */
@@ -62,19 +62,14 @@ pgtk_menu_set_in_use (bool in_use)
struct frame *f = XFRAME (frame);
if (in_use && FRAME_Z_GROUP_ABOVE (f))
- x_set_z_group (f, Qabove_suspended, Qabove);
+ pgtk_set_z_group (f, Qabove_suspended, Qabove);
else if (!in_use && FRAME_Z_GROUP_ABOVE_SUSPENDED (f))
- x_set_z_group (f, Qabove, Qabove_suspended);
+ 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: /* 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 has no menu bar this function does nothing.
-
- If FRAME is nil or not given, use the selected frame. */)
+ doc: /* SKIP: real doc in USE_GTK definition in xmenu.c. */)
(Lisp_Object frame)
{
GtkWidget *menubar;
@@ -132,7 +127,7 @@ pgtk_activate_menubar (struct frame *f)
static void
popup_deactivate_callback (GtkWidget *widget, gpointer client_data)
{
- popup_activated_flag = 0;
+ pgtk_menu_set_in_use (false);
}
/* Function that finds the frame for WIDGET and shows the HELP text
@@ -141,31 +136,15 @@ popup_deactivate_callback (GtkWidget *widget, gpointer client_data)
static void
show_help_event (struct frame *f, GtkWidget *widget, Lisp_Object help)
{
- /* Don't show this tooltip.
- * Tooltips are always tied to main widget, so stacking order
- * on Wayland is:
- * (above)
- * - menu
- * - tooltip
- * - main widget
- * (below)
- * This is applicable to tooltips for menu, and menu tooltips
- * are shown below menus.
- * As a workaround, I entrust Gtk with menu tooltips, and
- * let emacs not to show menu tooltips.
- */
-
-#if 0
- Lisp_Object frame;
-
- if (f)
- {
- XSETFRAME (frame, f);
- kbd_buffer_store_help_event (frame, help);
- }
- else
- show_help_echo (help, Qnil, Qnil, Qnil);
-#endif
+ /* 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
@@ -279,7 +258,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);
@@ -558,7 +537,7 @@ create_and_show_popup_menu (struct frame *f, widget_value * first_wv,
int x, int y, bool for_click)
{
GtkWidget *menu;
- ptrdiff_t specpdl_count = SPECPDL_INDEX ();
+ specpdl_ref specpdl_count = SPECPDL_INDEX ();
eassert (FRAME_PGTK_P (f));
@@ -625,17 +604,12 @@ pgtk_menu_show (struct frame *f, int x, int y, int menuflags,
= alloca (menu_items_used * sizeof *subprefix_stack);
int submenu_depth = 0;
- ptrdiff_t specpdl_count = SPECPDL_INDEX ();
+ specpdl_ref specpdl_count = SPECPDL_INDEX ();
eassert (FRAME_PGTK_P (f));
*error_name = NULL;
- if (!FRAME_GTK_OUTER_WIDGET (f)) {
- *error_name = "Can't popup from child frames.";
- return Qnil;
- }
-
if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
{
*error_name = "Empty menu";
@@ -902,7 +876,7 @@ create_and_show_dialog (struct frame *f, widget_value *first_wv)
if (menu)
{
- ptrdiff_t specpdl_count = SPECPDL_INDEX ();
+ specpdl_ref specpdl_count = SPECPDL_INDEX ();
record_unwind_protect_ptr (pop_down_menu, menu);
/* Display the menu. */
@@ -934,17 +908,12 @@ pgtk_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_PGTK_P (f));
*error_name = NULL;
- if (!FRAME_GTK_OUTER_WIDGET (f)) {
- *error_name = "Can't popup from child frames.";
- return Qnil;
- }
-
if (menu_items_n_panes > 1)
{
*error_name = "Multiple panes in dialog box";
@@ -1087,7 +1056,7 @@ pgtk_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);
diff --git a/src/pgtkselect.c b/src/pgtkselect.c
index 23a79895d54..e0230003b3a 100644
--- a/src/pgtkselect.c
+++ b/src/pgtkselect.c
@@ -17,14 +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/>. */
-/*
-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. */
#include <config.h>
@@ -33,25 +25,37 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
#include "pgtkterm.h"
#include "termhooks.h"
#include "keyboard.h"
-#include "pgtkselect.h"
-#include <gdk/gdk.h>
-
-#if 0
-static Lisp_Object Vselection_alist;
-#endif
+#include "atimer.h"
+#include "blockinput.h"
-static GQuark quark_primary_data = 0;
-static GQuark quark_primary_size = 0;
-static GQuark quark_secondary_data = 0;
-static GQuark quark_secondary_size = 0;
-static GQuark quark_clipboard_data = 0;
-static GQuark quark_clipboard_size = 0;
+/* 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;
- Internal utility functions
-
- ========================================================================== */
+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
@@ -100,489 +104,1765 @@ frame_for_pgtk_selection (Lisp_Object object)
return NULL;
}
-static GtkClipboard *
-symbol_to_gtk_clipboard (GtkWidget * widget, Lisp_Object symbol)
+#define LOCAL_SELECTION(selection_symbol, dpyinfo) \
+ assq_no_quit (selection_symbol, dpyinfo->terminal->Vselection_alist)
+
+static GdkAtom
+symbol_to_gdk_atom (Lisp_Object sym)
{
- GdkAtom atom;
+ if (NILP (sym))
+ return GDK_NONE;
- CHECK_SYMBOL (symbol);
- if (NILP (symbol))
- {
- atom = GDK_SELECTION_PRIMARY;
- }
- else if (EQ (symbol, QCLIPBOARD))
+ 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))
{
- atom = GDK_SELECTION_CLIPBOARD;
+ 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);
}
- else if (EQ (symbol, QPRIMARY))
+ 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))
{
- atom = GDK_SELECTION_PRIMARY;
+ handler_fn = Qnil;
+ value = XCAR (XCDR (XCDR (local_value)));
}
- else if (EQ (symbol, QSECONDARY))
+ else
{
- atom = GDK_SELECTION_SECONDARY;
+ /* 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);
}
- else if (EQ (symbol, Qt))
+
+ /* 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)
{
- atom = GDK_SELECTION_SECONDARY;
+ next = cs->next;
+ if (! cs->nofree && cs->data)
+ xfree (cs->data);
+ xfree (cs);
}
- else
+ 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)
{
- atom = 0;
- error ("Bad selection");
+ 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);
}
- return gtk_widget_get_clipboard (widget, atom);
+ /* 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
-selection_type_to_quarks (GdkAtom type, GQuark * quark_data,
- GQuark * quark_size)
+pgtk_handle_selection_request (struct selection_input_event *event)
{
- if (type == GDK_SELECTION_PRIMARY)
+ 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)
{
- *quark_data = quark_primary_data;
- *quark_size = quark_primary_size;
+ tem = Qnil;
+
+ if (CONSP (alias))
+ tem = XCAR (alias);
+
+ if (CONSP (tem)
+ && EQ (XCAR (tem), selection_symbol)
+ && SYMBOLP (XCDR (tem)))
+ {
+ selection_symbol = XCDR (tem);
+ break;
+ }
}
- else if (type == GDK_SELECTION_SECONDARY)
+
+ 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))
{
- *quark_data = quark_secondary_data;
- *quark_size = quark_secondary_size;
+ /* 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 (type == GDK_SELECTION_CLIPBOARD)
+ else
{
- *quark_data = quark_clipboard_data;
- *quark_size = quark_clipboard_size;
+ 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))))
{
- /* fixme: Is it safe to use 'error' here? */
- error ("Unknown selection type.");
+ 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
-get_func (GtkClipboard * cb, GtkSelectionData * data, guint info,
- gpointer user_data_or_owner)
+pgtk_handle_selection_clear (struct selection_input_event *event)
{
- GObject *obj = G_OBJECT (user_data_or_owner);
- const char *str;
- int size;
- GQuark quark_data, quark_size;
+ GdkAtom selection = SELECTION_EVENT_SELECTION (event);
+ guint32 changed_owner_time = SELECTION_EVENT_TIME (event);
- selection_type_to_quarks (gtk_clipboard_get_selection (cb), &quark_data,
- &quark_size);
+ Lisp_Object selection_symbol, local_selection_data;
+ guint32 local_selection_time;
+ struct pgtk_display_info *dpyinfo = SELECTION_EVENT_DPYINFO (event);
+ Lisp_Object Vselection_alist;
- str = g_object_get_qdata (obj, quark_data);
- size = GPOINTER_TO_SIZE (g_object_get_qdata (obj, quark_size));
- gtk_selection_data_set_text (data, str, size);
+ 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);
}
-static void
-clear_func (GtkClipboard * cb, gpointer user_data_or_owner)
+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)
{
- GObject *obj = G_OBJECT (user_data_or_owner);
- GQuark quark_data, quark_size;
+ 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. */
- selection_type_to_quarks (gtk_clipboard_get_selection (cb), &quark_data,
- &quark_size);
+/* Currently unused -- uncomment later if we decide to implement INCR
+ transfer for X. */
+
+#if 0
- g_object_set_qdata (obj, quark_data, NULL);
- g_object_set_qdata (obj, quark_size, 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;
- Functions used externally
+ 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. */
-void
-pgtk_selection_init (void)
+static void
+wait_for_property_change_unwind (void *loc)
{
- if (quark_primary_data == 0)
+ 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)
{
- quark_primary_data = g_quark_from_static_string ("pgtk-primary-data");
- quark_primary_size = g_quark_from_static_string ("pgtk-primary-size");
- quark_secondary_data =
- g_quark_from_static_string ("pgtk-secondary-data");
- quark_secondary_size =
- g_quark_from_static_string ("pgtk-secondary-size");
- quark_clipboard_data =
- g_quark_from_static_string ("pgtk-clipboard-data");
- quark_clipboard_size =
- g_quark_from_static_string ("pgtk-clipboard-size");
+ 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_selection_lost (GtkWidget * widget, GdkEventSelection * event,
- gpointer user_data)
+pgtk_handle_property_notify (GdkEventProperty *event)
{
- GQuark quark_data, quark_size;
+ struct prop_location *rest;
+ GdkDisplay *dpy;
- selection_type_to_quarks (event->selection, &quark_data, &quark_size);
+ dpy = gdk_window_get_display (event->window);
- g_object_set_qdata (G_OBJECT (widget), quark_data, NULL);
- g_object_set_qdata (G_OBJECT (widget), quark_size, 0);
+ 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 bool
-pgtk_selection_usable (void)
-{
- if (pgtk_enable_selection_on_multi_display)
- return true;
-
- /*
- * https://github.com/GNOME/gtk/blob/gtk-3-24/gdk/wayland/gdkselection-wayland.c#L1033
- *
- * Gdk uses gdk_display_get_default() when handling selections, so
- * selections don't work properly on multi-display environment.
- *
- * ----------------
- * #include <gtk/gtk.h>
- *
- * static GtkWidget *top1, *top2;
- *
- * int main (int argc, char **argv)
- * {
- * GtkWidget *w;
- * GtkTextBuffer *buf;
- *
- * gtk_init (&argc, &argv);
- *
- * static char *text = "\
- * It is fine today.\n\
- * It will be fine tomorrow too.\n\
- * It is too hot.";
- *
- * top1 = gtk_window_new (GTK_WINDOW_TOPLEVEL);
- * gtk_window_set_title (GTK_WINDOW (top1), "default");
- * gtk_widget_show (top1);
- * w = gtk_text_view_new ();
- * gtk_container_add (GTK_CONTAINER (top1), w);
- * gtk_widget_show (w);
- * buf = gtk_text_view_get_buffer (GTK_TEXT_VIEW (w));
- * gtk_text_buffer_insert_at_cursor (buf, text, strlen (text));
- * gtk_text_buffer_add_selection_clipboard (buf, gtk_widget_get_clipboard (w, GDK_SELECTION_PRIMARY));
- *
- * unsetenv ("GDK_BACKEND");
- * GdkDisplay *gdpy;
- * const char *dpyname2;
- * if (strcmp (G_OBJECT_TYPE_NAME (gtk_widget_get_window (top1)), "GdkWaylandWindow") == 0)
- * dpyname2 = ":0";
- * else
- * dpyname2 = "wayland-0";
- * gdpy = gdk_display_open (dpyname2);
- * top2 = gtk_window_new (GTK_WINDOW_TOPLEVEL);
- * gtk_window_set_title (GTK_WINDOW (top2), dpyname2);
- * gtk_window_set_screen (GTK_WINDOW (top2), gdk_display_get_default_screen (gdpy));
- * gtk_widget_show (top2);
- * w = gtk_text_view_new ();
- * gtk_container_add (GTK_CONTAINER (top2), w);
- * gtk_widget_show (w);
- * buf = gtk_text_view_get_buffer (GTK_TEXT_VIEW (w));
- * gtk_text_buffer_insert_at_cursor (buf, text, strlen (text));
- * gtk_text_buffer_add_selection_clipboard (buf, gtk_widget_get_clipboard (w, GDK_SELECTION_PRIMARY));
- *
- * gtk_main ();
- *
- * return 0;
- * }
- * ----------------
- *
- * This code fails if
- * GDK_BACKEND=x11 ./test
- * and select on both of windows.
- *
- * ----------------
- * (test:15345): GLib-GObject-CRITICAL **: 01:56:38.041: g_object_ref: assertion 'G_IS_OBJECT (object)' failed
- *
- * (test:15345): GLib-GObject-CRITICAL **: 01:56:38.042: g_object_ref: assertion 'G_IS_OBJECT (object)' failed
- *
- * (test:15345): GLib-GObject-CRITICAL **: 01:56:39.113: g_object_ref: assertion 'G_IS_OBJECT (object)' failed
- *
- * (test:15345): GLib-GObject-CRITICAL **: 01:56:39.113: g_object_ref: assertion 'G_IS_OBJECT (object)' failed
- * ----------------
- * (gtk-3.24.10)
- *
- * This function checks whether selections work by the number of displays.
- * If you use more than 2 displays, then selection is disabled.
- */
+static void
+pgtk_display_selection_waiting_message (struct atimer *timer)
+{
+ Lisp_Object val;
- GdkDisplayManager *dpyman = gdk_display_manager_get ();
- GSList *list = gdk_display_manager_list_displays (dpyman);
- int len = g_slist_length (list);
- g_slist_free (list);
- return len < 2;
+ val = build_string ("Waiting for reply from selection owner...");
+ message3_nolog (val);
}
-/* ==========================================================================
+static void
+pgtk_cancel_atimer (void *atimer)
+{
+ cancel_atimer (atimer);
+}
- Lisp Defuns
+
+/* 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));
+}
-DEFUN ("pgtk-own-selection-internal", Fpgtk_own_selection_internal, Spgtk_own_selection_internal, 2, 3, 0,
- doc: /* Assert an X selection of type SELECTION and value VALUE.
-SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
-\(Those are literal upper-case symbol names, since that's what X expects.)
-VALUE is typically a string, or a cons of two markers, but may be
-anything that the functions on `selection-converter-alist' know about.
+/* Subroutines of pgtk_get_window_property_as_lisp_data */
-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)
+static ptrdiff_t
+pgtk_size_for_format (gint format)
{
- Lisp_Object successful_p = Qnil;
- Lisp_Object target_symbol, rest;
- GtkClipboard *cb;
- struct frame *f;
- GQuark quark_data, quark_size;
+ switch (format)
+ {
+ case 8:
+ return sizeof (unsigned char);
+ case 16:
+ return sizeof (unsigned short);
+ case 32:
+ return sizeof (unsigned long);
+
+ default:
+ emacs_abort ();
+ }
+}
- check_window_system (NULL);
+/* Use xfree, not g_free, to free the data obtained with this function. */
- if (!pgtk_selection_usable ())
- return Qnil;
+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;
- if (NILP (frame))
- frame = selected_frame;
- if (!FRAME_LIVE_P (XFRAME (frame)) || !FRAME_PGTK_P (XFRAME (frame)))
- error ("pgtk selection unavailable for this frame");
- f = XFRAME (frame);
+ 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;
- cb = symbol_to_gtk_clipboard (FRAME_GTK_WIDGET (f), selection);
- selection_type_to_quarks (gtk_clipboard_get_selection (cb), &quark_data,
- &quark_size);
+ return;
+ }
+
+ element_size = pgtk_size_for_format (actual_format);
+ length = length / element_size;
- /* We only support copy of text. */
- target_symbol = QTEXT;
- if (STRINGP (value))
+ /* 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)
{
- GtkTargetList *list;
- GtkTargetEntry *targets;
- gint n_targets;
- GtkWidget *widget;
+ ldata = (typeof (ldata)) data;
+ idata = xdata;
- list = gtk_target_list_new (NULL, 0);
- gtk_target_list_add_text_targets (list, 0);
+ for (i = 0; i < length; ++i)
+ idata[i] = ldata[i];
- {
- /* text/plain: Strings encoded by Gtk are not correctly decoded by Chromium(Wayland). */
- GdkAtom atom_text_plain = gdk_atom_intern ("text/plain", false);
- gtk_target_list_remove (list, atom_text_plain);
- }
+ /* 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;
+}
- targets = gtk_target_table_new_from_list (list, &n_targets);
+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;
- int size = SBYTES (value);
- gchar *str = xmalloc (size + 1);
- memcpy (str, SSDATA (value), size);
- str[size] = '\0';
+ 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;
+}
- widget = FRAME_GTK_WIDGET (f);
- g_object_set_qdata_full (G_OBJECT (widget), quark_data, str, xfree);
- g_object_set_qdata_full (G_OBJECT (widget), quark_size,
- GSIZE_TO_POINTER (size), NULL);
+
+
+/* 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;
- if (gtk_clipboard_set_with_owner (cb,
- targets, n_targets,
- get_func, clear_func,
- G_OBJECT (FRAME_GTK_WIDGET (f))))
+ 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
{
- successful_p = Qt;
+ 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;
}
- gtk_clipboard_set_can_store (cb, NULL, 0);
+ }
+
+ /* 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;
- gtk_target_table_free (targets, n_targets);
- gtk_target_list_unref (list);
+ if (CONSP (obj) && SYMBOLP (XCAR (obj)))
+ {
+ type = XCAR (obj);
+ obj = XCDR (obj);
+ if (CONSP (obj) && NILP (XCDR (obj)))
+ obj = XCAR (obj);
}
- if (!EQ (Vpgtk_sent_selection_hooks, Qunbound))
+ 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))
{
- /* FIXME: Use run-hook-with-args! */
- for (rest = Vpgtk_sent_selection_hooks; CONSP (rest);
- rest = Fcdr (rest))
- call3 (Fcar (rest), selection, target_symbol, successful_p);
+ 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-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.
+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'.
-Sets the last-change time for the selection to TIME-OBJECT (by default
-the time of the last event).
+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.
-
-On Nextstep, the TIME-OBJECT and TERMINAL arguments are unused.
-On MS-DOS, all this does is return non-nil if we own the selection.
-On PGTK, the TIME-OBJECT is unused. */)
- (Lisp_Object selection, Lisp_Object time_object, Lisp_Object terminal)
+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);
- GtkClipboard *cb;
- if (!pgtk_selection_usable ())
- return Qnil;
+ CHECK_SYMBOL (selection_symbol);
+ CHECK_SYMBOL (target_type);
+ if (EQ (target_type, QMULTIPLE))
+ error ("Retrieving MULTIPLE selections is currently unimplemented");
if (!f)
- return Qnil;
+ 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);
- cb = symbol_to_gtk_clipboard (FRAME_GTK_WIDGET (f), selection);
+ if (!NILP (maybe_alias))
+ {
+ selection_symbol = XCDR (maybe_alias);
+ CHECK_SYMBOL (selection_symbol);
+ }
- gtk_clipboard_clear (cb);
+ val = pgtk_get_local_selection (selection_symbol, target_type, true,
+ FRAME_DISPLAY_INFO (f));
- return Qt;
+ 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.
-DEFUN ("pgtk-selection-exists-p", Fpgtk_selection_exists_p, Spgtk_selection_exists_p, 0, 2, 0,
- doc: /* Whether there is an owner for the given X selection.
-SELECTION should be the name of the selection in question, typically
-one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. (X expects
-these literal upper-case names.) The symbol nil is the same as
-`PRIMARY', and t is the same as `SECONDARY'.
+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.
-
-On Nextstep, TERMINAL is unused. */)
- (Lisp_Object selection, Lisp_Object terminal)
+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);
- GtkClipboard *cb;
+ struct pgtk_display_info *dpyinfo;
- if (!pgtk_selection_usable ())
+ if (!f)
return Qnil;
- if (!f)
+ 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;
- cb = symbol_to_gtk_clipboard (FRAME_GTK_WIDGET (f), selection);
+ selection_atom = symbol_to_gdk_atom (selection);
- return gtk_clipboard_wait_is_text_available (cb) ? Qt : Qnil;
-}
+ 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 X Selection.
+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 X expects.)
+\(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 X
+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.
-
-On Nextstep, TERMINAL is unused. */)
+frame's display, or the first available X display. */)
(Lisp_Object selection, Lisp_Object terminal)
{
struct frame *f = frame_for_pgtk_selection (terminal);
- GtkClipboard *cb;
- GObject *obj;
- GQuark quark_data, quark_size;
- if (!pgtk_selection_usable ())
- return Qnil;
-
- cb = symbol_to_gtk_clipboard (FRAME_GTK_WIDGET (f), selection);
- selection_type_to_quarks (gtk_clipboard_get_selection (cb), &quark_data,
- &quark_size);
+ CHECK_SYMBOL (selection);
+ if (NILP (selection)) selection = QPRIMARY;
+ if (EQ (selection, Qt)) selection = QSECONDARY;
- obj = gtk_clipboard_get_owner (cb);
-
- return obj && g_object_get_qdata (obj, quark_data) != NULL ? Qt : Qnil;
+ 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'.
-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
+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.
-
-On Nextstep, TIME-STAMP and TERMINAL are unused.
-On PGTK, TIME-STAMP is unused. */)
- (Lisp_Object selection_symbol, Lisp_Object target_type,
- Lisp_Object time_stamp, Lisp_Object terminal)
+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);
- GtkClipboard *cb;
+ struct pgtk_display_info *dpyinfo;
- CHECK_SYMBOL (selection_symbol);
- CHECK_SYMBOL (target_type);
- if (EQ (target_type, QMULTIPLE))
- error ("Retrieving MULTIPLE selections is currently unimplemented");
- if (!f)
- error ("PGTK selection unavailable for this frame");
+ CHECK_SYMBOL (selection);
+ if (NILP (selection)) selection = QPRIMARY;
+ if (EQ (selection, Qt)) selection = QSECONDARY;
- if (!pgtk_selection_usable ())
+ if (!f)
return Qnil;
- cb = symbol_to_gtk_clipboard (FRAME_GTK_WIDGET (f), selection_symbol);
+ dpyinfo = FRAME_DISPLAY_INFO (f);
- GdkAtom target_atom = gdk_atom_intern (SSDATA (SYMBOL_NAME (target_type)), false);
- GtkSelectionData *seldata = gtk_clipboard_wait_for_contents (cb, target_atom);
+ if (!NILP (LOCAL_SELECTION (selection, dpyinfo)))
+ return Qt;
- if (seldata == NULL)
- return Qnil;
+ 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. */
- const guchar *sd_data = gtk_selection_data_get_data (seldata);
- int sd_len = gtk_selection_data_get_length (seldata);
- int sd_format = gtk_selection_data_get_format (seldata);
- GdkAtom sd_type = gtk_selection_data_get_data_type (seldata);
+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));
+}
- if (sd_format == 8)
+
+/***********************************************************************
+ 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)
{
- Lisp_Object str, lispy_type;
+ if (!CONSP (tem))
+ continue;
- str = make_unibyte_string ((char *) sd_data, sd_len);
- /* Indicate that this string is from foreign selection by a text
- property `foreign-selection' so that the caller of
- x-get-selection-internal (usually x-get-selection) can know
- that the string must be decode. */
- if (sd_type == gdk_atom_intern ("COMPOUND_TEXT", false))
- lispy_type = QCOMPOUND_TEXT;
- else if (sd_type == gdk_atom_intern ("UTF8_STRING", false))
- lispy_type = QUTF8_STRING;
- else if (sd_type == gdk_atom_intern ("text/plain;charset=utf-8", false))
- lispy_type = Qtext_plain_charset_utf_8;
- else
- lispy_type = QSTRING;
- Fput_text_property (make_fixnum (0), make_fixnum (sd_len),
- Qforeign_selection, lispy_type, str);
+ t = XCAR (tem);
- gtk_selection_data_free (seldata);
- return str;
+ 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 ();
- gtk_selection_data_free (seldata);
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);
-void
-nxatoms_of_pgtkselect (void)
+ 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
@@ -592,41 +1872,89 @@ syms_of_pgtkselect (void)
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 (Qforeign_selection, "foreign-selection");
+ DEFSYM (QNULL, "NULL");
+ DEFSYM (QATOM, "ATOM");
+ DEFSYM (QTARGETS, "TARGETS");
DEFSYM (QUTF8_STRING, "UTF8_STRING");
- DEFSYM (QSTRING, "STRING");
DEFSYM (QCOMPOUND_TEXT, "COMPOUND_TEXT");
- DEFSYM (Qtext_plain_charset_utf_8, "text/plain;charset=utf-8");
+
+ 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);
-
-#if 0
- Vselection_alist = Qnil;
- staticpro (&Vselection_alist);
-#endif
+ 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,
- "A list of functions to be called when Emacs answers a selection request.\n\
-The functions are called with four arguments:\n\
- - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
- - the selection-type which Emacs was asked to convert the\n\
- selection into before sending (for example, `STRING' or `LENGTH');\n\
- - a flag indicating success or failure for responding to the request.\n\
-We might have failed (and declined the request) for any number of reasons,\n\
-including being asked for a selection that we no longer own, or being asked\n\
-to convert into a type that we don't know about or that is inappropriate.\n\
-This hook doesn't let you change the behavior of Emacs's selection replies,\n\
-it merely informs you that they have happened.");
+ doc: /* A list of functions to be called when Emacs answers a selection request
+The functions are called with four arguments:
+ - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
+ - the selection-type which Emacs was asked to convert the
+ selection into before sending (for example, `STRING' or `LENGTH');
+ - a flag indicating success or failure for responding to the request.
+We might have failed (and declined the request) for any number of reasons,
+including being asked for a selection that we no longer own, or being asked
+to convert into a type that we don't know about or that is inappropriate.
+This hook doesn't let you change the behavior of Emacs's selection replies,
+it merely informs you that they have happened. */);
Vpgtk_sent_selection_hooks = Qnil;
- DEFVAR_BOOL ("pgtk-enable-selection-on-multi-display", pgtk_enable_selection_on_multi_display,
- doc: /* Enable selection on multi display environment.
-This may cause crash. */);
- pgtk_enable_selection_on_multi_display = false;
+ 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/pgtkselect.h b/src/pgtkselect.h
deleted file mode 100644
index 0509c83bdec..00000000000
--- a/src/pgtkselect.h
+++ /dev/null
@@ -1,33 +0,0 @@
-/* Definitions and headers for selection of pure Gtk+3.
- Copyright (C) 1989, 1993, 2005, 2008-2022 Free Software Foundation,
- Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software: you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation, either version 3 of the License, or (at
-your option) any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
-
-
-#include "dispextern.h"
-#include "frame.h"
-
-#ifdef HAVE_PGTK
-
-#include <gtk/gtk.h>
-
-extern void pgtk_selection_init (void);
-extern void pgtk_selection_lost (GtkWidget * widget,
- GdkEventSelection * event,
- gpointer user_data);
-
-#endif /* HAVE_PGTK */
diff --git a/src/pgtkterm.c b/src/pgtkterm.c
index 1d301d11f6f..b283cef7cde 100644
--- a/src/pgtkterm.c
+++ b/src/pgtkterm.c
@@ -1,4 +1,4 @@
-/* Pure Gtk+-3 communication module. -*- coding: utf-8 -*-
+/* Communication module for window systems using GTK.
Copyright (C) 1989, 1993-1994, 2005-2006, 2008-2022 Free Software
Foundation, Inc.
@@ -36,6 +36,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <c-strcase.h>
#include <ftoastr.h>
+#include <dlfcn.h>
+
#include "lisp.h"
#include "blockinput.h"
#include "frame.h"
@@ -47,7 +49,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "fontset.h"
#include "composite.h"
#include "ccl.h"
-#include "dynlib.h"
#include "termhooks.h"
#include "termopts.h"
@@ -60,58 +61,223 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "buffer.h"
#include "font.h"
#include "xsettings.h"
-#include "pgtkselect.h"
#include "emacsgtkfixed.h"
#ifdef GDK_WINDOWING_WAYLAND
#include <gdk/gdkwayland.h>
#endif
-#define STORE_KEYSYM_FOR_DEBUG(keysym) ((void)0)
-
-#define FRAME_CR_CONTEXT(f) ((f)->output_data.pgtk->cr_context)
+#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)))
+#define FRAME_CR_SURFACE(f) (cairo_get_target (FRAME_CR_CONTEXT (f)))
/* Non-zero means that a HELP_EVENT has been generated since Emacs
start. */
static bool any_help_event_p;
-struct pgtk_display_info *x_display_list; /* Chain of existing displays */
-extern Lisp_Object tip_frame;
+/* Chain of existing displays */
+struct pgtk_display_info *x_display_list;
-static struct event_queue_t
+struct event_queue_t
{
union buffered_input_event *q;
int nr, cap;
-} event_q = {
- NULL, 0, 0,
};
+/* 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;
-static void pgtk_delete_display (struct pgtk_display_info *dpyinfo);
-static void pgtk_clear_frame_area (struct frame *f, int x, int y, int width,
- int height);
-static void pgtk_fill_rectangle (struct frame *f, unsigned long color, int x,
- int y, int width, int height);
-static void pgtk_clip_to_row (struct window *w, struct glyph_row *row,
- enum glyph_row_area area, cairo_t * cr);
-static struct frame *pgtk_any_window_to_frame (GdkWindow * window);
-
-/*
- * This is not a flip context in the same sense as gpu rendering
- * scences, 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
- */
+/* 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)
@@ -122,8 +288,9 @@ flip_cr_context (struct frame *f)
if (cr != FRAME_CR_CONTEXT (f))
{
cairo_destroy (cr);
- FRAME_CR_ACTIVE_CONTEXT (f) = cairo_reference (FRAME_CR_CONTEXT (f));
+ FRAME_CR_ACTIVE_CONTEXT (f)
+ = cairo_reference (FRAME_CR_CONTEXT (f));
}
unblock_input ();
}
@@ -133,6 +300,9 @@ 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;
@@ -146,6 +316,27 @@ evq_enqueue (union buffered_input_event *ev)
}
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);
}
@@ -153,18 +344,35 @@ static int
evq_flush (struct input_event *hold_quit)
{
struct event_queue_t *evq = &event_q;
- int i, n = evq->nr;
- for (i = 0; i < n; i++)
- kbd_buffer_store_buffered_event (&evq->q[i], hold_quit);
- evq->nr = 0;
+ 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];
@@ -172,19 +380,22 @@ mark_pgtkterm (void)
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)
-/* --------------------------------------------------------------------------
- Called by keyboard.c. Not sure if the return val is important, except
- that it be unique.
- -------------------------------------------------------------------------- */
{
- static char value[16];
- sprintf (value, "%d", keysym);
- return value;
+ return gdk_keyval_name (keysym);
}
void
@@ -234,7 +445,7 @@ pgtk_frame_raise_lower (struct frame *f, bool raise_flag)
/* Free X resources of frame F. */
void
-x_free_frame_resources (struct frame *f)
+pgtk_free_frame_resources (struct frame *f)
{
struct pgtk_display_info *dpyinfo;
Mouse_HLInfo *hlinfo;
@@ -335,7 +546,7 @@ x_free_frame_resources (struct frame *f)
}
void
-x_destroy_window (struct frame *f)
+pgtk_destroy_window (struct frame *f)
/* --------------------------------------------------------------------------
External: Delete the window
-------------------------------------------------------------------------- */
@@ -344,7 +555,7 @@ x_destroy_window (struct frame *f)
check_window_system (f);
if (dpyinfo->gdpy != NULL)
- x_free_frame_resources (f);
+ pgtk_free_frame_resources (f);
dpyinfo->reference_count--;
}
@@ -353,7 +564,7 @@ x_destroy_window (struct frame *f)
from its current recorded position values and gravity. */
static void
-x_calc_absolute_position (struct frame *f)
+pgtk_calc_absolute_position (struct frame *f)
{
int flags = f->size_hint_flags;
struct frame *p = FRAME_PARENT_FRAME (f);
@@ -387,7 +598,7 @@ x_calc_absolute_position (struct frame *f)
f->left_pos = (FRAME_PIXEL_WIDTH (p) - width - 2 * f->border_width
+ f->left_pos);
else
- f->left_pos = (x_display_pixel_width (FRAME_DISPLAY_INFO (f))
+ f->left_pos = (pgtk_display_pixel_width (FRAME_DISPLAY_INFO (f))
- width + f->left_pos);
}
@@ -413,7 +624,7 @@ x_calc_absolute_position (struct frame *f)
f->top_pos = (FRAME_PIXEL_HEIGHT (p) - height - 2 * f->border_width
+ f->top_pos);
else
- f->top_pos = (x_display_pixel_height (FRAME_DISPLAY_INFO (f))
+ f->top_pos = (pgtk_display_pixel_height (FRAME_DISPLAY_INFO (f))
- height + f->top_pos);
}
@@ -430,13 +641,8 @@ 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, int xoff, int yoff, int change_gravity)
-/* --------------------------------------------------------------------------
- External: Position the window
- -------------------------------------------------------------------------- */
+pgtk_set_offset (struct frame *f, int xoff, int yoff, int change_gravity)
{
- int modified_top, modified_left;
-
if (change_gravity > 0)
{
f->top_pos = yoff;
@@ -449,49 +655,26 @@ x_set_offset (struct frame *f, int xoff, int yoff, int change_gravity)
f->win_gravity = NorthWestGravity;
}
- x_calc_absolute_position (f);
+ pgtk_calc_absolute_position (f);
block_input ();
- x_wm_set_size_hint (f, 0, false);
+ xg_wm_set_size_hint (f, 0, false);
- if (x_gtk_use_window_move)
+ if (change_gravity != 0)
{
- 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
{
- 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);
- }
+ 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;
}
-
- modified_left = f->left_pos;
- modified_top = f->top_pos;
-
- if (FRAME_GTK_OUTER_WIDGET (f))
- {
- gtk_window_move (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
- modified_left, modified_top);
- }
- else
- {
- GtkWidget *fixed = FRAME_GTK_WIDGET (f);
- GtkWidget *parent = gtk_widget_get_parent (fixed);
- gtk_fixed_move (GTK_FIXED (parent), fixed,
- modified_left, modified_top);
- }
-
unblock_input ();
+ return;
}
static void
@@ -510,31 +693,8 @@ pgtk_set_window_size (struct frame *f, bool change_gravity,
gtk_widget_get_size_request (FRAME_GTK_WIDGET (f), &pixelwidth,
&pixelheight);
-#if 0
- if (pixelwise)
- {
- pixelwidth = FRAME_TEXT_TO_PIXEL_WIDTH (f, width);
- pixelheight = FRAME_TEXT_TO_PIXEL_HEIGHT (f, height);
- }
- else
- {
- pixelwidth = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, width);
- pixelheight = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, height);
- }
-#else
pixelwidth = width;
pixelheight = height;
-#endif
-
-#if 0
- frame_size_history_add
- (f, Qx_set_window_size_1, width, height,
- list5 (Fcons (make_fixnum (pixelwidth), make_fixnum (pixelheight)),
- Fcons (make_fixnum (pixelwidth), make_fixnum (pixelheight)),
- make_fixnum (f->border_width),
- make_fixnum (FRAME_PGTK_TITLEBAR_HEIGHT (f)),
- make_fixnum (FRAME_TOOLBAR_HEIGHT (f))));
-#endif
for (GtkWidget * w = FRAME_GTK_WIDGET (f); w != NULL;
w = gtk_widget_get_parent (w))
@@ -545,7 +705,7 @@ pgtk_set_window_size (struct frame *f, bool change_gravity,
f->output_data.pgtk->preferred_width = pixelwidth;
f->output_data.pgtk->preferred_height = pixelheight;
- x_wm_set_size_hint (f, 0, 0);
+ xg_wm_set_size_hint (f, 0, 0);
xg_frame_set_char_size (f, pixelwidth, pixelheight);
gtk_widget_queue_resize (FRAME_WIDGET (f));
@@ -567,10 +727,6 @@ pgtk_iconify_frame (struct frame *f)
block_input ();
-#if 0
- x_set_bitmap_icon (f);
-#endif
-
if (FRAME_GTK_OUTER_WIDGET (f))
{
if (!FRAME_VISIBLE_P (f))
@@ -585,20 +741,8 @@ pgtk_iconify_frame (struct frame *f)
/* 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)
-#if 0
- && !FRAME_X_EMBEDDED_P (f)
-#endif
- )
- x_set_offset (f, f->left_pos, f->top_pos, 0);
-
-#if 0
- if (!FRAME_VISIBLE_P (f))
- {
- /* If the frame was withdrawn, before, we must map it. */
- XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
- }
-#endif
+ 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);
@@ -607,8 +751,8 @@ pgtk_iconify_frame (struct frame *f)
}
static gboolean
-pgtk_make_frame_visible_wait_for_map_event_cb (GtkWidget * widget,
- GdkEventAny * event,
+pgtk_make_frame_visible_wait_for_map_event_cb (GtkWidget *widget,
+ GdkEventAny *event,
gpointer user_data)
{
int *foundptr = user_data;
@@ -629,19 +773,19 @@ 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);
+ 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);
+ 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)
{
@@ -655,6 +799,7 @@ pgtk_wait_for_map_event (struct frame *f, bool multiple_times)
}
g_signal_handler_disconnect (FRAME_WIDGET (f), id);
+
if (!timed_out)
g_source_remove (src);
}
@@ -662,9 +807,6 @@ pgtk_wait_for_map_event (struct frame *f, bool multiple_times)
void
pgtk_make_frame_visible (struct frame *f)
-/* --------------------------------------------------------------------------
- External: Show the window (X11 semantics)
- -------------------------------------------------------------------------- */
{
GtkWidget *win = FRAME_GTK_OUTER_WIDGET (f);
@@ -681,17 +823,11 @@ pgtk_make_frame_visible (struct frame *f)
void
pgtk_make_frame_invisible (struct frame *f)
-/* --------------------------------------------------------------------------
- External: Hide the window (X11 semantics)
- -------------------------------------------------------------------------- */
{
gtk_widget_hide (FRAME_WIDGET (f));
- /* Map events are emitted many times, and
- * map_event() do SET_FRAME_VISIBLE(f, 1).
- * I expect visible = 0, so process those map events here and
- * SET_FRAME_VISIBLE(f, 0) after that.
- */
+ /* 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);
@@ -770,45 +906,26 @@ pgtk_new_font (struct frame *f, Lisp_Object font_object, int fontset)
}
int
-x_display_pixel_height (struct pgtk_display_info *dpyinfo)
+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
-x_display_pixel_width (struct pgtk_display_info *dpyinfo)
+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
-x_set_parent_frame (struct frame *f, Lisp_Object new_value,
- Lisp_Object old_value)
-/* --------------------------------------------------------------------------
- Set frame F's `parent-frame' parameter. If non-nil, make F a child
- frame of the frame specified by that parameter. Technically, this
- makes F's window-system window a child window of the parent frame's
- window-system window. If nil, make F's window-system window a
- top-level window--a child of its display's root window.
-
- A child frame's `left' and `top' parameters specify positions
- relative to the top-left corner of its parent frame's native
- rectangle. On macOS moving a parent frame moves all its child
- frames too, keeping their position relative to the parent
- unaltered. When a parent frame is iconified or made invisible, its
- child frames are made invisible. When a parent frame is deleted,
- its child frames are deleted too.
-
- Whether a child frame has a tool bar may be window-system or window
- manager dependent. It's advisable to disable it via the frame
- parameter settings.
-
- Some window managers may not honor this parameter.
- -------------------------------------------------------------------------- */
+pgtk_set_parent_frame (struct frame *f, Lisp_Object new_value,
+ Lisp_Object old_value)
{
struct frame *p = NULL;
@@ -848,7 +965,8 @@ x_set_parent_frame (struct frame *f, Lisp_Object new_value,
{
GtkWidget *whbox_of_f = gtk_widget_get_parent (fixed);
- /* Here, unhighlight can be called and may change border_color_css_provider. */
+ /* 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))
@@ -869,10 +987,11 @@ x_set_parent_frame (struct frame *f, Lisp_Object new_value,
{
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);
+ gtk_box_pack_start (GTK_BOX (f->output_data.pgtk->hbox_widget),
+ fixed, TRUE, TRUE, 0);
f->output_data.pgtk->preferred_width = alloc.width;
f->output_data.pgtk->preferred_height = alloc.height;
- x_wm_set_size_hint (f, 0, 0);
+ xg_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));
@@ -903,34 +1022,17 @@ x_set_parent_frame (struct frame *f, Lisp_Object new_value,
g_object_unref (fixed);
- if (FRAME_GTK_OUTER_WIDGET (f))
- {
- if (EQ (x_gtk_resize_child_frames, Qresize_mode))
- gtk_container_set_resize_mode
- (GTK_CONTAINER (FRAME_GTK_OUTER_WIDGET (f)),
- p ? GTK_RESIZE_IMMEDIATE : GTK_RESIZE_QUEUE);
- }
-
unblock_input ();
fset_parent_frame (f, new_value);
}
}
-
+/* Doesn't work on wayland. */
void
-x_set_no_focus_on_map (struct frame *f, Lisp_Object new_value,
- Lisp_Object old_value)
-/* Set frame F's `no-focus-on-map' parameter which, if non-nil, means
- * that F's window-system window does not want to receive input focus
- * when it is mapped. (A frame's window is mapped when the frame is
- * displayed for the first time and when the frame changes its state
- * from `iconified' or `invisible' to `visible'.)
- *
- * Some window managers may not honor this parameter. */
+pgtk_set_no_focus_on_map (struct frame *f, Lisp_Object new_value,
+ Lisp_Object old_value)
{
- /* doesn't work on wayland. */
-
if (!EQ (new_value, old_value))
{
xg_set_no_focus_on_map (f, new_value);
@@ -939,36 +1041,16 @@ x_set_no_focus_on_map (struct frame *f, Lisp_Object new_value,
}
void
-x_set_no_accept_focus (struct frame *f, Lisp_Object new_value,
- Lisp_Object old_value)
-/* Set frame F's `no-accept-focus' parameter which, if non-nil, hints
- * that F's window-system window does not want to receive input focus
- * via mouse clicks or by moving the mouse into it.
- *
- * If non-nil, this may have the unwanted side-effect that a user cannot
- * scroll a non-selected frame with the mouse.
- *
- * Some window managers may not honor this parameter. */
+pgtk_set_no_accept_focus (struct frame *f, Lisp_Object new_value,
+ Lisp_Object old_value)
{
- /* doesn't work on wayland. */
-
xg_set_no_accept_focus (f, new_value);
FRAME_NO_ACCEPT_FOCUS (f) = !NILP (new_value);
}
void
-x_set_z_group (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
-/* Set frame F's `z-group' parameter. If `above', F's window-system
- window is displayed above all windows that do not have the `above'
- property set. If nil, F's window is shown below all windows that
- have the `above' property set and above all windows that have the
- `below' property set. If `below', F's window is displayed below
- all windows that do.
-
- Some window managers may not honor this parameter. */
+pgtk_set_z_group (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
{
- /* doesn't work on wayland. */
-
if (!FRAME_GTK_OUTER_WIDGET (f))
return;
@@ -1029,7 +1111,7 @@ pgtk_initialize_display_info (struct pgtk_display_info *dpyinfo)
face. */
static void
-x_set_cursor_gc (struct glyph_string *s)
+pgtk_set_cursor_gc (struct glyph_string *s)
{
if (s->font == FRAME_FONT (s->f)
&& s->face->background == FRAME_BACKGROUND_PIXEL (s->f)
@@ -1067,7 +1149,7 @@ x_set_cursor_gc (struct glyph_string *s)
/* Set up S->gc of glyph string S for drawing text in mouse face. */
static void
-x_set_mouse_face_gc (struct glyph_string *s)
+pgtk_set_mouse_face_gc (struct glyph_string *s)
{
prepare_face_for_display (s->f, s->face);
@@ -1096,7 +1178,7 @@ x_set_mouse_face_gc (struct glyph_string *s)
matrix was built, so there isn't much to do, here. */
static void
-x_set_mode_line_face_gc (struct glyph_string *s)
+pgtk_set_mode_line_face_gc (struct glyph_string *s)
{
s->xgcv.foreground = s->face->foreground;
s->xgcv.background = s->face->background;
@@ -1108,7 +1190,7 @@ x_set_mode_line_face_gc (struct glyph_string *s)
pattern. */
static void
-x_set_glyph_string_gc (struct glyph_string *s)
+pgtk_set_glyph_string_gc (struct glyph_string *s)
{
prepare_face_for_display (s->f, s->face);
@@ -1120,17 +1202,17 @@ x_set_glyph_string_gc (struct glyph_string *s)
}
else if (s->hl == DRAW_INVERSE_VIDEO)
{
- x_set_mode_line_face_gc (s);
+ pgtk_set_mode_line_face_gc (s);
s->stippled_p = s->face->stipple != 0;
}
else if (s->hl == DRAW_CURSOR)
{
- x_set_cursor_gc (s);
+ pgtk_set_cursor_gc (s);
s->stippled_p = false;
}
else if (s->hl == DRAW_MOUSE_FACE)
{
- x_set_mouse_face_gc (s);
+ 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)
@@ -1148,7 +1230,7 @@ x_set_glyph_string_gc (struct glyph_string *s)
line or menu if we don't have X toolkit support. */
static void
-x_set_glyph_string_clipping (struct glyph_string *s, cairo_t * cr)
+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);
@@ -1163,14 +1245,13 @@ x_set_glyph_string_clipping (struct glyph_string *s, cairo_t * 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
-x_set_glyph_string_clipping_exactly (struct glyph_string *src,
- struct glyph_string *dst, cairo_t * cr)
+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;
@@ -1182,7 +1263,6 @@ x_set_glyph_string_clipping_exactly (struct glyph_string *src,
cairo_clip (cr);
}
-
/* RIF:
Compute left and right overhang of glyph string S. */
@@ -1223,16 +1303,17 @@ pgtk_compute_glyph_string_overhangs (struct glyph_string *s)
}
}
-
-/* Fill rectangle X, Y, W, H with background color of glyph string S. */
-
+/* Fill rectangle X, Y, W, H with background color of glyph string
+ S. */
static void
-x_clear_glyph_string_rect (struct glyph_string *s, int x, int y, int w, int h)
+pgtk_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);
+ 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)
@@ -1274,9 +1355,8 @@ fill_background (struct glyph_string *s, int x, int y, int width, int height)
background even if it wouldn't be drawn normally. This is used
when a string preceding S draws into the background of S, or S
contains the first component of a composition. */
-
static void
-x_draw_glyph_string_background (struct glyph_string *s, bool force_p)
+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. */
@@ -1287,9 +1367,7 @@ x_draw_glyph_string_background (struct glyph_string *s, bool force_p)
if (s->stippled_p)
{
/* Fill background with a stipple pattern. */
-
- fill_background (s,
- s->x, s->y + box_line_width,
+ fill_background (s, s->x, s->y + box_line_width,
s->background_width,
s->height - 2 * box_line_width);
s->background_filled_p = true;
@@ -1303,9 +1381,9 @@ x_draw_glyph_string_background (struct glyph_string *s, bool force_p)
|| s->font_not_found_p
|| s->extends_to_end_of_line_p || force_p)
{
- x_clear_glyph_string_rect (s, s->x, s->y + box_line_width,
- s->background_width,
- s->height - 2 * box_line_width);
+ 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;
}
}
@@ -1314,12 +1392,12 @@ x_draw_glyph_string_background (struct glyph_string *s, bool force_p)
static void
pgtk_draw_rectangle (struct frame *f, unsigned long color, int x, int y,
- int width, int height)
+ 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);
+ 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);
@@ -1327,9 +1405,8 @@ pgtk_draw_rectangle (struct frame *f, unsigned long color, int x, int y,
}
/* Draw the foreground of glyph string S. */
-
static void
-x_draw_glyph_string_foreground (struct glyph_string *s)
+pgtk_draw_glyph_string_foreground (struct glyph_string *s)
{
int i, x;
@@ -1349,7 +1426,8 @@ x_draw_glyph_string_foreground (struct glyph_string *s)
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);
+ g->pixel_width - 1, s->height - 1,
+ false);
x += g->pixel_width;
}
}
@@ -1373,9 +1451,8 @@ x_draw_glyph_string_foreground (struct glyph_string *s)
}
/* Draw the foreground of composite glyph string S. */
-
static void
-x_draw_composite_glyph_string_foreground (struct glyph_string *s)
+pgtk_draw_composite_glyph_string_foreground (struct glyph_string *s)
{
int i, j, x;
struct font *font = s->font;
@@ -1399,7 +1476,7 @@ x_draw_composite_glyph_string_foreground (struct glyph_string *s)
{
if (s->cmp_from == 0)
pgtk_draw_rectangle (s->f, s->face->foreground, x, s->y,
- s->width - 1, s->height - 1);
+ s->width - 1, s->height - 1, false);
}
else if (!s->first_glyph->u.cmp.automatic)
{
@@ -1464,9 +1541,8 @@ x_draw_composite_glyph_string_foreground (struct glyph_string *s)
/* Draw the foreground of glyph string S for glyphless characters. */
-
static void
-x_draw_glyphless_glyph_string_foreground (struct glyph_string *s)
+pgtk_draw_glyphless_glyph_string_foreground (struct glyph_string *s)
{
struct glyph *glyph = s->first_glyph;
unsigned char2b[8];
@@ -1541,9 +1617,14 @@ x_draw_glyphless_glyph_string_foreground (struct glyph_string *s)
pgtk_draw_rectangle (s->f, s->face->foreground,
x, s->ybase - glyph->ascent,
glyph->pixel_width - 1,
- glyph->ascent + glyph->descent - 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
@@ -1560,20 +1641,18 @@ x_draw_glyphless_glyph_string_foreground (struct glyph_string *s)
#define HIGHLIGHT_COLOR_DARK_BOOST_LIMIT 48000
-/* Allocate a color which is lighter or darker than *PIXEL by FACTOR
- or DELTA. Try a color with RGB values multiplied by FACTOR first.
- If this produces the same color as PIXEL, try a color where all RGB
- values have DELTA added. Return the allocated color in *PIXEL.
- DISPLAY is the X display, CMAP is the colormap to operate on.
- Value is non-zero if successful. */
+/* 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 bool
-x_alloc_lighter_color (struct frame *f, unsigned long *pixel, double factor,
- int delta)
+static void
+pgtk_compute_lighter_color (struct frame *f, unsigned long *pixel,
+ double factor, int delta)
{
Emacs_Color color, new;
long bright;
- bool success_p;
/* Get RGB color values. */
color.pixel = *pixel;
@@ -1613,38 +1692,33 @@ x_alloc_lighter_color (struct frame *f, unsigned long *pixel, double factor,
}
}
- /* Try to allocate the color. */
- new.pixel = new.red >> 8 << 16 | new.green >> 8 << 8 | new.blue >> 8;
- success_p = true;
- if (success_p)
+ new.pixel = (new.red >> 8 << 16
+ | new.green >> 8 << 8
+ | new.blue >> 8);
+
+ if (new.pixel == *pixel)
{
- if (new.pixel == *pixel)
- {
- /* If we end up with the same color as before, try adding
- delta to the RGB values. */
- new.red = min (0xffff, delta + color.red);
- new.green = min (0xffff, delta + color.green);
- new.blue = min (0xffff, delta + color.blue);
- new.pixel =
- new.red >> 8 << 16 | new.green >> 8 << 8 | new.blue >> 8;
- success_p = true;
- }
- else
- success_p = true;
- *pixel = new.pixel;
+ /* 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);
}
- return success_p;
+ *pixel = new.pixel;
}
static void
-x_fill_trapezoid_for_relief (struct frame *f, unsigned long color, int x,
- int y, int width, int height, int top_p)
+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);
+ 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);
@@ -1663,15 +1737,15 @@ enum corners
};
static void
-x_erase_corners_for_relief (struct frame *f, unsigned long color, int x,
- int y, int width, int height, double radius,
- double margin, int corners)
+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);
+ pgtk_set_cr_source_with_color (f, color, false);
for (i = 0; i < CORNER_LAST; i++)
if (corners & (1 << i))
{
@@ -1695,16 +1769,9 @@ x_erase_corners_for_relief (struct frame *f, unsigned long color, int x,
pgtk_end_cr_clip (f);
}
-/* Set up the foreground color for drawing relief lines of glyph
- string S. RELIEF is a pointer to a struct relief containing the GC
- with which lines will be drawn. Use a color that is FACTOR or
- DELTA lighter or darker than the relief's background which is found
- in S->f->output_data.pgtk->relief_background. If such a color cannot
- be allocated, use DEFAULT_PIXEL, instead. */
-
static void
-x_setup_relief_color (struct frame *f, struct relief *relief, double factor,
- int delta, unsigned long default_pixel)
+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);
@@ -1714,16 +1781,15 @@ x_setup_relief_color (struct frame *f, struct relief *relief, double factor,
/* Allocate new color. */
xgcv.foreground = default_pixel;
pixel = background;
- if (x_alloc_lighter_color (f, &pixel, factor, delta))
- xgcv.foreground = relief->pixel = pixel;
+ 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
-x_setup_relief_colors (struct glyph_string *s)
+pgtk_setup_relief_colors (struct glyph_string *s)
{
struct pgtk_output *di = FRAME_X_OUTPUT (s->f);
unsigned long color;
@@ -1740,30 +1806,27 @@ x_setup_relief_colors (struct glyph_string *s)
color = s->xgcv.background;
}
- if (TRUE)
+ if (!di->relief_background_valid_p
+ || di->relief_background != color)
{
+ di->relief_background_valid_p = true;
di->relief_background = color;
- x_setup_relief_color (s->f, &di->white_relief, 1.2, 0x8000,
- WHITE_PIX_DEFAULT (s->f));
- x_setup_relief_color (s->f, &di->black_relief, 0.6, 0x4000,
- BLACK_PIX_DEFAULT (s->f));
+ 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
-x_set_clip_rectangles (struct frame *f, cairo_t * cr, XRectangle * rectangles,
- int n)
+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_rectangle (cr, rectangles[i].x, rectangles[i].y,
+ rectangles[i].width, rectangles[i].height);
cairo_clip (cr);
}
}
@@ -1777,11 +1840,11 @@ x_set_clip_rectangles (struct frame *f, cairo_t * cr, XRectangle * rectangles,
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)
+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;
@@ -1799,12 +1862,12 @@ x_draw_relief_rect (struct frame *f,
bottom_right_color = FRAME_X_OUTPUT (f)->white_relief.xgcv.foreground;
}
- x_set_clip_rectangles (f, cr, clip_rect, 1);
+ 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);
+ vwidth, bottom_y + 1 - top_y, false);
if (top_p)
corners |= 1 << CORNER_TOP_LEFT;
if (bot_p)
@@ -1813,7 +1876,7 @@ x_draw_relief_rect (struct frame *f,
if (right_p)
{
pgtk_fill_rectangle (f, bottom_right_color, 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)
@@ -1823,34 +1886,32 @@ x_draw_relief_rect (struct frame *f,
{
if (!right_p)
pgtk_fill_rectangle (f, top_left_color, 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_color, left_x, top_y,
- right_x + 1 - left_x, hwidth, 1);
+ 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);
+ hwidth, false);
else
- x_fill_trapezoid_for_relief (f, bottom_right_color,
- left_x, bottom_y + 1 - hwidth,
- right_x + 1 - left_x, hwidth, 0);
+ 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);
+ 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);
+ right_x + 1 - left_x, 1, false);
if (corners)
- {
- x_erase_corners_for_relief (f, FRAME_BACKGROUND_PIXEL (f), left_x,
- top_y, right_x - left_x + 1,
- bottom_y - top_y + 1, 6, 1, corners);
- }
+ pgtk_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);
}
@@ -1863,10 +1924,10 @@ x_draw_relief_rect (struct frame *f,
rectangle to use when drawing. */
static void
-x_draw_box_rect (struct glyph_string *s,
- int left_x, int top_y, int right_x, int bottom_y, int hwidth,
- int vwidth, bool left_p, bool right_p,
- XRectangle * clip_rect)
+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;
@@ -1875,27 +1936,29 @@ x_draw_box_rect (struct glyph_string *s,
foreground_backup = s->xgcv.foreground;
s->xgcv.foreground = s->face->box_color;
- x_set_clip_rectangles (s->f, cr, clip_rect, 1);
+ 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);
+ 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);
+ 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);
+ 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);
+ bottom_y - top_y + 1, false);
s->xgcv.foreground = foreground_backup;
@@ -1906,7 +1969,7 @@ x_draw_box_rect (struct glyph_string *s,
/* Draw a box around glyph string S. */
static void
-x_draw_glyph_string_box (struct glyph_string *s)
+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;
@@ -1939,33 +2002,27 @@ x_draw_glyph_string_box (struct glyph_string *s)
get_glyph_string_clip_rect (s, &clip_rect);
if (s->face->box == FACE_SIMPLE_BOX)
- x_draw_box_rect (s, left_x, top_y, right_x, bottom_y, hwidth,
- vwidth, left_p, right_p, &clip_rect);
+ pgtk_draw_box_rect (s, left_x, top_y, right_x, bottom_y, hwidth,
+ vwidth, left_p, right_p, &clip_rect);
else
{
- x_setup_relief_colors (s);
- x_draw_relief_rect (s->f, left_x, top_y, right_x, bottom_y, hwidth,
- vwidth, raised_p, true, true, left_p, right_p,
- &clip_rect);
+ 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
-x_get_scale_factor (int *scale_x, int *scale_y)
-{
- *scale_x = *scale_y = 1;
-}
-
-static void
-x_draw_horizontal_wave (struct frame *f, unsigned long color, int x, int y,
- int width, int height, int wave_length)
+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);
+ pgtk_set_cr_source_with_color (f, color, false);
cairo_rectangle (cr, x, y, width, height);
cairo_clip (cr);
@@ -1997,34 +2054,19 @@ x_draw_horizontal_wave (struct frame *f, unsigned long color, int x, int y,
pgtk_end_cr_clip (f);
}
-/*
- Draw a wavy line under S. The wave fills wave_height pixels from y0.
-
- x0 wave_length = 2
- --
- y0 * * * * *
- |* * * * * * * * *
- wave_height = 3 | * * * *
-
-*/
static void
-x_draw_underwave (struct glyph_string *s, unsigned long color)
+pgtk_draw_underwave (struct glyph_string *s, unsigned long color)
{
- /* Adjust for scale/HiDPI. */
- int scale_x, scale_y;
-
- x_get_scale_factor (&scale_x, &scale_y);
-
- int wave_height = 3 * scale_y, wave_length = 2 * scale_x;
+ int wave_height = 3, wave_length = 2;
- x_draw_horizontal_wave (s->f, color, s->x, s->ybase - wave_height + 3,
- s->width, wave_height, wave_length);
+ 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
-x_draw_image_relief (struct glyph_string *s)
+pgtk_draw_image_relief (struct glyph_string *s)
{
int x1, y1, thick;
bool raised_p, top_p, bot_p, left_p, right_p;
@@ -2107,33 +2149,29 @@ x_draw_image_relief (struct glyph_string *s)
if (s->slice.y + s->slice.height == s->img->height)
y1 += thick + extra_y, bot_p = true;
- x_setup_relief_colors (s);
+ pgtk_setup_relief_colors (s);
get_glyph_string_clip_rect (s, &r);
- x_draw_relief_rect (s->f, x, y, x1, y1, thick, thick, raised_p,
- top_p, bot_p, left_p, right_p, &r);
+ 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
-x_draw_glyph_string_bg_rect (struct glyph_string *s, int x, int y, int w,
- int h)
+pgtk_draw_glyph_string_bg_rect (struct glyph_string *s, int x, int y, int w,
+ int h)
{
if (s->stippled_p)
- {
- /* Fill background with a stipple pattern. */
-
- fill_background (s, x, y, w, h);
- }
+ fill_background (s, x, y, w, h);
else
- x_clear_glyph_string_rect (s, x, y, w, h);
+ pgtk_clear_glyph_string_rect (s, x, y, w, h);
}
static void
-x_cr_draw_image (struct frame *f, Emacs_GC *gc, cairo_pattern_t *image,
- int src_x, int src_y, int width, int height,
- int dest_x, int dest_y, bool overlay_p)
+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);
@@ -2141,7 +2179,7 @@ x_cr_draw_image (struct frame *f, Emacs_GC *gc, cairo_pattern_t *image,
cairo_rectangle (cr, dest_x, dest_y, width, height);
else
{
- pgtk_set_cr_source_with_gc_background (f, gc);
+ pgtk_set_cr_source_with_gc_background (f, gc, false);
cairo_rectangle (cr, dest_x, dest_y, width, height);
cairo_fill_preserve (cr);
}
@@ -2158,7 +2196,7 @@ x_cr_draw_image (struct frame *f, Emacs_GC *gc, cairo_pattern_t *image,
}
else
{
- pgtk_set_cr_source_with_gc_foreground (f, gc);
+ pgtk_set_cr_source_with_gc_foreground (f, gc, false);
cairo_clip (cr);
cairo_mask (cr, image);
}
@@ -2169,7 +2207,7 @@ x_cr_draw_image (struct frame *f, Emacs_GC *gc, cairo_pattern_t *image,
/* Draw foreground of image glyph string S. */
static void
-x_draw_image_foreground (struct glyph_string *s)
+pgtk_draw_image_foreground (struct glyph_string *s)
{
int x = s->x;
int y = s->ybase - image_ascent (s->img, s->face, &s->slice);
@@ -2191,10 +2229,10 @@ x_draw_image_foreground (struct glyph_string *s)
if (s->img->cr_data)
{
cairo_t *cr = pgtk_begin_cr_clip (s->f);
- x_set_glyph_string_clipping (s, cr);
- x_cr_draw_image (s->f, &s->xgcv, s->img->cr_data,
- s->slice.x, s->slice.y, s->slice.width, s->slice.height,
- x, y, true);
+ 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
@@ -2206,9 +2244,9 @@ x_draw_image_foreground (struct glyph_string *s)
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);
+ 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);
@@ -2216,7 +2254,7 @@ x_draw_image_foreground (struct glyph_string *s)
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);
+ s->slice.width - 1, s->slice.height - 1, false);
}
/* Draw image glyph string S.
@@ -2234,7 +2272,7 @@ x_draw_image_foreground (struct glyph_string *s)
*/
static void
-x_draw_image_glyph_string (struct glyph_string *s)
+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);
@@ -2257,41 +2295,39 @@ x_draw_image_glyph_string (struct glyph_string *s)
|| s->img->pixmap == 0
|| s->width != s->background_width)
{
- {
- int x = s->x;
- int y = s->y;
- int 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->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;
+ if (s->slice.y == 0)
+ y += box_line_vwidth;
- x_draw_glyph_string_bg_rect (s, x, y, width, height);
- }
+ pgtk_draw_glyph_string_bg_rect (s, x, y, width, height);
s->background_filled_p = true;
}
/* Draw the foreground. */
- x_draw_image_foreground (s);
+ 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)
- x_draw_image_relief (s);
+ pgtk_draw_image_relief (s);
}
/* Draw stretch glyph string S. */
static void
-x_draw_stretch_glyph_string (struct glyph_string *s)
+pgtk_draw_stretch_glyph_string (struct glyph_string *s)
{
eassert (s->first_glyph->type == STRETCH_GLYPH);
@@ -2327,7 +2363,7 @@ x_draw_stretch_glyph_string (struct glyph_string *s)
x -= width;
/* Draw cursor. */
- x_draw_glyph_string_bg_rect (s, x, s->y, width, s->height);
+ 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)
@@ -2343,7 +2379,7 @@ x_draw_stretch_glyph_string (struct glyph_string *s)
x = s->x;
if (s->row->mouse_face_p && cursor_in_mouse_face_p (s->w))
{
- x_set_mouse_face_gc (s);
+ pgtk_set_mouse_face_gc (s);
color = s->xgcv.foreground;
}
else
@@ -2352,17 +2388,13 @@ x_draw_stretch_glyph_string (struct glyph_string *s)
cairo_t *cr = pgtk_begin_cr_clip (s->f);
get_glyph_string_clip_rect (s, &r);
- x_set_clip_rectangles (s->f, cr, &r, 1);
+ pgtk_set_clip_rectangles (s->f, cr, &r, 1);
if (s->face->stipple)
- {
- /* Fill background with a stipple pattern. */
- fill_background (s, x, y, w, h);
- }
+ fill_background (s, x, y, w, h);
else
- {
- pgtk_fill_rectangle (s->f, color, x, y, w, h);
- }
+ pgtk_fill_rectangle (s->f, color, x, y, w, h,
+ true);
pgtk_end_cr_clip (s->f);
}
@@ -2370,32 +2402,19 @@ x_draw_stretch_glyph_string (struct glyph_string *s)
else if (!s->background_filled_p)
{
int background_width = s->background_width;
- int x = s->x, text_left_x = window_box_left_offset (s->w, TEXT_AREA);
+ int x = s->x, text_left_x = window_box_left (s->w, TEXT_AREA);
/* Don't draw into left fringe or scrollbar area except for
- header line and mode line. */
- if (x < text_left_x && !s->row->mode_line_p)
+ header line and mode line. */
+ if (s->area == TEXT_AREA
+ && x < text_left_x && !s->row->mode_line_p)
{
- int left_x = WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (s->w);
- int right_x = text_left_x;
-
- if (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (s->w))
- left_x += WINDOW_LEFT_FRINGE_WIDTH (s->w);
- else
- right_x -= WINDOW_LEFT_FRINGE_WIDTH (s->w);
-
- /* Adjust X and BACKGROUND_WIDTH to fit inside the space
- between LEFT_X and RIGHT_X. */
- if (x < left_x)
- {
- background_width -= left_x - x;
- x = left_x;
- }
- if (x + background_width > right_x)
- background_width = right_x - x;
+ background_width -= text_left_x - x;
+ x = text_left_x;
}
+
if (background_width > 0)
- x_draw_glyph_string_bg_rect (s, x, s->y, background_width, s->height);
+ pgtk_draw_glyph_string_bg_rect (s, x, s->y, background_width, s->height);
}
s->background_filled_p = true;
@@ -2420,19 +2439,19 @@ pgtk_draw_glyph_string (struct glyph_string *s)
if (next->first_glyph->type != IMAGE_GLYPH)
{
cairo_t *cr = pgtk_begin_cr_clip (next->f);
- x_set_glyph_string_gc (next);
- x_set_glyph_string_clipping (next, cr);
+ pgtk_set_glyph_string_gc (next);
+ pgtk_set_glyph_string_clipping (next, cr);
if (next->first_glyph->type == STRETCH_GLYPH)
- x_draw_stretch_glyph_string (next);
+ pgtk_draw_stretch_glyph_string (next);
else
- x_draw_glyph_string_background (next, true);
+ 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. */
- x_set_glyph_string_gc (s);
+ pgtk_set_glyph_string_gc (s);
cairo_t *cr = pgtk_begin_cr_clip (s->f);
@@ -2444,10 +2463,10 @@ pgtk_draw_glyph_string (struct glyph_string *s)
|| s->first_glyph->type == COMPOSITE_GLYPH))
{
- x_set_glyph_string_clipping (s, cr);
- x_draw_glyph_string_background (s, true);
- x_draw_glyph_string_box (s);
- x_set_glyph_string_clipping (s, cr);
+ 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. */
@@ -2457,14 +2476,14 @@ pgtk_draw_glyph_string (struct glyph_string *s)
/* 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. */
- x_set_glyph_string_clipping_exactly (s, s, cr);
+ pgtk_set_glyph_string_clipping_exactly (s, s, cr);
else
- x_set_glyph_string_clipping (s, cr);
+ pgtk_set_glyph_string_clipping (s, cr);
switch (s->first_glyph->type)
{
case IMAGE_GLYPH:
- x_draw_image_glyph_string (s);
+ pgtk_draw_image_glyph_string (s);
break;
case XWIDGET_GLYPH:
@@ -2472,15 +2491,15 @@ pgtk_draw_glyph_string (struct glyph_string *s)
break;
case STRETCH_GLYPH:
- x_draw_stretch_glyph_string (s);
+ pgtk_draw_stretch_glyph_string (s);
break;
case CHAR_GLYPH:
if (s->for_overlaps)
s->background_filled_p = true;
else
- x_draw_glyph_string_background (s, false);
- x_draw_glyph_string_foreground (s);
+ pgtk_draw_glyph_string_background (s, false);
+ pgtk_draw_glyph_string_foreground (s);
break;
case COMPOSITE_GLYPH:
@@ -2488,16 +2507,16 @@ pgtk_draw_glyph_string (struct glyph_string *s)
&& !s->first_glyph->u.cmp.automatic))
s->background_filled_p = true;
else
- x_draw_glyph_string_background (s, true);
- x_draw_composite_glyph_string_foreground (s);
+ 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
- x_draw_glyph_string_background (s, true);
- x_draw_glyphless_glyph_string_foreground (s);
+ pgtk_draw_glyph_string_background (s, true);
+ pgtk_draw_glyphless_glyph_string_foreground (s);
break;
default:
@@ -2508,7 +2527,7 @@ pgtk_draw_glyph_string (struct glyph_string *s)
{
/* Draw relief if not yet drawn. */
if (!relief_drawn_p && s->face->box != FACE_NO_BOX)
- x_draw_glyph_string_box (s);
+ pgtk_draw_glyph_string_box (s);
/* Draw underline. */
if (s->face->underline)
@@ -2516,19 +2535,21 @@ pgtk_draw_glyph_string (struct glyph_string *s)
if (s->face->underline == FACE_UNDER_WAVE)
{
if (s->face->underline_defaulted_p)
- x_draw_underwave (s, s->xgcv.foreground);
+ pgtk_draw_underwave (s, s->xgcv.foreground);
else
- {
- x_draw_underwave (s, s->face->underline_color);
- }
+ 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
- && 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;
@@ -2543,8 +2564,11 @@ pgtk_draw_glyph_string (struct glyph_string *s)
thickness = font->underline_thickness;
else
thickness = 1;
- if (x_underline_at_descent_line)
- position = (s->height - thickness) - (s->ybase - s->y);
+ 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
@@ -2563,7 +2587,11 @@ pgtk_draw_glyph_string (struct glyph_string *s)
else
position = underline_minimum_offset;
}
- position = max (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. */
@@ -2576,11 +2604,13 @@ pgtk_draw_glyph_string (struct glyph_string *s)
y = s->ybase + position;
if (s->face->underline_defaulted_p)
pgtk_fill_rectangle (s->f, s->xgcv.foreground,
- s->x, y, s->width, thickness);
+ s->x, y, s->width, thickness,
+ false);
else
{
pgtk_fill_rectangle (s->f, s->face->underline_color,
- s->x, y, s->width, thickness);
+ s->x, y, s->width, thickness,
+ false);
}
}
}
@@ -2591,12 +2621,10 @@ pgtk_draw_glyph_string (struct glyph_string *s)
if (s->face->overline_color_defaulted_p)
pgtk_fill_rectangle (s->f, s->xgcv.foreground, s->x, s->y + dy,
- s->width, h);
+ s->width, h, false);
else
- {
- pgtk_fill_rectangle (s->f, s->face->overline_color, s->x,
- s->y + dy, s->width, h);
- }
+ pgtk_fill_rectangle (s->f, s->face->overline_color, s->x,
+ s->y + dy, s->width, h, false);
}
/* Draw strike-through. */
@@ -2616,12 +2644,10 @@ pgtk_draw_glyph_string (struct glyph_string *s)
if (s->face->strike_through_color_defaulted_p)
pgtk_fill_rectangle (s->f, s->xgcv.foreground, s->x, glyph_y + dy,
- s->width, h);
+ s->width, h, false);
else
- {
- pgtk_fill_rectangle (s->f, s->face->strike_through_color, s->x,
- glyph_y + dy, s->width, h);
- }
+ pgtk_fill_rectangle (s->f, s->face->strike_through_color, s->x,
+ glyph_y + dy, s->width, h, false);
}
if (s->prev)
@@ -2637,13 +2663,13 @@ pgtk_draw_glyph_string (struct glyph_string *s)
enum draw_glyphs_face save = prev->hl;
prev->hl = s->hl;
- x_set_glyph_string_gc (prev);
+ pgtk_set_glyph_string_gc (prev);
cairo_save (cr);
- x_set_glyph_string_clipping_exactly (s, prev, cr);
+ pgtk_set_glyph_string_clipping_exactly (s, prev, cr);
if (prev->first_glyph->type == CHAR_GLYPH)
- x_draw_glyph_string_foreground (prev);
+ pgtk_draw_glyph_string_foreground (prev);
else
- x_draw_composite_glyph_string_foreground (prev);
+ pgtk_draw_composite_glyph_string_foreground (prev);
prev->hl = save;
prev->num_clips = 0;
cairo_restore (cr);
@@ -2663,13 +2689,13 @@ pgtk_draw_glyph_string (struct glyph_string *s)
enum draw_glyphs_face save = next->hl;
next->hl = s->hl;
- x_set_glyph_string_gc (next);
+ pgtk_set_glyph_string_gc (next);
cairo_save (cr);
- x_set_glyph_string_clipping_exactly (s, next, cr);
+ pgtk_set_glyph_string_clipping_exactly (s, next, cr);
if (next->first_glyph->type == CHAR_GLYPH)
- x_draw_glyph_string_foreground (next);
+ pgtk_draw_glyph_string_foreground (next);
else
- x_draw_composite_glyph_string_foreground (next);
+ pgtk_draw_composite_glyph_string_foreground (next);
cairo_restore (cr);
next->hl = save;
next->num_clips = 0;
@@ -2678,6 +2704,11 @@ pgtk_draw_glyph_string (struct glyph_string *s)
}
}
+ /* 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;
@@ -2734,7 +2765,7 @@ pgtk_clear_frame_area (struct frame *f, int x, int y, int width, int height)
/* Draw a hollow box cursor on window W in glyph row ROW. */
static void
-x_draw_hollow_cursor (struct window *w, struct glyph_row *row)
+pgtk_draw_hollow_cursor (struct window *w, struct glyph_row *row)
{
struct frame *f = XFRAME (WINDOW_FRAME (w));
int x, y, wd, h;
@@ -2753,7 +2784,7 @@ x_draw_hollow_cursor (struct window *w, struct glyph_row *row)
/* 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);
+ 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
@@ -2767,7 +2798,8 @@ x_draw_hollow_cursor (struct window *w, struct glyph_row *row)
}
/* 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);
+ pgtk_draw_rectangle (f, FRAME_X_OUTPUT (f)->cursor_color,
+ x, y, wd, h - 1, false);
pgtk_end_cr_clip (f);
}
@@ -2779,7 +2811,7 @@ x_draw_hollow_cursor (struct window *w, struct glyph_row *row)
--gerd. */
static void
-x_draw_bar_cursor (struct window *w, struct glyph_row *row, int width,
+pgtk_draw_bar_cursor (struct window *w, struct glyph_row *row, int width,
enum text_cursor_kinds kind)
{
struct frame *f = XFRAME (w->frame);
@@ -2841,7 +2873,7 @@ x_draw_bar_cursor (struct window *w, struct glyph_row *row, int width,
pgtk_fill_rectangle (f, color, x,
WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y),
- width, row->height);
+ width, row->height, false);
}
else /* HBAR_CURSOR */
{
@@ -2862,7 +2894,7 @@ x_draw_bar_cursor (struct window *w, struct glyph_row *row, int width,
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);
+ w->phys_cursor_width - 1, width, false);
}
pgtk_end_cr_clip (f);
@@ -2877,6 +2909,7 @@ pgtk_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, int x,
int cursor_width, bool on_p, bool active_p)
{
struct frame *f = XFRAME (w->frame);
+
if (on_p)
{
w->phys_cursor_type = cursor_type;
@@ -2895,7 +2928,7 @@ pgtk_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, int x,
switch (cursor_type)
{
case HOLLOW_BOX_CURSOR:
- x_draw_hollow_cursor (w, glyph_row);
+ pgtk_draw_hollow_cursor (w, glyph_row);
break;
case FILLED_BOX_CURSOR:
@@ -2903,11 +2936,11 @@ pgtk_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, int x,
break;
case BAR_CURSOR:
- x_draw_bar_cursor (w, glyph_row, cursor_width, BAR_CURSOR);
+ pgtk_draw_bar_cursor (w, glyph_row, cursor_width, BAR_CURSOR);
break;
case HBAR_CURSOR:
- x_draw_bar_cursor (w, glyph_row, cursor_width, HBAR_CURSOR);
+ pgtk_draw_bar_cursor (w, glyph_row, cursor_width, HBAR_CURSOR);
break;
case NO_CURSOR:
@@ -2933,17 +2966,17 @@ pgtk_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, int x,
}
static void
-pgtk_copy_bits (struct frame *f, cairo_rectangle_t * src_rect,
- cairo_rectangle_t * dst_rect)
+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);
+ 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,
@@ -2955,6 +2988,7 @@ pgtk_copy_bits (struct frame *f, cairo_rectangle_t * src_rect,
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);
@@ -3162,10 +3196,9 @@ pgtk_bitmap_icon (struct frame *f, Lisp_Object file)
}
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);
- }
+ 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;
@@ -3216,7 +3249,7 @@ pgtk_draw_vertical_window_border (struct window *w, int x, int y0, int y1)
face = FACE_FROM_ID_OR_NULL (f, VERTICAL_BORDER_FACE_ID);
if (face)
- pgtk_set_cr_source_with_color (f, face->foreground);
+ pgtk_set_cr_source_with_color (f, face->foreground, false);
cairo_rectangle (cr, x, y0, 1, y1 - y0);
cairo_fill (cr);
@@ -3247,32 +3280,32 @@ pgtk_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1)
if (y1 - y0 > x1 - x0 && x1 - x0 > 2)
/* Vertical. */
{
- pgtk_set_cr_source_with_color (f, color_first);
+ 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);
+ 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);
+ 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);
+ 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);
+ 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);
+ 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);
+ pgtk_set_cr_source_with_color (f, color, false);
cairo_rectangle (cr, x0, y0, x1 - x0, y1 - y0);
cairo_fill (cr);
}
@@ -3325,8 +3358,8 @@ pgtk_frame_up_to_date (struct frame *f)
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)
+ 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);
@@ -3335,6 +3368,7 @@ pgtk_mouse_position (struct frame **fp, int insist, Lisp_Object * bar_window,
GdkDevice *device;
GdkModifierType mask;
GdkWindow *win;
+ bool return_frame_flag = false;
block_input ();
@@ -3348,54 +3382,54 @@ pgtk_mouse_position (struct frame **fp, int insist, Lisp_Object * bar_window,
dpyinfo->last_mouse_scroll_bar = NULL;
- if (gui_mouse_grabbed (dpyinfo))
- {
- /* 1.1. use last_mouse_frame as frame where the pointer is on. */
- f1 = dpyinfo->last_mouse_frame;
- }
+ if (gui_mouse_grabbed (dpyinfo)
+ && (!EQ (track_mouse, Qdropping)
+ && !EQ (track_mouse, Qdrag_source)))
+ f1 = dpyinfo->last_mouse_frame;
else
{
f1 = *fp;
- /* 1.2. get frame where the pointer is on. */
win = gtk_widget_get_window (FRAME_GTK_WIDGET (*fp));
seat = gdk_display_get_default_seat (dpyinfo->gdpy);
device = gdk_seat_get_pointer (seat);
- win =
- gdk_window_get_device_position (win, device, &win_x, &win_y, &mask);
+ win = gdk_window_get_device_position (win, device, &win_x,
+ &win_y, &mask);
if (win != NULL)
f1 = pgtk_any_window_to_frame (win);
else
{
- /* crossing display server? */
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 */
+ /* F1 can be a terminal frame. (Bug#50322) */
if (f1 == NULL || !FRAME_PGTK_P (f1))
{
unblock_input ();
return;
}
- /* 2. get the display and the device. */
win = gtk_widget_get_window (FRAME_GTK_WIDGET (f1));
- GdkDisplay *gdpy = gdk_window_get_display (win);
- seat = gdk_display_get_default_seat (gdpy);
+ seat = gdk_display_get_default_seat (dpyinfo->gdpy);
device = gdk_seat_get_pointer (seat);
- /* 3. get x, y relative to edit window of the frame. */
- win = gdk_window_get_device_position (win, device, &win_x, &win_y, &mask);
+ win = gdk_window_get_device_position (win, device,
+ &win_x, &win_y, &mask);
if (f1 != NULL)
{
- dpyinfo = FRAME_DISPLAY_INFO (f1);
- remember_mouse_glyph (f1, win_x, win_y, &dpyinfo->last_mouse_glyph);
+ remember_mouse_glyph (f1, win_x, win_y,
+ &dpyinfo->last_mouse_glyph);
dpyinfo->last_mouse_glyph_frame = f1;
*bar_window = Qnil;
*part = 0;
- *fp = f1;
+ *fp = !return_frame_flag ? f1 : NULL;
XSETINT (*x, win_x);
XSETINT (*y, win_y);
*timestamp = dpyinfo->last_mouse_movement_time;
@@ -3421,10 +3455,10 @@ pgtk_define_fringe_bitmap (int which, unsigned short *bits, int h, int wd)
{
i = max_fringe_bmp;
max_fringe_bmp = which + 20;
- fringe_bmp =
- (cairo_pattern_t **) xrealloc (fringe_bmp,
- max_fringe_bmp *
- sizeof (cairo_pattern_t *));
+ fringe_bmp
+ = (cairo_pattern_t **) xrealloc (fringe_bmp,
+ max_fringe_bmp *
+ sizeof (cairo_pattern_t *));
while (i < max_fringe_bmp)
fringe_bmp[i++] = 0;
}
@@ -3485,41 +3519,6 @@ pgtk_clip_to_row (struct window *w, struct glyph_row *row,
}
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);
- 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);
- cairo_clip (cr);
- cairo_mask (cr, image);
- }
-
- pgtk_end_cr_clip (f);
-}
-
-static void
pgtk_draw_fringe_bitmap (struct window *w, struct glyph_row *row,
struct draw_fringe_bitmap_params *p)
{
@@ -3533,26 +3532,37 @@ pgtk_draw_fringe_bitmap (struct window *w, struct glyph_row *row,
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
+ /* In case the same realized face is used for fringes and for
+ something displayed in the text (e.g. face `region' on
mono-displays, the fill style may have been changed to
- FillSolid in x_draw_glyph_string_background. */
+ FillSolid in pgtk_draw_glyph_string_background. */
if (face->stipple)
- {
- fill_background_by_face (f, face, p->bx, p->by, p->nx, p->ny);
- }
+ fill_background_by_face (f, face, p->bx, p->by, p->nx, p->ny);
else
{
- pgtk_set_cr_source_with_color (f, face->background);
+ 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)
+ 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)
@@ -3571,7 +3581,8 @@ static int hourglass_enter_count = 0;
static void
hourglass_cb (struct atimer *timer)
{
- /*NOP*/}
+
+}
static void
pgtk_show_hourglass (struct frame *f)
@@ -3579,7 +3590,9 @@ pgtk_show_hourglass (struct frame *f)
struct pgtk_output *x = FRAME_X_OUTPUT (f);
if (x->hourglass_widget != NULL)
gtk_widget_destroy (x->hourglass_widget);
- x->hourglass_widget = gtk_event_box_new (); /* gtk_event_box is GDK_INPUT_ONLY. */
+
+ /* 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);
@@ -3588,17 +3601,16 @@ pgtk_show_hourglass (struct frame *f)
gdk_window_set_cursor (gtk_widget_get_window (x->hourglass_widget),
x->hourglass_cursor);
- /* For cursor animation, we receive signals, set pending_signals, and dispatch. */
+ /* 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);
+ hourglass_atimer
+ = start_atimer (ATIMER_CONTINUOUS, ts, hourglass_cb, NULL);
}
-
- /* Cursor frequently stops animation. gtk's bug? */
}
static void
@@ -3659,35 +3671,19 @@ static struct redisplay_interface pgtk_redisplay_interface = {
pgtk_default_font_parameter,
};
-static void
-pgtk_redraw_scroll_bars (struct frame *f)
-{
-}
-
void
pgtk_clear_frame (struct frame *f)
-/* --------------------------------------------------------------------------
- External (hook): Erase the entire frame
- -------------------------------------------------------------------------- */
{
- /* comes on initial frame because we have
- after-make-frame-functions = select-frame */
if (!FRAME_DEFAULT_FACE (f))
return;
- /* mark_window_cursors_off (XWINDOW (FRAME_ROOT_WINDOW (f))); */
+ mark_window_cursors_off (XWINDOW (FRAME_ROOT_WINDOW (f)));
block_input ();
-
pgtk_clear_area (f, 0, 0, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f));
-
- /* as of 2006/11 or so this is now needed */
- pgtk_redraw_scroll_bars (f);
unblock_input ();
}
-/* Invert the middle quarter of the frame for .15 sec. */
-
static void
recover_from_visible_bell (struct atimer *timer)
{
@@ -3703,83 +3699,89 @@ recover_from_visible_bell (struct atimer *timer)
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 ();
- {
- cairo_surface_t *surface_orig = FRAME_CR_SURFACE (f);
+ surface_orig = FRAME_CR_SURFACE (f);
- int width = FRAME_CR_SURFACE_DESIRED_WIDTH (f);
- int height = FRAME_CR_SURFACE_DESIRED_HEIGHT (f);
- cairo_surface_t *surface =
- cairo_surface_create_similar (surface_orig, CAIRO_CONTENT_COLOR_ALPHA,
- width, height);
+ 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);
- cairo_t *cr = cairo_create (surface);
- cairo_set_source_surface (cr, surface_orig, 0, 0);
- cairo_rectangle (cr, 0, 0, width, height);
- cairo_clip (cr);
- cairo_paint (cr);
+ 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);
+ 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
{
- /* Get the height not including a menu bar widget. */
- int height = FRAME_PIXEL_HEIGHT (f);
- /* Height of each line to flash. */
- int flash_height = FRAME_LINE_HEIGHT (f);
- /* These will be the left and right margins of the rectangles. */
- int flash_left = FRAME_INTERNAL_BORDER_WIDTH (f);
- int flash_right =
- FRAME_PIXEL_WIDTH (f) - FRAME_INTERNAL_BORDER_WIDTH (f);
- int width = flash_right - flash_left;
-
- /* If window is tall, flash top and bottom line. */
- if (height > 3 * FRAME_LINE_HEIGHT (f))
- {
- cairo_rectangle (cr,
- flash_left,
- (FRAME_INTERNAL_BORDER_WIDTH (f)
- + FRAME_TOP_MARGIN_HEIGHT (f)),
- width, flash_height);
- cairo_fill (cr);
+ /* 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);
+ }
- 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;
- FRAME_X_OUTPUT (f)->cr_surface_visible_bell = surface;
- {
- struct timespec delay = make_timespec (0, 50 * 1000 * 1000);
- if (FRAME_X_OUTPUT (f)->atimer_visible_bell != NULL)
- {
- cancel_atimer (FRAME_X_OUTPUT (f)->atimer_visible_bell);
- FRAME_X_OUTPUT (f)->atimer_visible_bell = NULL;
- }
- FRAME_X_OUTPUT (f)->atimer_visible_bell =
- start_atimer (ATIMER_RELATIVE, delay, recover_from_visible_bell, f);
- }
+ 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;
}
- cairo_destroy (cr);
- }
+ FRAME_X_OUTPUT (f)->atimer_visible_bell
+ = start_atimer (ATIMER_RELATIVE, delay, recover_from_visible_bell, f);
+
+ cairo_destroy (cr);
unblock_input ();
}
@@ -3861,8 +3863,9 @@ pgtk_send_scroll_bar_event (Lisp_Object window, enum scroll_bar_part part,
EVENT_INIT (inev.ie);
- inev.ie.kind =
- horizontal ? HORIZONTAL_SCROLL_BAR_CLICK_EVENT : SCROLL_BAR_CLICK_EVENT;
+ 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;
@@ -3894,28 +3897,21 @@ xg_scroll_callback (GtkRange * range,
switch (scroll)
{
case GTK_SCROLL_JUMP:
-#if 0
- /* Buttons 1 2 or 3 must be grabbed. */
- if (FRAME_DISPLAY_INFO (f)->grabbed != 0
- && FRAME_DISPLAY_INFO (f)->grabbed < (1 << 4))
-#endif
- {
- 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;
- }
+ 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:
@@ -3977,7 +3973,7 @@ xg_end_scroll_callback (GtkWidget * widget,
and X window of the scroll bar in BAR. */
static void
-x_create_toolkit_scroll_bar (struct frame *f, struct scroll_bar *bar)
+pgtk_create_toolkit_scroll_bar (struct frame *f, struct scroll_bar *bar)
{
const char *scroll_bar_name = SCROLL_BAR_NAME;
@@ -3988,8 +3984,8 @@ x_create_toolkit_scroll_bar (struct frame *f, struct scroll_bar *bar)
}
static void
-x_create_horizontal_toolkit_scroll_bar (struct frame *f,
- struct scroll_bar *bar)
+pgtk_create_horizontal_toolkit_scroll_bar (struct frame *f,
+ struct scroll_bar *bar)
{
const char *scroll_bar_name = SCROLL_BAR_HORIZONTAL_NAME;
@@ -4004,30 +4000,28 @@ x_create_horizontal_toolkit_scroll_bar (struct frame *f,
displaying PORTION out of a whole WHOLE, and our position POSITION. */
static void
-x_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int portion,
- int position, int whole)
+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
-x_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar,
- int portion, int position,
- int whole)
+pgtk_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar,
+ int portion, int position,
+ int whole)
{
xg_set_toolkit_horizontal_scroll_bar_thumb (bar, portion, position, whole);
}
-
-
/* Create a scroll bar and return the scroll bar vector for it. W is
the Emacs window on which to create the scroll bar. TOP, LEFT,
WIDTH and HEIGHT are the pixel coordinates and dimensions of the
scroll bar. */
static struct scroll_bar *
-x_scroll_bar_create (struct window *w, int top, int left,
- int width, int height, bool horizontal)
+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
@@ -4037,9 +4031,9 @@ x_scroll_bar_create (struct window *w, int top, int left,
block_input ();
if (horizontal)
- x_create_horizontal_toolkit_scroll_bar (f, bar);
+ pgtk_create_horizontal_toolkit_scroll_bar (f, bar);
else
- x_create_toolkit_scroll_bar (f, bar);
+ pgtk_create_toolkit_scroll_bar (f, bar);
XSETWINDOW (bar->window, w);
bar->top = top;
@@ -4077,7 +4071,7 @@ x_scroll_bar_create (struct window *w, int top, int left,
nil. */
static void
-x_scroll_bar_remove (struct scroll_bar *bar)
+pgtk_scroll_bar_remove (struct scroll_bar *bar)
{
struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window)));
block_input ();
@@ -4125,7 +4119,7 @@ pgtk_set_vertical_scroll_bar (struct window *w, int portion, int whole,
unblock_input ();
}
- bar = x_scroll_bar_create (w, top, left, width, max (height, 1), false);
+ bar = pgtk_scroll_bar_create (w, top, left, width, max (height, 1), false);
}
else
{
@@ -4165,13 +4159,12 @@ pgtk_set_vertical_scroll_bar (struct window *w, int portion, int whole,
unblock_input ();
}
- x_set_toolkit_scroll_bar_thumb (bar, portion, position, whole);
+ 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)
@@ -4203,7 +4196,7 @@ pgtk_set_horizontal_scroll_bar (struct window *w, int portion, int whole,
unblock_input ();
}
- bar = x_scroll_bar_create (w, top, left, width, height, true);
+ bar = pgtk_scroll_bar_create (w, top, left, width, height, true);
}
else
{
@@ -4246,7 +4239,7 @@ pgtk_set_horizontal_scroll_bar (struct window *w, int portion, int whole,
unblock_input ();
}
- x_set_toolkit_horizontal_scroll_bar_thumb (bar, portion, position, whole);
+ pgtk_set_toolkit_horizontal_scroll_bar_thumb (bar, portion, position, whole);
XSETVECTOR (barobj, bar);
wset_horizontal_scroll_bar (w, barobj);
@@ -4286,7 +4279,6 @@ pgtk_condemn_scroll_bars (struct frame *frame)
}
}
-
/* Un-mark WINDOW's scroll bar for deletion in this judgment cycle.
Note that WINDOW isn't necessarily condemned at all. */
@@ -4390,7 +4382,7 @@ pgtk_judge_scroll_bars (struct frame *f)
{
struct scroll_bar *b = XSCROLL_BAR (bar);
- x_scroll_bar_remove (b);
+ pgtk_scroll_bar_remove (b);
next = b->next;
b->next = b->prev = Qnil;
@@ -4471,15 +4463,22 @@ pgtk_delete_terminal (struct terminal *terminal)
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;
- }
+ 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);
- /* Do not close the connection here because it's already closed
- by X(t)CloseDisplay (Bug#18403). */
dpyinfo->gdpy = NULL;
}
@@ -4503,7 +4502,7 @@ pgtk_query_frame_background_color (struct frame *f, Emacs_Color * bgcolor)
}
static void
-pgtk_free_pixmap (struct frame *_f, Emacs_Pixmap pixmap)
+pgtk_free_pixmap (struct frame *f, Emacs_Pixmap pixmap)
{
if (pixmap)
{
@@ -4527,17 +4526,18 @@ pgtk_focus_frame (struct frame *f, bool noactivate)
}
}
-
static void
-set_opacity_recursively (GtkWidget * w, gpointer data)
+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);
+ gtk_container_foreach (GTK_CONTAINER (w),
+ set_opacity_recursively, data);
}
static void
-x_set_frame_alpha (struct frame *f)
+pgtk_set_frame_alpha (struct frame *f)
{
struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
double alpha = 1.0;
@@ -4561,22 +4561,6 @@ x_set_frame_alpha (struct frame *f)
else if (alpha < alpha_min && alpha_min <= 1.0)
alpha = alpha_min;
-#if 0
- /* 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
- alpha has not changed on the frame. */
-
- if (!FRAME_PARENT_FRAME (f))
- {
- Window 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);
- }
-#endif
-
set_opacity_recursively (FRAME_WIDGET (f), &alpha);
/* without this, blending mode is strange on wayland. */
gtk_widget_queue_resize_no_redraw (FRAME_WIDGET (f));
@@ -4585,22 +4569,13 @@ x_set_frame_alpha (struct frame *f)
static void
frame_highlight (struct frame *f)
{
- /* We used to only do this if Vx_no_window_manager was non-nil, but
- the ICCCM (section 4.1.6) says that the window's border pixmap
- and border pixel are window attributes which are "private to the
- client", so we can always change it to whatever we want. */
block_input ();
- /* I recently started to get errors in this XSetWindowBorder, depending on
- the window-manager in use, tho something more is at play since I've been
- using that same window-manager binary for ever. Let's not crash just
- because of this (bug#9310). */
-
GtkWidget *w = FRAME_WIDGET (f);
- char *css =
- g_strdup_printf ("decoration { border: solid %dpx #%06x; }",
- f->border_width,
- (unsigned int) FRAME_X_OUTPUT (f)->border_pixel & 0x00ffffff);
+ 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 ();
@@ -4619,33 +4594,32 @@ frame_highlight (struct frame *f)
unblock_input ();
gui_update_cursor (f, true);
- x_set_frame_alpha (f);
+ pgtk_set_frame_alpha (f);
}
static void
frame_unhighlight (struct frame *f)
{
- /* We used to only do this if Vx_no_window_manager was non-nil, but
- the ICCCM (section 4.1.6) says that the window's border pixmap
- and border pixel are window attributes which are "private to the
- client", so we can always change it to whatever we want. */
+ GtkWidget *w;
+ char *css;
+ GtkStyleContext *ctxt;
+ GtkCssProvider *css_provider, *old;
+
block_input ();
- /* Same as above for XSetWindowBorder (bug#9310). */
- GtkWidget *w = FRAME_WIDGET (f);
+ w = FRAME_WIDGET (f);
- char *css =
- g_strdup_printf ("decoration { border: dotted %dpx #ffffff; }",
- f->border_width);
+ css = g_strdup_printf ("decoration { border: dotted %dpx #ffffff; }",
+ f->border_width);
- GtkStyleContext *ctxt = gtk_widget_get_style_context (w);
- GtkCssProvider *css_provider = gtk_css_provider_new ();
+ 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);
- GtkCssProvider *old = FRAME_X_OUTPUT (f)->border_color_css_provider;
+ old = FRAME_X_OUTPUT (f)->border_color_css_provider;
FRAME_X_OUTPUT (f)->border_color_css_provider = css_provider;
if (old != NULL)
{
@@ -4655,7 +4629,7 @@ frame_unhighlight (struct frame *f)
unblock_input ();
gui_update_cursor (f, true);
- x_set_frame_alpha (f);
+ pgtk_set_frame_alpha (f);
}
@@ -4694,16 +4668,15 @@ pgtk_frame_rehighlight (struct pgtk_display_info *dpyinfo)
the appropriate X display info. */
static void
-XTframe_rehighlight (struct frame *frame)
+pgtk_frame_rehighlight_hook (struct frame *frame)
{
pgtk_frame_rehighlight (FRAME_DISPLAY_INFO (frame));
}
-
-/* Toggle mouse pointer visibility on frame F by using invisible cursor. */
-
+/* Set whether or not the mouse pointer should be visible on frame
+ F. */
static void
-x_toggle_visible_pointer (struct frame *f, bool invisible)
+pgtk_toggle_invisible_pointer (struct frame *f, bool invisible)
{
Emacs_Cursor cursor;
if (invisible)
@@ -4713,22 +4686,10 @@ x_toggle_visible_pointer (struct frame *f, bool invisible)
gdk_window_set_cursor (gtk_widget_get_window (FRAME_GTK_WIDGET (f)),
cursor);
f->pointer_invisible = invisible;
-}
-static void
-x_setup_pointer_blanking (struct pgtk_display_info *dpyinfo)
-{
- dpyinfo->toggle_visible_pointer = x_toggle_visible_pointer;
- dpyinfo->invisible_cursor =
- gdk_cursor_new_for_display (dpyinfo->gdpy, GDK_BLANK_CURSOR);
-}
-
-static void
-XTtoggle_invisible_pointer (struct frame *f, bool invisible)
-{
- block_input ();
- FRAME_DISPLAY_INFO (f)->toggle_visible_pointer (f, invisible);
- unblock_input ();
+ /* 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
@@ -4738,7 +4699,7 @@ XTtoggle_invisible_pointer (struct frame *f, bool invisible)
Lisp code can tell when the switch took place by examining the events. */
static void
-x_new_focus_frame (struct pgtk_display_info *dpyinfo, struct frame *frame)
+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 */
@@ -4774,9 +4735,6 @@ pgtk_buffer_flipping_unblocked_hook (struct frame *f)
static struct terminal *
pgtk_create_terminal (struct pgtk_display_info *dpyinfo)
-/* --------------------------------------------------------------------------
- Set up use of Gtk before we make the first connection.
- -------------------------------------------------------------------------- */
{
struct terminal *terminal;
@@ -4787,13 +4745,13 @@ pgtk_create_terminal (struct pgtk_display_info *dpyinfo)
terminal->clear_frame_hook = pgtk_clear_frame;
terminal->ring_bell_hook = pgtk_ring_bell;
- terminal->toggle_invisible_pointer_hook = XTtoggle_invisible_pointer;
+ 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 = XTframe_rehighlight;
+ 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;
@@ -4801,14 +4759,14 @@ pgtk_create_terminal (struct pgtk_display_info *dpyinfo)
terminal->menu_show_hook = pgtk_menu_show;
terminal->activate_menubar_hook = pgtk_activate_menubar;
terminal->popup_dialog_hook = pgtk_popup_dialog;
- terminal->change_tab_bar_height_hook = x_change_tab_bar_height;
+ terminal->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 = x_destroy_window;
+ 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;
@@ -4816,16 +4774,17 @@ pgtk_create_terminal (struct pgtk_display_info *dpyinfo)
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_scroll_bar_default_width_hook
+ = pgtk_set_scroll_bar_default_width;
+ terminal->set_scroll_bar_default_height_hook
+ = pgtk_set_scroll_bar_default_height;
terminal->set_window_size_hook = pgtk_set_window_size;
terminal->query_colors = pgtk_query_colors;
- terminal->get_focus_frame = x_get_focus_frame;
+ terminal->get_focus_frame = pgtk_get_focus_frame;
terminal->focus_frame_hook = pgtk_focus_frame;
- terminal->set_frame_offset_hook = x_set_offset;
+ 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. */
@@ -4840,7 +4799,7 @@ struct pgtk_window_is_of_frame_recursive_t
};
static void
-pgtk_window_is_of_frame_recursive (GtkWidget * widget, gpointer data)
+pgtk_window_is_of_frame_recursive (GtkWidget *widget, gpointer data)
{
struct pgtk_window_is_of_frame_recursive_t *datap = data;
@@ -4856,14 +4815,13 @@ pgtk_window_is_of_frame_recursive (GtkWidget * widget, gpointer data)
return;
}
- if (GTK_IS_CONTAINER (widget)) {
+ 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)
+pgtk_window_is_of_frame (struct frame *f, GdkWindow *window)
{
struct pgtk_window_is_of_frame_recursive_t data;
data.window = window;
@@ -4876,7 +4834,7 @@ pgtk_window_is_of_frame (struct frame *f, GdkWindow * window)
/* 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)
+pgtk_any_window_to_frame (GdkWindow *window)
{
Lisp_Object tail, frame;
struct frame *f, *found = NULL;
@@ -4885,16 +4843,16 @@ pgtk_any_window_to_frame (GdkWindow * window)
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;
- }
- }
+ {
+ if (found)
+ break;
+ f = XFRAME (frame);
+ if (FRAME_PGTK_P (f))
+ {
+ if (pgtk_window_is_of_frame (f, window))
+ found = f;
+ }
+ }
return found;
}
@@ -4902,7 +4860,6 @@ pgtk_any_window_to_frame (GdkWindow * window)
static gboolean
pgtk_handle_event (GtkWidget *widget, GdkEvent *event, gpointer *data)
{
-#if GTK_CHECK_VERSION (3, 18, 0)
struct frame *f;
union buffered_input_event inev;
GtkWidget *frame_widget;
@@ -4932,22 +4889,23 @@ pgtk_handle_event (GtkWidget *widget, GdkEvent *event, gpointer *data)
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;
}
-#endif
return FALSE;
}
static void
pgtk_fill_rectangle (struct frame *f, unsigned long color, int x, int y,
- int width, int height)
+ 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);
+ 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);
@@ -5001,7 +4959,7 @@ pgtk_clear_under_internal_border (struct frame *f)
}
static gboolean
-pgtk_handle_draw (GtkWidget * widget, cairo_t * cr, gpointer * data)
+pgtk_handle_draw (GtkWidget *widget, cairo_t *cr, gpointer *data)
{
struct frame *f;
@@ -5027,19 +4985,11 @@ pgtk_handle_draw (GtkWidget * widget, cairo_t * cr, gpointer * data)
}
static void
-size_allocate (GtkWidget * widget, GtkAllocation * alloc,
+size_allocate (GtkWidget *widget, GtkAllocation *alloc,
gpointer user_data)
{
struct frame *f = pgtk_any_window_to_frame (gtk_widget_get_window (widget));
- /* Between a frame is created and not shown, size is allocated and
- * this handler is called. When that, since the widget's window is
- * NULL, we can't get f, pgtk_cr_update_surface_desired_size is not
- * called, and its size is 0x0. That causes empty frame.
- *
- * Fortunately since we know f in pgtk_set_event_handler, we can get
- * it through user_data;
- */
if (!f)
f = user_data;
@@ -5051,88 +5001,8 @@ size_allocate (GtkWidget * widget, GtkAllocation * alloc,
}
static void
-x_find_modifier_meanings (struct pgtk_display_info *dpyinfo)
-{
- GdkDisplay *gdpy = dpyinfo->gdpy;
- GdkKeymap *keymap = gdk_keymap_get_for_display (gdpy);
- GdkModifierType state = GDK_META_MASK;
- gboolean r = gdk_keymap_map_virtual_modifiers (keymap, &state);
- if (r)
- {
- /* Meta key exists. */
- if (state == GDK_META_MASK)
- {
- dpyinfo->meta_mod_mask = GDK_MOD1_MASK; /* maybe this is meta. */
- dpyinfo->alt_mod_mask = 0;
- }
- else
- {
- dpyinfo->meta_mod_mask = state & ~GDK_META_MASK;
- if (dpyinfo->meta_mod_mask == GDK_MOD1_MASK)
- dpyinfo->alt_mod_mask = 0;
- else
- dpyinfo->alt_mod_mask = GDK_MOD1_MASK;
- }
- }
- else
- {
- dpyinfo->meta_mod_mask = GDK_MOD1_MASK;
- dpyinfo->alt_mod_mask = 0;
- }
-
- state = GDK_SUPER_MASK;
- r = gdk_keymap_map_virtual_modifiers (keymap, &state);
- if (r)
- {
- /* Super key exists. */
- if (state == GDK_SUPER_MASK)
- {
- dpyinfo->super_mod_mask = GDK_MOD4_MASK; /* maybe this is super. */
- }
- else
- {
- dpyinfo->super_mod_mask = state & ~GDK_SUPER_MASK;
- }
- }
- else
- {
- dpyinfo->super_mod_mask = GDK_MOD4_MASK;
- }
-
- state = GDK_HYPER_MASK;
- r = gdk_keymap_map_virtual_modifiers (keymap, &state);
- if (r)
- {
- /* Hyper key exists. */
- if (state == GDK_HYPER_MASK)
- {
- dpyinfo->hyper_mod_mask = GDK_MOD3_MASK; /* maybe this is hyper. */
- }
- else
- {
- dpyinfo->hyper_mod_mask = state & ~GDK_HYPER_MASK;
- }
- }
- else
- {
- dpyinfo->hyper_mod_mask = GDK_MOD3_MASK;
- }
-
- /* If xmodmap says:
- * $ xmodmap | grep mod4
- * mod4 Super_L (0x85), Super_R (0x86), Super_L (0xce), Hyper_L (0xcf)
- * then, when mod4 is pressed, both of super and hyper are recognized ON.
- * Maybe many people have such configuration, and they don't like such behavior,
- * so I disable hyper if such configuration is detected.
- */
- if (dpyinfo->hyper_mod_mask == dpyinfo->super_mod_mask)
- dpyinfo->hyper_mod_mask = 0;
-}
-
-static void
-get_modifier_values (int *mod_ctrl,
- int *mod_meta,
- int *mod_alt, int *mod_hyper, int *mod_super)
+get_modifier_values (int *mod_ctrl, int *mod_meta, int *mod_alt,
+ int *mod_hyper, int *mod_super)
{
Lisp_Object tem;
@@ -5177,14 +5047,13 @@ pgtk_gtk_to_emacs_modifiers (struct pgtk_display_info *dpyinfo, int state)
mod |= shift_modifier;
if (state & GDK_CONTROL_MASK)
mod |= mod_ctrl;
- if (state & dpyinfo->meta_mod_mask)
+ if (state & GDK_META_MASK || state & GDK_MOD1_MASK)
mod |= mod_meta;
- if (state & dpyinfo->alt_mod_mask)
- mod |= mod_alt;
- if (state & dpyinfo->super_mod_mask)
+ if (state & GDK_SUPER_MASK)
mod |= mod_super;
- if (state & dpyinfo->hyper_mod_mask)
+ if (state & GDK_HYPER_MASK)
mod |= mod_hyper;
+
return mod;
}
@@ -5202,18 +5071,16 @@ pgtk_emacs_to_gtk_modifiers (struct pgtk_display_info *dpyinfo, int state)
&mod_super);
mask = 0;
- if (state & mod_alt)
- mask |= dpyinfo->alt_mod_mask;
if (state & mod_super)
- mask |= dpyinfo->super_mod_mask;
+ mask |= GDK_SUPER_MASK;
if (state & mod_hyper)
- mask |= dpyinfo->hyper_mod_mask;
+ 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 |= dpyinfo->meta_mod_mask;
+ mask |= GDK_MOD1_MASK;
return mask;
}
@@ -5229,11 +5096,11 @@ pgtk_emacs_to_gtk_modifiers (struct pgtk_display_info *dpyinfo, int state)
void
-pgtk_enqueue_string (struct frame *f, gchar * str)
+pgtk_enqueue_string (struct frame *f, gchar *str)
{
- gunichar *ustr;
+ gunichar *ustr, *uptr;
- ustr = g_utf8_to_ucs4 (str, -1, NULL, NULL, NULL);
+ uptr = ustr = g_utf8_to_ucs4 (str, -1, NULL, NULL, NULL);
if (ustr == NULL)
return;
for (; *ustr != 0; ustr++)
@@ -5252,6 +5119,7 @@ pgtk_enqueue_string (struct frame *f, gchar * str)
evq_enqueue (&inev);
}
+ g_free (uptr);
}
void
@@ -5269,20 +5137,15 @@ pgtk_enqueue_preedit (struct frame *f, Lisp_Object preedit)
}
static gboolean
-key_press_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data)
+key_press_event (GtkWidget *widget, GdkEvent *event, gpointer *user_data)
{
- struct coding_system coding;
union buffered_input_event inev;
ptrdiff_t nbytes = 0;
Mouse_HLInfo *hlinfo;
+ struct frame *f;
- USE_SAFE_ALLOCA;
-
+ f = pgtk_any_window_to_frame (gtk_widget_get_window (widget));
EVENT_INIT (inev.ie);
- inev.ie.kind = NO_EVENT;
- inev.ie.arg = Qnil;
-
- struct frame *f = pgtk_any_window_to_frame (gtk_widget_get_window (widget));
hlinfo = MOUSE_HL_INFO (f);
/* If mouse-highlight is an integer, input clears out
@@ -5295,20 +5158,6 @@ key_press_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data)
if (f != 0)
{
- /* While super is pressed, gtk_im_context_filter_keypress() always process the
- * key events ignoring super.
- * As a work around, don't call it while super or hyper are pressed...
- */
- struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
- if (!(event->key.state & (dpyinfo->super_mod_mask | dpyinfo->hyper_mod_mask)))
- {
- if (pgtk_im_filter_keypress (f, &event->key))
- return 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
@@ -5325,13 +5174,22 @@ key_press_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data)
unsigned char *copy_bufptr = copy_buffer;
int copy_bufsiz = sizeof (copy_buffer);
int modifiers;
- Lisp_Object coding_system = Qlatin_1;
Lisp_Object c;
- guint state = event->key.state;
+ 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);
+ state |= pgtk_emacs_to_gtk_modifiers (FRAME_DISPLAY_INFO (f),
+ extra_keyboard_modifiers);
modifiers = state;
/* This will have to go some day... */
@@ -5363,6 +5221,9 @@ key_press_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data)
{
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;
}
@@ -5374,6 +5235,9 @@ key_press_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data)
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;
}
@@ -5386,6 +5250,9 @@ key_press_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data)
? 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;
}
@@ -5449,9 +5316,6 @@ key_press_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data)
|| (orig_keysym & (1 << 28))
|| (keysym != GDK_KEY_VoidSymbol && nbytes == 0))
&& !(event->key.is_modifier
- /* Gtk's modifier keys are different from Xlib's ones.
- * I need to exclude them.
- */
|| IsModifierKey (orig_keysym)
/* The symbols from GDK_KEY_ISO_Lock
to GDK_KEY_ISO_Last_Group_Lock
@@ -5464,68 +5328,21 @@ key_press_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data)
#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;
+
+ inev.ie.device
+ = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (f), event);
goto done;
}
- { /* Raw bytes, not keysym. */
- ptrdiff_t i;
- int nchars, len;
-
- for (i = 0, nchars = 0; i < nbytes; i++)
- {
- if (ASCII_CHAR_P (copy_bufptr[i]))
- nchars++;
- STORE_KEYSYM_FOR_DEBUG (copy_bufptr[i]);
- }
-
- if (nchars < nbytes)
- {
- /* Decode the input data. */
-
- /* The input should be decoded with locale `coding_system'. */
- if (!NILP (Vlocale_coding_system))
- coding_system = Vlocale_coding_system;
- 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;
- }
-
- /* 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;
- evq_enqueue (&inev);
- }
-
- /* count += nchars; */
-
- inev.ie.kind = NO_EVENT; /* Already stored above. */
+ {
+ 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;
@@ -5537,11 +5354,8 @@ done:
{
XSETFRAME (inev.ie.frame_or_window, f);
evq_enqueue (&inev);
- /* count++; */
}
- SAFE_FREE ();
-
return TRUE;
}
@@ -5559,6 +5373,7 @@ configure_event (GtkWidget *widget,
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)
@@ -5571,6 +5386,15 @@ configure_event (GtkWidget *widget,
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;
}
@@ -5603,9 +5427,9 @@ map_event (GtkWidget *widget,
/* The `z-group' is reset every time a frame becomes
invisible. Handle this here. */
if (FRAME_Z_GROUP (f) == z_group_above)
- x_set_z_group (f, Qabove, Qnil);
+ pgtk_set_z_group (f, Qabove, Qnil);
else if (FRAME_Z_GROUP (f) == z_group_below)
- x_set_z_group (f, Qbelow, Qnil);
+ pgtk_set_z_group (f, Qbelow, Qnil);
}
SET_FRAME_VISIBLE (f, 1);
@@ -5630,15 +5454,18 @@ window_state_event (GtkWidget *widget,
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 (event->window_state.new_window_state & GDK_WINDOW_STATE_FOCUSED)
+ if (new_state & GDK_WINDOW_STATE_FOCUSED)
{
if (FRAME_ICONIFIED_P (f))
{
@@ -5654,6 +5481,38 @@ window_state_event (GtkWidget *widget,
}
}
+ 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;
@@ -5691,15 +5550,15 @@ delete_event (GtkWidget *widget,
a FOCUS_IN_EVENT into *BUFP. */
static void
-x_focus_changed (gboolean is_enter, int state,
- struct pgtk_display_info *dpyinfo, struct frame *frame,
- union buffered_input_event *bufp)
+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)
{
- x_new_focus_frame (dpyinfo, frame);
+ pgtk_new_focus_frame (dpyinfo, frame);
dpyinfo->x_focus_event_frame = frame;
/* Don't stop displaying the initial startup message
@@ -5724,14 +5583,14 @@ x_focus_changed (gboolean is_enter, int state,
if (dpyinfo->x_focus_event_frame == frame)
{
dpyinfo->x_focus_event_frame = 0;
- x_new_focus_frame (dpyinfo, 0);
+ pgtk_new_focus_frame (dpyinfo, NULL);
bufp->ie.kind = FOCUS_OUT_EVENT;
XSETFRAME (bufp->ie.frame_or_window, frame);
}
if (frame->pointer_invisible)
- XTtoggle_invisible_pointer (frame, false);
+ pgtk_toggle_invisible_pointer (frame, false);
}
}
@@ -5740,10 +5599,12 @@ 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));
+ 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
@@ -5755,7 +5616,7 @@ enter_notify_event (GtkWidget *widget, GdkEvent *event,
if (event->crossing.detail != GDK_NOTIFY_INFERIOR
&& event->crossing.focus && !(focus_state & FOCUS_EXPLICIT))
- x_focus_changed (TRUE, FOCUS_IMPLICIT, dpyinfo, frame, &inev);
+ pgtk_focus_changed (TRUE, FOCUS_IMPLICIT, dpyinfo, frame, &inev);
if (inev.ie.kind != NO_EVENT)
evq_enqueue (&inev);
return TRUE;
@@ -5766,10 +5627,12 @@ 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));
+ 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
@@ -5790,7 +5653,7 @@ leave_notify_event (GtkWidget *widget, GdkEvent *event,
if (event->crossing.detail != GDK_NOTIFY_INFERIOR
&& event->crossing.focus && !(focus_state & FOCUS_EXPLICIT))
- x_focus_changed (FALSE, FOCUS_IMPLICIT, dpyinfo, frame, &inev);
+ pgtk_focus_changed (FALSE, FOCUS_IMPLICIT, dpyinfo, frame, &inev);
if (frame)
{
@@ -5809,11 +5672,11 @@ leave_notify_event (GtkWidget *widget, GdkEvent *event,
}
static gboolean
-focus_in_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data)
+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));
+ struct frame *frame
+ = pgtk_any_window_to_frame (gtk_widget_get_window (widget));
if (frame == NULL)
return TRUE;
@@ -5822,8 +5685,8 @@ focus_in_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data)
inev.ie.kind = NO_EVENT;
inev.ie.arg = Qnil;
- x_focus_changed (TRUE, FOCUS_EXPLICIT,
- FRAME_DISPLAY_INFO (frame), frame, &inev);
+ pgtk_focus_changed (TRUE, FOCUS_EXPLICIT,
+ FRAME_DISPLAY_INFO (frame), frame, &inev);
if (inev.ie.kind != NO_EVENT)
evq_enqueue (&inev);
@@ -5833,11 +5696,11 @@ focus_in_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data)
}
static gboolean
-focus_out_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data)
+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));
+ struct frame *frame
+ = pgtk_any_window_to_frame (gtk_widget_get_window (widget));
if (frame == NULL)
return TRUE;
@@ -5846,8 +5709,8 @@ focus_out_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data)
inev.ie.kind = NO_EVENT;
inev.ie.arg = Qnil;
- x_focus_changed (FALSE, FOCUS_EXPLICIT,
- FRAME_DISPLAY_INFO (frame), frame, &inev);
+ pgtk_focus_changed (FALSE, FOCUS_EXPLICIT,
+ FRAME_DISPLAY_INFO (frame), frame, &inev);
if (inev.ie.kind != NO_EVENT)
evq_enqueue (&inev);
@@ -5865,7 +5728,8 @@ focus_out_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data)
another motion event, so we can check again the next time it moves. */
static bool
-note_mouse_movement (struct frame *frame, const GdkEventMotion * event)
+note_mouse_movement (struct frame *frame,
+ const GdkEventMotion *event)
{
XRectangle *r;
struct pgtk_display_info *dpyinfo;
@@ -5885,6 +5749,9 @@ note_mouse_movement (struct frame *frame, const GdkEventMotion * event)
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;
}
@@ -5901,6 +5768,9 @@ note_mouse_movement (struct frame *frame, const GdkEventMotion * event)
/* 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;
}
@@ -5908,17 +5778,14 @@ note_mouse_movement (struct frame *frame, const GdkEventMotion * event)
}
static gboolean
-motion_notify_event (GtkWidget * widget, GdkEvent * event,
- gpointer * user_data)
+motion_notify_event (GtkWidget *widget, GdkEvent *event,
+ gpointer *user_data)
{
union buffered_input_event inev;
struct frame *f, *frame;
struct pgtk_display_info *dpyinfo;
Mouse_HLInfo *hlinfo;
- /* This is needed to make pointer visible when motion_notify event */
- pending_signals = true;
-
EVENT_INIT (inev.ie);
inev.ie.kind = NO_EVENT;
inev.ie.arg = Qnil;
@@ -5938,8 +5805,9 @@ motion_notify_event (GtkWidget * widget, GdkEvent * event,
clear_mouse_face (hlinfo);
}
- if (f && xg_event_is_for_scrollbar (f, event))
+ if (f && xg_event_is_for_scrollbar (f, event, false))
f = 0;
+
if (f)
{
/* Maybe generate a SELECT_WINDOW_EVENT for
@@ -5984,11 +5852,9 @@ motion_notify_event (GtkWidget * widget, GdkEvent * event,
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 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. */
@@ -6016,26 +5882,6 @@ motion_notify_event (GtkWidget * widget, GdkEvent * event,
return TRUE;
}
-/* Mouse clicks and mouse movement. Rah.
-
- Formerly, we used PointerMotionHintMask (in standard_event_mask)
- so that we would have to call XQueryPointer after each MotionNotify
- event to ask for another such event. However, this made mouse tracking
- slow, and there was a bug that made it eventually stop.
-
- Simply asking for MotionNotify all the time seems to work better.
-
- In order to avoid asking for motion events and then throwing most
- of them away or busy-polling the server for mouse positions, we ask
- the server for pointer motion hints. This means that we get only
- one event per group of mouse movements. "Groups" are delimited by
- other kinds of events (focus changes and button clicks, for
- example), or by XQueryPointer calls; when one of these happens, we
- get another MotionNotify event the next time the mouse moves. This
- is at least as efficient as getting motion events when mouse
- tracking is on, and I suspect only negligibly worse when tracking
- is off. */
-
/* 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
@@ -6043,7 +5889,8 @@ motion_notify_event (GtkWidget * widget, GdkEvent * event,
static Lisp_Object
construct_mouse_click (struct input_event *result,
- const GdkEventButton * event, struct frame *f)
+ const GdkEventButton *event,
+ struct frame *f)
{
/* Make the event type NO_EVENT; we'll change that when we decide
otherwise. */
@@ -6058,11 +5905,14 @@ construct_mouse_click (struct input_event *result,
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)
+button_event (GtkWidget *widget, GdkEvent *event,
+ gpointer *user_data)
{
union buffered_input_event inev;
struct frame *f, *frame;
@@ -6086,9 +5936,6 @@ button_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data)
dpyinfo = FRAME_DISPLAY_INFO (frame);
dpyinfo->last_mouse_glyph_frame = NULL;
-#if 0
- x_display_set_last_user_time (dpyinfo, event->button.time);
-#endif
if (gui_mouse_grabbed (dpyinfo))
f = dpyinfo->last_mouse_frame;
@@ -6117,14 +5964,6 @@ button_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data)
}
}
- /* xg_event_is_for_scrollbar() doesn't work correctly on sway, and
- * we shouldn't need it.
- */
-#if 0
- if (f && xg_event_is_for_scrollbar (f, event))
- f = 0;
-#endif
-
if (f)
{
/* Is this in the tab-bar? */
@@ -6166,11 +6005,6 @@ button_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data)
if (!NILP (tab_bar_arg))
inev.ie.arg = tab_bar_arg;
}
-#if 0
- if (FRAME_X_EMBEDDED_P (f))
- xembed_send_message (f, event->button.time,
- XEMBED_REQUEST_FOCUS, 0, 0, 0);
-#endif
}
if (event->type == GDK_BUTTON_PRESS)
@@ -6197,7 +6031,7 @@ button_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data)
}
static gboolean
-scroll_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data)
+scroll_event (GtkWidget *widget, GdkEvent *event, gpointer *user_data)
{
union buffered_input_event inev;
struct frame *f, *frame;
@@ -6229,6 +6063,8 @@ scroll_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data)
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;
}
@@ -6322,47 +6158,245 @@ scroll_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data)
}
if (inev.ie.kind != NO_EVENT)
- evq_enqueue (&inev);
+ {
+ 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 (&current_drop_context,
+ g_object_unref);
+}
+
static void
-drag_data_received (GtkWidget * widget, GdkDragContext * context,
- gint x, gint y,
- GtkSelectionData * data,
- guint info, guint time, gpointer user_data)
+drag_leave (GtkWidget *widget, GdkDragContext *context,
+ guint time, gpointer user_data)
{
- struct frame *f = pgtk_any_window_to_frame (gtk_widget_get_window (widget));
- gchar **uris = gtk_selection_data_get_uris (data);
+ struct frame *f;
+ union buffered_input_event inev;
- if (uris != NULL)
+ f = pgtk_any_window_to_frame (gtk_widget_get_window (widget));
+
+ if (current_drop_context)
{
- for (int i = 0; uris[i] != NULL; i++)
- {
- union buffered_input_event inev;
- Lisp_Object arg = Qnil;
+ if (current_drop_context_drop)
+ gtk_drag_finish (current_drop_context,
+ FALSE, FALSE, current_drop_time);
- EVENT_INIT (inev.ie);
- inev.ie.kind = NO_EVENT;
- inev.ie.arg = Qnil;
+ g_clear_pointer (&current_drop_context,
+ g_object_unref);
+ }
- arg = list2 (Qurl, build_string (uris[i]));
+ EVENT_INIT (inev.ie);
- inev.ie.kind = DRAG_N_DROP_EVENT;
- inev.ie.modifiers = 0;
- XSETINT (inev.ie.x, x);
- XSETINT (inev.ie.y, y);
- XSETFRAME (inev.ie.frame_or_window, f);
- inev.ie.arg = arg;
- inev.ie.timestamp = 0;
+ inev.ie.kind = DRAG_N_DROP_EVENT;
+ inev.ie.modifiers = 0;
+ inev.ie.arg = Qnil;
+ inev.ie.timestamp = time;
- evq_enqueue (&inev);
- }
+ 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 (&current_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 (&current_drop_context,
+ g_object_unref);
}
- gtk_drag_finish (context, TRUE, FALSE, time);
+ 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)
{
@@ -6373,9 +6407,9 @@ pgtk_set_event_handler (struct frame *f)
return;
}
- gtk_drag_dest_set (FRAME_GTK_WIDGET (f), GTK_DEST_DEFAULT_ALL, NULL, 0,
- GDK_ACTION_COPY);
- gtk_drag_dest_add_uri_targets (FRAME_GTK_WIDGET (f));
+ 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))
{
@@ -6414,14 +6448,24 @@ pgtk_set_event_handler (struct frame *f)
G_CALLBACK (button_event), NULL);
g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "scroll-event",
G_CALLBACK (scroll_event), NULL);
- g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "selection-clear-event",
- G_CALLBACK (pgtk_selection_lost), NULL);
g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "configure-event",
G_CALLBACK (configure_event), NULL);
- g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "drag-data-received",
- G_CALLBACK (drag_data_received), NULL);
+ g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "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);
}
@@ -6481,25 +6525,72 @@ same_x_server (const char *name1, const char *name2)
&& (*name2 == '.' || *name2 == '\0'));
}
-#define GNOME_INTERFACE_SCHEMA "org.gnome.desktop.interface"
+static struct frame *
+pgtk_find_selection_owner (GdkWindow *window)
+{
+ Lisp_Object tail, tem;
+ struct frame *f;
-static gdouble pgtk_text_scaling_factor (void)
+ 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)
{
- GSettingsSchemaSource *schema_source = g_settings_schema_source_get_default ();
- if (schema_source != NULL)
+ 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)
{
- GSettingsSchema *schema = g_settings_schema_source_lookup (schema_source,
- GNOME_INTERFACE_SCHEMA, true);
- if (schema != NULL)
- {
- g_settings_schema_unref (schema);
- GSettings *set = g_settings_new (GNOME_INTERFACE_SCHEMA);
- return g_settings_get_double (set, "text-scaling-factor");
+ 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;
}
}
- return 1;
-}
+ 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.
@@ -6514,9 +6605,11 @@ pgtk_term_init (Lisp_Object display_name, char *resource_name)
static int x_initialized = 0;
static unsigned x_display_id = 0;
static char *initial_display = NULL;
- static dynlib_handle_ptr *handle = NULL;
char *dpy_name;
+ static void *handle = NULL;
Lisp_Object lisp_dpy_name = Qnil;
+ GdkScreen *gscr;
+ gdouble dpi;
block_input ();
@@ -6653,9 +6746,6 @@ pgtk_term_init (Lisp_Object display_name, char *resource_name)
*nametail++ = '@';
lispstpcpy (nametail, system_name);
- /* Figure out which modifier bits mean what. */
- x_find_modifier_meanings (dpyinfo);
-
/* 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);
@@ -6670,34 +6760,35 @@ pgtk_term_init (Lisp_Object display_name, char *resource_name)
reset_mouse_highlight (&dpyinfo->mouse_highlight);
- {
- GdkScreen *gscr = gdk_display_get_default_screen (dpyinfo->gdpy);
+ gscr = gdk_display_get_default_screen (dpyinfo->gdpy);
+ dpi = gdk_screen_get_resolution (gscr);
- gdouble dpi = gdk_screen_get_resolution (gscr);
- if (dpi < 0)
- dpi = 96.0;
+ if (dpi < 0)
+ dpi = 96.0;
- dpi *= pgtk_text_scaling_factor ();
- dpyinfo->resx = dpi;
- dpyinfo->resy = dpi;
- }
+ dpyinfo->resx = dpi;
+ dpyinfo->resy = dpi;
+
+ g_signal_connect (G_OBJECT (gscr), "monitors-changed",
+ G_CALLBACK (pgtk_monitors_changed_cb),
+ terminal);
- /* smooth scroll setting */
- dpyinfo->scroll.x_per_char = 2;
- dpyinfo->scroll.y_per_line = 2;
+ /* Set up scrolling increments. */
+ dpyinfo->scroll.x_per_char = 1;
+ dpyinfo->scroll.y_per_line = 1;
dpyinfo->connection = -1;
if (!handle)
- handle = dynlib_open (NULL);
+ 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 *)
- = dynlib_sym (handle, "gdk_x11_display_get_xdisplay");
+ = dlsym (handle, "gdk_x11_display_get_xdisplay");
int (*x_connection_number) (void *)
- = dynlib_sym (handle, "XConnectionNumber");
+ = dlsym (handle, "XConnectionNumber");
if (x_connection_number
&& gdk_x11_display_get_xdisplay)
@@ -6711,7 +6802,7 @@ pgtk_term_init (Lisp_Object display_name, char *resource_name)
{
struct wl_display *wl_dpy = gdk_wayland_display_get_wl_display (dpy);
int (*display_get_fd) (struct wl_display *)
- = dynlib_sym (handle, "wl_display_get_fd");
+ = dlsym (handle, "wl_display_get_fd");
if (display_get_fd)
dpyinfo->connection = display_get_fd (wl_dpy);
@@ -6729,14 +6820,19 @@ pgtk_term_init (Lisp_Object display_name, char *resource_name)
init_sigio (dpyinfo->connection);
}
- x_setup_pointer_blanking (dpyinfo);
+ dpyinfo->invisible_cursor
+ = gdk_cursor_new_for_display (dpyinfo->gdpy, GDK_BLANK_CURSOR);
xsettings_initialize (dpyinfo);
- pgtk_selection_init ();
-
pgtk_im_init (dpyinfo);
+ g_signal_connect (G_OBJECT (dpyinfo->gdpy), "seat-added",
+ G_CALLBACK (pgtk_seat_added_cb), dpyinfo);
+ g_signal_connect (G_OBJECT (dpyinfo->gdpy), "seat-removed",
+ G_CALLBACK (pgtk_seat_removed_cb), dpyinfo);
+ pgtk_enumerate_devices (dpyinfo, true);
+
unblock_input ();
return dpyinfo;
@@ -6770,6 +6866,7 @@ pgtk_delete_display (struct pgtk_display_info *dpyinfo)
tail->next = tail->next->next;
}
+ pgtk_free_devices (dpyinfo);
xfree (dpyinfo);
}
@@ -6802,9 +6899,9 @@ pgtk_xlfd_to_fontname (const char *xlfd)
}
bool
-pgtk_defined_color (struct frame *f,
- const char *name,
- Emacs_Color * color_def, bool alloc, bool makeIndex)
+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,
@@ -6885,7 +6982,8 @@ pgtk_clear_area (struct frame *f, int x, int y, int width, int height)
eassert (width > 0 && height > 0);
cr = pgtk_begin_cr_clip (f);
- pgtk_set_cr_source_with_color (f, FRAME_X_OUTPUT (f)->background_color);
+ 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);
@@ -6895,7 +6993,6 @@ pgtk_clear_area (struct frame *f, int x, int y, int width, int height)
void
syms_of_pgtkterm (void)
{
- /* from 23+ we need to tell emacs what modifiers there are.. */
DEFSYM (Qmodifier_value, "modifier-value");
DEFSYM (Qalt, "alt");
DEFSYM (Qhyper, "hyper");
@@ -6909,12 +7006,17 @@ syms_of_pgtkterm (void)
DEFSYM (Qlatin_1, "latin-1");
- xg_default_icon_file =
- build_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg");
+ 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));
@@ -6923,80 +7025,46 @@ syms_of_pgtkterm (void)
Fput (Qcontrol, Qmodifier_value, make_fixnum (ctrl_modifier));
DEFVAR_LISP ("x-ctrl-keysym", Vx_ctrl_keysym,
- doc: /* Which keys Emacs uses for the ctrl modifier.
-This should be one of the symbols `ctrl', `alt', `hyper', `meta',
-`super'. For example, `ctrl' means use the Ctrl_L and Ctrl_R keysyms.
-The default is nil, which is the same as `ctrl'. */ );
+ doc: /* SKIP: real doc in xterm.c. */);
Vx_ctrl_keysym = Qnil;
DEFVAR_LISP ("x-alt-keysym", Vx_alt_keysym,
- doc: /* Which keys Emacs uses for the alt modifier.
-This should be one of the symbols `ctrl', `alt', `hyper', `meta',
-`super'. For example, `alt' means use the Alt_L and Alt_R keysyms.
-The default is nil, which is the same as `alt'. */ );
+ doc: /* SKIP: real doc in xterm.c. */);
Vx_alt_keysym = Qnil;
DEFVAR_LISP ("x-hyper-keysym", Vx_hyper_keysym,
- doc: /* Which keys Emacs uses for the hyper modifier.
-This should be one of the symbols `ctrl', `alt', `hyper', `meta',
-`super'. For example, `hyper' means use the Hyper_L and Hyper_R
-keysyms. The default is nil, which is the same as `hyper'. */ );
+ doc: /* SKIP: real doc in xterm.c. */);
Vx_hyper_keysym = Qnil;
DEFVAR_LISP ("x-meta-keysym", Vx_meta_keysym,
- doc: /* Which keys Emacs uses for the meta modifier.
-This should be one of the symbols `ctrl', `alt', `hyper', `meta',
-`super'. For example, `meta' means use the Meta_L and Meta_R keysyms.
-The default is nil, which is the same as `meta'. */ );
+ doc: /* SKIP: real doc in xterm.c. */);
Vx_meta_keysym = Qnil;
DEFVAR_LISP ("x-super-keysym", Vx_super_keysym,
- doc: /* Which keys Emacs uses for the super modifier.
-This should be one of the symbols `ctrl', `alt', `hyper', `meta',
-`super'. For example, `super' means use the Super_L and Super_R
-keysyms. The default is nil, which is the same as `super'. */ );
+ doc: /* SKIP: real doc in xterm.c. */);
Vx_super_keysym = Qnil;
- /* TODO: move to common code */
- 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. */ );
- /* Vx_toolkit_scroll_bars = Qt; */
- Vx_toolkit_scroll_bars = intern_c_string ("gtk");
+ 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-use-underline-position-properties", x_use_underline_position_properties,
- doc: /*Non-nil means make use of UNDERLINE_POSITION font properties.
-A value of nil means ignore them. If you encounter fonts with bogus
-UNDERLINE_POSITION font properties, for example 7x13 on XFree prior
-to 4.1, set this to nil. */);
- x_use_underline_position_properties = 0;
-
- DEFVAR_BOOL ("x-underline-at-descent-line", x_underline_at_descent_line,
- doc: /* Non-nil means to draw the underline at the same place as the descent line.
-A value of nil means to draw the underline according to the value of the
-variable `x-use-underline-position-properties', which is usually at the
-baseline level. The default value is nil. */);
+ 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_BOOL ("x-gtk-use-window-move", x_gtk_use_window_move,
- doc: /* Non-nil means rely on gtk_window_move to set frame positions.
-If this variable is t (the default), the GTK build uses the function
-gtk_window_move to set or store frame positions and disables some time
-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-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 X events.
+ doc: /* How long to wait for GTK events.
-Emacs will wait up to this many seconds to receive X 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.
+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);
@@ -7015,13 +7083,12 @@ If set to a non-float value, there will be no wait at all. */);
}
/* 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.
- */
+ 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)
{
@@ -7068,25 +7135,42 @@ pgtk_end_cr_clip (struct frame *f)
}
void
-pgtk_set_cr_source_with_gc_foreground (struct frame *f, Emacs_GC * gc)
+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);
+ 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)
+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);
+ 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)
+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);
- cairo_set_source_rgb (FRAME_CR_CONTEXT (f), col.red / 65535.0,
- col.green / 65535.0, col.blue / 65535.0);
+
+ 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
@@ -7098,7 +7182,7 @@ pgtk_cr_draw_frame (cairo_t * cr, struct frame *f)
static cairo_status_t
pgtk_cr_accumulate_data (void *closure, const unsigned char *data,
- unsigned int length)
+ unsigned int length)
{
Lisp_Object *acc = (Lisp_Object *) closure;
@@ -7125,8 +7209,6 @@ pgtk_cr_destroy (void *cr)
unblock_input ();
}
-
-
Lisp_Object
pgtk_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type)
{
@@ -7136,7 +7218,7 @@ pgtk_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);
@@ -7219,9 +7301,3 @@ pgtk_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type)
return CALLN (Fapply, intern ("concat"), Fnreverse (acc));
}
-
-
-void
-init_pgtkterm (void)
-{
-}
diff --git a/src/pgtkterm.h b/src/pgtkterm.h
index 42b03e315ef..fcc6c5310e9 100644
--- a/src/pgtkterm.h
+++ b/src/pgtkterm.h
@@ -40,8 +40,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <cairo-svg.h>
#endif
-/* could use list to store these, but rest of emacs has a big infrastructure
- for managing a table of bitmap "records" */
struct pgtk_bitmap_record
{
void *img;
@@ -51,13 +49,22 @@ struct pgtk_bitmap_record
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 RED_FROM_ULONG(color) (((color) >> 16) & 0xff)
#define GREEN_FROM_ULONG(color) (((color) >> 8) & 0xff)
-#define BLUE_FROM_ULONG(color) ((color) & 0xff)
+#define BLUE_FROM_ULONG(color) ((color) & 0xff)
struct scroll_bar
{
@@ -89,7 +96,7 @@ struct scroll_bar
editing large files, we establish a minimum height by always
drawing handle bottoms VERTICAL_SCROLL_BAR_MIN_HANDLE pixels below
where they would be normally; the bottom and top are in a
- different co-ordinate system. */
+ different coordinate system. */
int start, end;
/* If the scroll bar handle is currently being dragged by the user,
@@ -112,8 +119,6 @@ struct scroll_bar
bool horizontal;
};
-
-/* init'd in pgtk_initialize_display_info () */
struct pgtk_display_info
{
/* Chain of all pgtk_display_info structures. */
@@ -122,8 +127,14 @@ struct pgtk_display_info
/* The generic display parameters corresponding to this PGTK display. */
struct terminal *terminal;
- /* This says how to access this display in Gdk. */
- GdkDisplay *gdpy;
+ 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;
@@ -205,30 +216,28 @@ struct pgtk_display_info
/* 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.
- Unused if this display supports Xfixes extension. */
+ /* The invisible cursor used for pointer blanking. */
Emacs_Cursor invisible_cursor;
- /* Function used to toggle pointer visibility on this display. */
- void (*toggle_visible_pointer) (struct frame *, bool);
-
/* 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;
- /* Modifier masks in gdk */
- int meta_mod_mask, alt_mod_mask, super_mod_mask, hyper_mod_mask;
-
/* The last click event. */
GdkEvent *last_click_event;
- /* input method */
+ /* IM context data. */
struct
{
GtkIMContext *context;
@@ -249,10 +258,6 @@ extern struct pgtk_display_info *x_display_list;
struct pgtk_output
{
-#if 0
- void *view;
- void *miniimage;
-#endif
unsigned long foreground_color;
unsigned long background_color;
void *toolbar;
@@ -396,6 +401,10 @@ struct pgtk_output
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. */
@@ -409,7 +418,7 @@ struct pgtk_output
struct atimer *scale_factor_atimer;
};
-/* this dummy decl needed to support TTYs */
+/* Satisfy term.c. */
struct x_output
{
int unused;
@@ -439,14 +448,15 @@ enum
#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_WIDGET(f) (FRAME_GTK_OUTER_WIDGET (f) \
+ ? FRAME_GTK_OUTER_WIDGET (f) \
+ : FRAME_GTK_WIDGET (f))
-/* aliases */
#define FRAME_PGTK_VIEW(f) FRAME_GTK_WIDGET (f)
#define FRAME_X_WINDOW(f) FRAME_GTK_OUTER_WIDGET (f)
#define FRAME_NATIVE_WINDOW(f) GTK_WINDOW (FRAME_X_WINDOW (f))
+#define FRAME_GDK_WINDOW(f) \
+ (gtk_widget_get_window (FRAME_GTK_WIDGET (f)))
#define FRAME_X_DISPLAY(f) (FRAME_DISPLAY_INFO (f)->gdpy)
@@ -455,59 +465,8 @@ enum
/* Turning a lisp vector value into a pointer to a struct scroll_bar. */
#define XSCROLL_BAR(vec) ((struct scroll_bar *) XVECTOR (vec))
-#define PGTK_FACE_FOREGROUND(f) ((f)->foreground)
-#define PGTK_FACE_BACKGROUND(f) ((f)->background)
#define FRAME_DEFAULT_FACE(f) FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID)
-
-/* Compute pixel height of the frame's titlebar. */
-#define FRAME_PGTK_TITLEBAR_HEIGHT(f) 0
-
-/* Compute pixel size for vertical scroll bars */
-#define PGTK_SCROLL_BAR_WIDTH(f) \
- (FRAME_HAS_VERTICAL_SCROLL_BARS (f) \
- ? rint (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0 \
- ? FRAME_CONFIG_SCROLL_BAR_WIDTH (f) \
- : (FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f))) \
- : 0)
-
-/* Compute pixel size for horizontal scroll bars */
-#define PGTK_SCROLL_BAR_HEIGHT(f) \
- (FRAME_HAS_HORIZONTAL_SCROLL_BARS (f) \
- ? rint (FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) > 0 \
- ? FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) \
- : (FRAME_SCROLL_BAR_LINES (f) * FRAME_LINE_HEIGHT (f))) \
- : 0)
-
-/* Difference btwn char-column-calculated and actual SB widths.
- This is only a concern for rendering when SB on left. */
-#define PGTK_SCROLL_BAR_ADJUST(w, f) \
- (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT (w) ? \
- (FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f) \
- - PGTK_SCROLL_BAR_WIDTH (f)) : 0)
-
-/* Difference btwn char-line-calculated and actual SB heights.
- This is only a concern for rendering when SB on top. */
-#define PGTK_SCROLL_BAR_ADJUST_HORIZONTALLY(w, f) \
- (WINDOW_HAS_HORIZONTAL_SCROLL_BARS (w) ? \
- (FRAME_SCROLL_BAR_LINES (f) * FRAME_LINE_HEIGHT (f) \
- - PGTK_SCROLL_BAR_HEIGHT (f)) : 0)
-
#define FRAME_MENUBAR_HEIGHT(f) (FRAME_X_OUTPUT (f)->menubar_height)
-
-/* Calculate system coordinates of the left and top of the parent
- window or, if there is no parent window, the screen. */
-#define PGTK_PARENT_WINDOW_LEFT_POS(f) \
- (FRAME_PARENT_FRAME (f) != NULL \
- ? [[FRAME_PGTK_VIEW (f) window] parentWindow].frame.origin.x : 0)
-#define PGTK_PARENT_WINDOW_TOP_POS(f) \
- (FRAME_PARENT_FRAME (f) != NULL \
- ? ([[FRAME_PGTK_VIEW (f) window] parentWindow].frame.origin.y \
- + [[FRAME_PGTK_VIEW (f) window] parentWindow].frame.size.height \
- - FRAME_PGTK_TITLEBAR_HEIGHT (FRAME_PARENT_FRAME (f))) \
- : [[[PGTKScreen screepgtk] objectAtIndex: 0] frame].size.height)
-
-#define FRAME_PGTK_FONT_TABLE(f) (FRAME_DISPLAY_INFO (f)->font_table)
-
#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)
@@ -535,78 +494,101 @@ enum
#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 display_name,
- char *resource_name);
-extern void pgtk_term_shutdown (int sig);
+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 *f);
-extern char *pgtk_xlfd_to_fontname (const char *xlfd);
+extern void pgtk_clear_frame (struct frame *);
+extern char *pgtk_xlfd_to_fontname (const char *);
-/* Implemented in pgtkfns. */
+/* Implemented in pgtkfns.c. */
extern void pgtk_set_doc_edited (void);
-extern const char *pgtk_get_defaults_value (const char *key);
-extern const char *pgtk_get_string_resource (XrmDatabase rdb,
- const char *name,
- const char *class);
-extern void pgtk_implicitly_set_name (struct frame *f, Lisp_Object arg,
- Lisp_Object oldval);
+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 *f,
- const char *name,
- Emacs_Color * color_def, bool alloc,
- bool makeIndex);
-extern void pgtk_query_color (struct frame *f, Emacs_Color * color);
-extern void pgtk_query_colors (struct frame *f, Emacs_Color * colors,
- int ncolors);
-extern int pgtk_parse_color (struct frame *f, const char *color_name,
- Emacs_Color * color);
+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 *f, int x, int y, int width,
- int height);
-extern int pgtk_gtk_to_emacs_modifiers (struct pgtk_display_info *dpyinfo,
- int state);
-extern void pgtk_clear_under_internal_border (struct frame *f);
-extern void pgtk_set_event_handler (struct frame *f);
+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 x_display_pixel_height (struct pgtk_display_info *);
-extern int x_display_pixel_width (struct pgtk_display_info *);
+extern int pgtk_display_pixel_height (struct pgtk_display_info *);
+extern int pgtk_display_pixel_width (struct pgtk_display_info *);
-/* Implemented in pgtkterm.c */
-extern void x_destroy_window (struct frame *f);
-extern void x_set_parent_frame (struct frame *f, Lisp_Object new_value,
- Lisp_Object old_value);
-extern void x_set_no_focus_on_map (struct frame *f, Lisp_Object new_value,
- Lisp_Object old_value);
-extern void x_set_no_accept_focus (struct frame *f, Lisp_Object new_value,
- Lisp_Object old_value);
-extern void x_set_z_group (struct frame *f, Lisp_Object new_value,
- Lisp_Object old_value);
+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 *f);
-extern void pgtk_end_cr_clip (struct frame *f);
-extern void pgtk_set_cr_source_with_gc_foreground (struct frame *f,
- Emacs_GC * gc);
-extern void pgtk_set_cr_source_with_gc_background (struct frame *f,
- Emacs_GC * gc);
-extern void pgtk_set_cr_source_with_color (struct frame *f,
- unsigned long color);
-extern void pgtk_cr_draw_frame (cairo_t * cr, struct frame *f);
-extern void pgtk_cr_destroy_frame_context (struct frame *f);
-extern Lisp_Object pgtk_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type);
+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 *f, Lisp_Object header,
- Lisp_Object contents);
-extern Lisp_Object pgtk_dialog_show (struct frame *f, Lisp_Object title,
- Lisp_Object header,
- const char **error_name);
+extern 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 *);
@@ -617,49 +599,47 @@ extern void syms_of_pgtkmenu (void);
extern void syms_of_pgtkselect (void);
extern void syms_of_pgtkim (void);
-/* Implemented in pgtkselect. */
-extern void nxatoms_of_pgtkselect (void);
-
/* Initialization and marking implemented in pgtkterm.c */
-extern void init_pgtkterm (void);
extern void mark_pgtkterm (void);
-extern void pgtk_delete_terminal (struct terminal *terminal);
+extern void pgtk_delete_terminal (struct terminal *);
-extern void pgtk_make_frame_visible (struct frame *f);
-extern void pgtk_make_frame_invisible (struct frame *f);
-extern void x_wm_set_size_hint (struct frame *, long, bool);
-extern void x_free_frame_resources (struct frame *);
-extern void pgtk_iconify_frame (struct frame *f);
-extern void pgtk_focus_frame (struct frame *f, bool noactivate);
-extern void pgtk_set_scroll_bar_default_width (struct frame *f);
-extern void pgtk_set_scroll_bar_default_height (struct frame *f);
-extern Lisp_Object x_get_focus_frame (struct frame *frame);
+extern void pgtk_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 *dpyinfo);
+extern void pgtk_frame_rehighlight (struct pgtk_display_info *);
-extern void x_change_tab_bar_height (struct frame *, int);
+extern void pgtk_change_tab_bar_height (struct frame *, int);
-extern struct pgtk_display_info *check_pgtk_display_info (Lisp_Object object);
+extern struct pgtk_display_info *check_pgtk_display_info (Lisp_Object);
-extern void pgtk_default_font_parameter (struct frame *f, Lisp_Object parms);
+extern void pgtk_default_font_parameter (struct frame *, Lisp_Object);
-extern void pgtk_menu_set_in_use (bool in_use);
+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 *f, gchar * str);
-extern void pgtk_enqueue_preedit (struct frame *f, Lisp_Object image_data);
-extern void pgtk_im_focus_in (struct frame *f);
-extern void pgtk_im_focus_out (struct frame *f);
-extern bool pgtk_im_filter_keypress (struct frame *f, GdkEventKey * ev);
-extern void pgtk_im_set_cursor_location (struct frame *f, int x, int y,
- int width, int height);
-extern void pgtk_im_init (struct pgtk_display_info *dpyinfo);
-extern void pgtk_im_finish (struct pgtk_display_info *dpyinfo);
+extern 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 *f, const char **data);
+extern bool xg_set_icon_from_xpm_data (struct frame *, const char **);
-extern bool pgtk_text_icon (struct frame *f, const char *icon_name);
+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);
diff --git a/src/print.c b/src/print.c
index a3c9011215f..4d7e42df1e8 100644
--- a/src/print.c
+++ b/src/print.c
@@ -101,7 +101,7 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1;
struct buffer *old = current_buffer; \
ptrdiff_t old_point = -1, start_point = -1; \
ptrdiff_t old_point_byte = -1, start_point_byte = -1; \
- ptrdiff_t specpdl_count = SPECPDL_INDEX (); \
+ specpdl_ref specpdl_count = SPECPDL_INDEX (); \
bool free_print_buffer = 0; \
bool multibyte \
= !NILP (BVAR (current_buffer, enable_multibyte_characters)); \
@@ -556,7 +556,7 @@ write_string (const char *data, Lisp_Object printcharfun)
void
temp_output_buffer_setup (const char *bufname)
{
- ptrdiff_t count = SPECPDL_INDEX ();
+ specpdl_ref count = SPECPDL_INDEX ();
register struct buffer *old = current_buffer;
register Lisp_Object buf;
@@ -620,7 +620,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 +721,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 +767,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 +834,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 +880,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 +959,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);
}
@@ -944,7 +1066,14 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
errmsg = Fget (errname, Qerror_message);
/* During loadup 'substitute-command-keys' might not be available. */
if (!NILP (Ffboundp (Qsubstitute_command_keys)))
- errmsg = call1 (Qsubstitute_command_keys, errmsg);
+ {
+ /* `substitute-command-keys' may bug out, which would lead
+ to infinite recursion when we're called from
+ skip_debugger, so ignore errors. */
+ Lisp_Object subs = safe_call1 (Qsubstitute_command_keys, errmsg);
+ if (!NILP (subs))
+ errmsg = subs;
+ }
file_error = Fmemq (Qfile_error, error_conditions);
}
@@ -978,7 +1107,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);
}
}
}
@@ -1126,7 +1255,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))
@@ -1138,7 +1266,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);
}
@@ -1150,10 +1278,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) \
@@ -1164,6 +1289,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,
@@ -1175,86 +1372,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,
@@ -1387,6 +1579,7 @@ static bool
print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
char *buf)
{
+ /* First do all the vectorlike types that have a readable syntax. */
switch (PSEUDOVECTOR_TYPE (XVECTOR (obj)))
{
case PVEC_BIGNUM:
@@ -1398,8 +1591,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? */
@@ -1416,6 +1685,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)
@@ -1437,7 +1730,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);
}
@@ -1470,51 +1763,6 @@ 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);
@@ -1578,79 +1826,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);
@@ -1726,7 +1901,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);
@@ -1738,7 +1914,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);
@@ -1750,95 +1927,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:
{
@@ -1921,32 +2016,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;
}
@@ -1970,7 +2165,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;
}
}
}
@@ -2004,8 +2199,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;
@@ -2042,7 +2239,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 ();
@@ -2062,7 +2260,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);
@@ -2115,14 +2314,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))
@@ -2145,8 +2349,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)
{
@@ -2168,14 +2372,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))
{
@@ -2185,9 +2397,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--;
@@ -2197,70 +2409,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;
@@ -2275,10 +2552,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);
}
@@ -2446,6 +2870,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);
@@ -2464,4 +2895,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 9664180cfd4..d6d51b26e11 100644
--- a/src/process.c
+++ b/src/process.c
@@ -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);
@@ -2173,7 +2190,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
&& !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);
@@ -2340,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)
@@ -2348,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);
@@ -2380,21 +2396,21 @@ 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);
@@ -2415,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))
{
@@ -2471,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;
}
@@ -2902,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;
}
@@ -2980,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);
@@ -3079,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);
@@ -3116,21 +3131,21 @@ 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);
@@ -3140,7 +3155,7 @@ usage: (make-serial-process &rest ARGS) */)
update_process_mark (p);
- tem = Fplist_get (contact, QCcoding);
+ tem = plist_get (contact, QCcoding);
val = Qnil;
if (!NILP (tem))
@@ -3179,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;
}
@@ -3194,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. */
@@ -3282,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))
@@ -3341,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))
{
@@ -3464,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);
@@ -3528,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)
@@ -3555,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);
@@ -3570,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)
{
@@ -3579,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
}
@@ -3599,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;
}
@@ -3621,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);
@@ -3879,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;
@@ -3893,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
@@ -3907,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'");
@@ -3921,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;
@@ -3936,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
@@ -3961,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
@@ -4003,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);
@@ -4157,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;
@@ -4178,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
@@ -4208,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;
}
@@ -4380,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;
@@ -4395,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;
@@ -4644,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;
@@ -4761,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;
@@ -4769,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
@@ -4839,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);
@@ -4861,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++;
@@ -4956,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);
@@ -4980,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;
@@ -5177,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 ();
@@ -5479,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;
@@ -6027,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;
@@ -6243,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;
@@ -6254,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);
@@ -6303,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)
@@ -6424,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));
@@ -6934,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)
@@ -7037,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;
@@ -7094,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.
@@ -7128,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))
{
@@ -7437,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;
@@ -8190,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
@@ -8250,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);
}
@@ -8271,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
@@ -8425,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
@@ -8583,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;
@@ -8590,7 +8666,10 @@ 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,
@@ -8603,8 +8682,13 @@ sentinel or a process filter function has an error. */);
"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);
@@ -8657,6 +8741,7 @@ sentinel or a process filter function has an error. */);
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);
@@ -8706,4 +8791,5 @@ sentinel or a process filter function has an error. */);
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 a1adfa2d8ce..9d6bd074e1b 100644
--- a/src/search.c
+++ b/src/search.c
@@ -310,7 +310,7 @@ looking_at_1 (Lisp_Object string, bool posix, bool modify_data)
s2 = 0;
}
- ptrdiff_t count = SPECPDL_INDEX ();
+ specpdl_ref count = SPECPDL_INDEX ();
freeze_buffer_relocation ();
freeze_pattern (cache_entry);
re_match_object = Qnil;
@@ -370,7 +370,6 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start,
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;
@@ -401,17 +400,22 @@ 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,
- (modify_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,
(modify_match_data ? &search_regs : NULL));
+ unbind_to (count, Qnil);
/* Set last_thing_searched only when match data is changed. */
if (modify_match_data)
@@ -480,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;
}
@@ -501,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;
}
@@ -568,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;
@@ -1198,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);
@@ -2827,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 9681a136e4b..0a307828008 100644
--- a/src/sound.c
+++ b/src/sound.c
@@ -361,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. */
@@ -1359,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
index 649cb382948..54bfb7b6c61 100644
--- a/src/sqlite.c
+++ b/src/sqlite.c
@@ -1,4 +1,5 @@
-/*
+/* Support for accessing SQLite databases.
+
Copyright (C) 2021-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,8 +20,7 @@ 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
-*/
+ https://github.com/syohex/emacs-sqlite3 */
#include <config.h>
#include "lisp.h"
@@ -43,6 +43,8 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_open_v2,
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));
@@ -80,6 +82,7 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension,
# 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
@@ -103,6 +106,7 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension,
# 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
@@ -129,6 +133,7 @@ load_dll_functions (HMODULE library)
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);
@@ -240,38 +245,38 @@ DEFUN ("sqlite-open", Fsqlite_open, Ssqlite_open, 0, 1, 0,
If FILE is nil, an in-memory database will be opened instead. */)
(Lisp_Object file)
{
- char *name;
+ 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
{
- CHECK_STRING (file);
- file = ENCODE_FILE (Fexpand_file_name (file, Qnil));
- name = xstrdup (SSDATA (file));
+#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
}
- else
- /* In-memory database. These have to have different names to
- refer to different databases. */
- name = xstrdup (SSDATA (CALLN (Fformat, build_string (":memory:%d"),
- make_int (++db_count))));
sqlite3 *sdb;
- int ret = sqlite3_open_v2 (name,
- &sdb,
- SQLITE_OPEN_FULLMUTEX
- | SQLITE_OPEN_READWRITE
- | SQLITE_OPEN_CREATE
- | (NILP (file) ? SQLITE_OPEN_MEMORY : 0)
-#ifdef SQLITE_OPEN_URI
- | SQLITE_OPEN_URI
-#endif
- | 0, NULL);
-
- if (ret != SQLITE_OK)
+ if (sqlite3_open_v2 (SSDATA (name), &sdb, flags, NULL) != SQLITE_OK)
return Qnil;
- return make_sqlite (false, sdb, NULL, name);
+ return make_sqlite (false, sdb, NULL, xstrdup (SSDATA (name)));
}
DEFUN ("sqlite-close", Fsqlite_close, Ssqlite_close, 1, 1, 0,
@@ -311,10 +316,37 @@ bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object values)
if (EQ (type, Qstring))
{
- Lisp_Object encoded = encode_string (value);
- ret = sqlite3_bind_text (stmt, i + 1,
- SSDATA (encoded), SBYTES (encoded),
- NULL);
+ 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))
{
@@ -428,11 +460,8 @@ row_to_value (sqlite3_stmt *stmt)
break;
case SQLITE_BLOB:
- v =
- code_convert_string_norecord
- (make_unibyte_string (sqlite3_column_blob (stmt, i),
- sqlite3_column_bytes (stmt, i)),
- Qutf_8, false);
+ v = make_unibyte_string (sqlite3_column_blob (stmt, i),
+ sqlite3_column_bytes (stmt, i));
break;
case SQLITE_NULL:
@@ -750,4 +779,6 @@ syms_of_sqlite (void)
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 d682e87cc71..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
@@ -2200,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
@@ -2320,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.
@@ -2335,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;
}
@@ -2348,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. */
@@ -2922,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);
@@ -2951,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)
@@ -2984,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);
@@ -3006,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)
@@ -3046,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 */
@@ -3152,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);
}
@@ -3249,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))
@@ -3294,6 +3287,7 @@ procfs_ttyname (int rdev)
unblock_input ();
return build_string (name);
}
+# endif /* GNU_LINUX */
static uintmax_t
procfs_get_total_memory (void)
@@ -3361,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);
@@ -3390,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");
@@ -3430,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,
@@ -3444,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;
@@ -3499,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);
@@ -3512,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;
@@ -3546,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. */
@@ -3595,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);
@@ -3620,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");
@@ -3708,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;
@@ -3789,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)
@@ -3868,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;
@@ -3877,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;
@@ -3959,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. */
@@ -3982,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;
@@ -3992,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;
@@ -4048,6 +4043,9 @@ system_process_attributes (Lisp_Object pid)
#elif defined DARWIN_OS
+#define HAVE_RUSAGE_INFO_CURRENT (__MAC_OS_X_VERSION_MIN_REQUIRED >= 101000)
+#define HAVE_PROC_PIDINFO (__MAC_OS_X_VERSION_MIN_REQUIRED >= 1050)
+
Lisp_Object
system_process_attributes (Lisp_Object pid)
{
@@ -4056,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;
@@ -4151,6 +4148,7 @@ system_process_attributes (Lisp_Object pid)
attrs = Fcons (Fcons (Qtpgid, INT_TO_INTEGER (proc.kp_eproc.e_tpgid)),
attrs);
+#if HAVE_RUSAGE_INFO_CURRENT
rusage_info_current ri;
if (proc_pid_rusage(proc_id, RUSAGE_INFO_CURRENT, (rusage_info_t *) &ri) == 0)
{
@@ -4164,15 +4162,33 @@ system_process_attributes (Lisp_Object pid)
attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (ri.ri_pageins)), attrs);
}
+#else /* !HAVE_RUSAGE_INFO_CURRENT */
+ struct rusage *rusage = proc.kp_proc.p_ru;
+ if (rusage)
+ {
+ attrs = Fcons (Fcons (Qminflt, INT_TO_INTEGER (rusage->ru_minflt)),
+ attrs);
+ attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (rusage->ru_majflt)),
+ attrs);
+
+ Lisp_Object utime = make_lisp_timeval (rusage->ru_utime);
+ Lisp_Object stime = make_lisp_timeval (rusage->ru_stime);
+ attrs = Fcons (Fcons (Qutime, utime), attrs);
+ attrs = Fcons (Fcons (Qstime, stime), attrs);
+ attrs = Fcons (Fcons (Qtime, Ftime_add (utime, stime)), attrs);
+ }
+#endif /* !HAVE_RUSAGE_INFO_CURRENT */
starttime = proc.kp_proc.p_starttime;
attrs = Fcons (Fcons (Qnice, make_fixnum (proc.kp_proc.p_nice)), attrs);
- attrs = Fcons (Fcons (Qstart, make_lisp_timeval (starttime)), attrs);
+ Lisp_Object start = make_lisp_timeval (starttime);
+ attrs = Fcons (Fcons (Qstart, start), attrs);
- now = current_timespec ();
- t = timespec_sub (now, timeval_to_timespec (starttime));
- attrs = Fcons (Fcons (Qetime, make_lisp_time (t)), attrs);
+ Lisp_Object now = Ftime_convert (Qnil, make_fixnum (1000000));
+ Lisp_Object etime = Ftime_convert (Ftime_subtract (now, start), Qnil);
+ attrs = Fcons (Fcons (Qetime, etime), attrs);
+#if HAVE_PROC_PIDINFO
struct proc_taskinfo taskinfo;
if (proc_pidinfo (proc_id, PROC_PIDTASKINFO, 0, &taskinfo, sizeof (taskinfo)) > 0)
{
@@ -4180,6 +4196,7 @@ system_process_attributes (Lisp_Object pid)
attrs = Fcons (Fcons (Qrss, make_fixnum (taskinfo.pti_resident_size / 1024)), attrs);
attrs = Fcons (Fcons (Qthcount, make_fixnum (taskinfo.pti_threadnum)), attrs);
}
+#endif /* HAVE_PROC_PIDINFO */
#ifdef KERN_PROCARGS2
char args[ARG_MAX];
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 5bcfe7d8a58..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 *) ATTRIBUTE_MALLOC;
+#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 f3b1b2394da..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
@@ -91,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 4c7a90a5773..3bea621dbda 100644
--- a/src/term.c
+++ b/src/term.c
@@ -1632,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;
@@ -2283,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;
@@ -3500,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));
diff --git a/src/termhooks.h b/src/termhooks.h
index 518e855eae1..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,
@@ -80,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
@@ -258,8 +278,9 @@ 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
@@ -306,6 +327,11 @@ enum event_kind
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. */
@@ -354,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
@@ -812,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
diff --git a/src/terminal.c b/src/terminal.c
index 3db80f4b1ff..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;
@@ -622,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, &current_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 f73c69149f7..9df50eaecc3 100644
--- a/src/timefns.c
+++ b/src/timefns.c
@@ -69,10 +69,9 @@ enum { TM_YEAR_BASE = 1900 };
# define FASTER_TIMEFNS 1
#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
@@ -213,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;
@@ -222,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));
@@ -342,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");
@@ -517,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. */
@@ -569,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;
@@ -730,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;
@@ -879,6 +878,16 @@ decode_lisp_time (Lisp_Object specified_time, bool decode_secs_only,
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)
@@ -914,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))
{
@@ -933,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))
@@ -1034,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. */
@@ -1068,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;
@@ -1081,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);
@@ -1162,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))
@@ -1209,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.
@@ -1264,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, false, 0, &t);
- return make_float (t);
+ return make_float (float_time (specified_time));
}
/* Write information into buffer S of size MAXSIZE, according to the
@@ -1456,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.
@@ -1528,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
{
@@ -1601,27 +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.
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.
+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)
@@ -1635,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);
@@ -1643,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));
@@ -1667,7 +1685,7 @@ usage: (encode-time TIME &rest OBSOLESCENT-ARGUMENTS) */)
struct lisp_time lt;
decode_lisp_time (secarg, false, &lt, 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);
@@ -1697,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
@@ -1729,35 +1747,49 @@ bits, and USEC and PSEC are the microsecond and picosecond counts. */)
struct lisp_time t;
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.
@@ -1996,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 e3f56783031..4ec7788442d 100644
--- a/src/verbose.mk.in
+++ b/src/verbose.mk.in
@@ -33,24 +33,45 @@ AM_V_GLOBALS =
AM_V_NO_PD =
AM_V_RC =
else
+
+# 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 = @$(info $ CC $@)
AM_V_CXX = @$(info $ CXX $@)
AM_V_CCLD = @$(info $ CCLD $@)
AM_V_CXXLD = @$(info $ CXXLD $@)
-ifeq ($(HAVE_NATIVE_COMP),yes)
-ifeq ($(NATIVE_DISABLED),1)
-AM_V_ELC = @$(info $ ELC $@)
-AM_V_ELN =
-else
+
+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 " $@;
endif
else
+ifneq (,$(have_working_info))
AM_V_ELC = @$(info $ ELC $@)
+else
+AM_V_ELC = @echo " ELC " $@;
+endif
AM_V_ELN =
endif
+
AM_V_GEN = @$(info $ GEN $@)
AM_V_GLOBALS = @$(info $ GEN globals.h)
AM_V_NO_PD = --no-print-directory
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 0dc874eac40..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)
@@ -4640,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)
{
@@ -4660,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)
@@ -10134,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
@@ -10247,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
@@ -10614,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
@@ -10674,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
@@ -10787,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);
@@ -10807,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;
@@ -10837,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);
@@ -10854,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;
@@ -10887,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);
}
diff --git a/src/w32.h b/src/w32.h
index 4941170bdcf..dc91c595c43 100644
--- a/src/w32.h
+++ b/src/w32.h
@@ -244,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 37f9b813c6c..51540e1880c 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -247,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;
@@ -795,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)
{
@@ -1217,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);
@@ -1233,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));
@@ -1242,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),
@@ -1252,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),
@@ -1263,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),
@@ -1273,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
@@ -1461,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))
@@ -1484,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))
@@ -1802,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
@@ -4093,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);
@@ -4107,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 */
@@ -4154,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 ();
@@ -5506,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);
@@ -5626,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 ();
@@ -5726,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",
@@ -5771,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;
@@ -5791,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;
@@ -5805,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");
@@ -5815,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);
@@ -5858,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);
@@ -5921,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;
@@ -5961,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);
}
@@ -5978,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);
}
@@ -6018,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
@@ -6078,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,
@@ -6155,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. */
@@ -6168,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))
@@ -6941,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;
@@ -6960,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;
@@ -6994,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;
@@ -7033,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);
}
@@ -7089,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)))
@@ -7266,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);
@@ -7310,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*");
@@ -7324,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);
@@ -7510,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);
@@ -7714,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)
{
@@ -7945,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);
@@ -10150,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))
@@ -10177,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
@@ -10427,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,
@@ -10436,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
@@ -10727,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.
@@ -10831,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);
@@ -11201,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 0495099db5c..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
@@ -2385,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);
@@ -2661,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);
@@ -2828,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");
@@ -2837,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/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 e7d2f0f076b..72e634f77c7 100644
--- a/src/w32notify.c
+++ b/src/w32notify.c
@@ -40,8 +40,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
and returns. That causes the WaitForSingleObjectEx function call
inside watch_worker to return, but the thread won't terminate until
the event telling to do so will be signaled. The completion
- routine issued another call to ReadDirectoryChangesW as quickly as
- possible. (Except when it does not, see below.)
+ routine then issues another call to ReadDirectoryChangesW as quickly
+ as possible. (Except when it does not, see below.)
In a GUI session, the WM_EMACS_FILENOTIFY message posted to the
message queue gets dispatched to the main Emacs window procedure,
@@ -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
+ `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
+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 781a19f480f..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)
{
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 700c492cc37..d0577efccc1 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -276,6 +276,62 @@ 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)
@@ -704,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
@@ -794,12 +872,25 @@ w32_draw_fringe_bitmap (struct window *w, struct glyph_row *row,
w32_fill_area (f, hdc, face->background,
p->bx, p->by, p->nx, p->ny);
- if (p->which && p->which < max_fringe_bmp)
+ if (p->which
+ && p->which < max_fringe_bmp
+ && p->which < max_used_fringe_bitmap)
{
HBITMAP pixmap = fringe_bmp[p->which];
HDC compat_hdc;
HANDLE horig_obj;
+ if (!fringe_bmp[p->which])
+ {
+ /* This fringe bitmap is known to fringe.c, but lacks the
+ HBITMAP data 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 HBITMAP now. */
+ gui_define_fringe_bitmap (f, p->which);
+ }
+
compat_hdc = CreateCompatibleDC (hdc);
SaveDC (hdc);
@@ -2564,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;
@@ -2587,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)
@@ -2601,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
@@ -2619,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. */
@@ -2847,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
@@ -2867,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
{
@@ -2877,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);
}
@@ -4784,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. */
@@ -4899,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;
@@ -4944,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;
@@ -5295,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;
@@ -5412,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)
{
@@ -5634,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);
@@ -5758,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;
@@ -5815,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,
@@ -7029,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));
@@ -7325,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;
@@ -7480,6 +7670,7 @@ w32_delete_display (struct w32_display_info *dpyinfo)
if (dpyinfo->palette)
DeleteObject (dpyinfo->palette);
}
+
w32_reset_fringes ();
}
@@ -7719,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 1e7c26b82e9..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",
@@ -1232,7 +1289,7 @@ WINDOW must be a live window and defaults to the selected one.
Clip the number to a reasonable value if out of range.
Return the new number. NCOL should be zero or positive.
-Note that if `automatic-hscrolling' is non-nil, you cannot scroll the
+Note that if `auto-hscroll-mode' is non-nil, you cannot scroll the
window so that the location of point moves off-window. */)
(Lisp_Object window, Lisp_Object ncol)
{
@@ -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,
@@ -1850,13 +1910,24 @@ Return POS. */)
DEFUN ("set-window-start", Fset_window_start, Sset_window_start, 2, 3, 0,
doc: /* Make display in WINDOW start at position POS in WINDOW's buffer.
WINDOW must be a live window and defaults to the selected one. Return
-POS. Optional third arg NOFORCE non-nil inhibits next redisplay from
-overriding motion of point in order to display at this exact start.
+POS.
+
+Optional third arg NOFORCE non-nil prevents next redisplay from
+moving point if displaying the window at POS makes point invisible;
+redisplay will then choose the WINDOW's start position by itself in
+that case, i.e. it will disregard POS if adhering to it will make
+point not visible in the window.
For reliable setting of WINDOW start position, make sure point is
at a position that will be visible when that start is in effect,
otherwise there's a chance POS will be disregarded, e.g., if point
-winds up in a partially-visible line. */)
+winds up in a partially-visible line.
+
+The setting of the WINDOW's start position takes effect during the
+next redisplay cycle, not immediately. If NOFORCE is nil or
+omitted, forcing the display of WINDOW to start at POS cancels
+any setting of WINDOW's vertical scroll (\"vscroll\") amount
+set by `set-window-vscroll' and by scrolling functions. */)
(Lisp_Object window, Lisp_Object pos, Lisp_Object noforce)
{
register struct window *w = decode_live_window (window);
@@ -2106,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);
@@ -2574,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
@@ -2714,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))
;
@@ -2732,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);
@@ -2886,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;
@@ -3011,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;
@@ -3179,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)
@@ -3505,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);
@@ -3538,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,
@@ -3575,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);
@@ -3647,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);
@@ -3815,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);
@@ -3893,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. */
@@ -4012,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);
@@ -4232,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);
@@ -4758,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);
@@ -5245,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));
@@ -5279,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));
@@ -5486,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);
@@ -5498,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);
@@ -5626,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;
}
}
@@ -5636,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;
}
@@ -5645,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)
@@ -5664,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 ();
@@ -5861,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)
@@ -6211,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);
@@ -6307,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))
@@ -6327,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.
@@ -6368,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))
@@ -6393,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))
@@ -6446,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. */
@@ -6542,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;
@@ -6604,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;
}
@@ -6658,6 +6722,7 @@ and redisplay normally--don't erase and redraw the frame. */)
bidi_unshelve_cache (itdata, false);
}
+ unbind_to (count, Qnil);
}
else
{
@@ -6851,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;
@@ -7078,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);
@@ -7232,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;
@@ -7412,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);
@@ -7443,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;
@@ -7959,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.
@@ -7969,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);
@@ -7995,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);
@@ -8124,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))
@@ -8227,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");
@@ -8268,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;
@@ -8327,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,
@@ -8589,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);
@@ -8608,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 141c29e8100..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;
@@ -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 2326df4300d..4089525e10f 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. */
@@ -774,7 +770,7 @@ static bool message_buf_print;
static bool message_cleared_p;
/* A scratch glyph row with contents used for generating truncation
- glyphs. Also used in direct_output_for_insert. */
+ glyphs and overlay-arrow glyphs. */
#define MAX_SCRATCH_GLYPHS 100
static struct glyph_row scratch_glyph_row;
@@ -836,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;
}
@@ -1034,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.) */
@@ -3002,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);
@@ -3226,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))
@@ -3988,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. */
@@ -3999,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;
@@ -4308,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;
@@ -4503,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. */
@@ -5548,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
@@ -5625,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]);
@@ -5826,7 +5841,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
/* 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. */
- ptrdiff_t count1 = SPECPDL_INDEX ();
+ specpdl_ref count1 = SPECPDL_INDEX ();
specbind (Qinhibit_quit, Qt);
face_id2 = lookup_derived_face (it->w, it->f, face_name,
FRINGE_FACE_ID, false);
@@ -5891,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;
@@ -5999,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
@@ -8172,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:
@@ -9190,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))
@@ -9895,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. */
@@ -10216,7 +10258,8 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos
could have both positions after TO_CHARPOS or
both positions before it, due to bidi
reordering.) */
- if (IT_CHARPOS (*it) != to_charpos
+ if (to_charpos > 0
+ && IT_CHARPOS (*it) != to_charpos
&& ((IT_CHARPOS (it_backup) > to_charpos)
== (IT_CHARPOS (*it) > to_charpos)))
{
@@ -10929,6 +10972,7 @@ window_text_pixel_size (Lisp_Object window, Lisp_Object from, Lisp_Object to,
max_y = XFIXNUM (y_limit);
itdata = bidi_shelve_cache ();
+
start_display (&it, w, startp);
int start_y = it.current_y;
@@ -10941,6 +10985,7 @@ window_text_pixel_size (Lisp_Object window, Lisp_Object from, Lisp_Object to,
same directionality. */
it.bidi_p = false;
+ int start_x;
if (vertical_offset != 0)
{
int last_y;
@@ -10974,6 +11019,7 @@ window_text_pixel_size (Lisp_Object window, Lisp_Object from, Lisp_Object to,
+ 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
{
@@ -10983,11 +11029,52 @@ window_text_pixel_size (Lisp_Object window, Lisp_Object from, Lisp_Object to,
reseat_at_previous_visible_line_start (&it);
it.current_x = it.hpos = 0;
if (IT_CHARPOS (it) != start)
- move_it_to (&it, start, -1, -1, -1, MOVE_TO_POS);
+ {
+ void *it1data = NULL;
+ struct it it1;
+
+ SAVE_IT (it1, it, it1data);
+ move_it_to (&it, start, -1, -1, -1, MOVE_TO_POS);
+ /* We could have a display property at START, in which case
+ asking move_it_to to stop at START will overshoot and
+ stop at position after START. So we try again, stopping
+ before START, and account for the width of the last
+ buffer position manually. */
+ if (IT_CHARPOS (it) > start && start > BEGV)
+ {
+ ptrdiff_t it1pos = IT_CHARPOS (it1);
+ int it1_x = it1.current_x;
+
+ RESTORE_IT (&it, &it1, it1data);
+ /* If START - 1 is the beginning of screen line,
+ move_it_to will not move, so we need to use a
+ lower-level move_it_in_display_line subroutine, and
+ tell it to move just 1 pixel, so it stops at the next
+ display element. */
+ if (start - 1 > it1pos)
+ move_it_to (&it, start - 1, -1, -1, -1, MOVE_TO_POS);
+ else
+ move_it_in_display_line (&it, start, it1_x + 1,
+ MOVE_TO_POS | MOVE_TO_X);
+ move_it_to (&it, start - 1, -1, -1, -1, MOVE_TO_POS);
+ start_x = it.current_x;
+ /* If we didn't change our buffer position, the pixel
+ width of what's here was not yet accounted for; do it
+ manually. */
+ if (IT_CHARPOS (it) == start - 1)
+ start_x += it.pixel_width;
+ }
+ else
+ {
+ start_x = it.current_x;
+ bidi_unshelve_cache (it1data, true);
+ }
+ }
+ else
+ start_x = it.current_x;
}
/* Now move to TO. */
- int start_x = it.current_x;
int move_op = MOVE_TO_POS | MOVE_TO_Y;
int to_x = -1;
it.current_y = start_y;
@@ -11163,7 +11250,7 @@ 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
+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.
@@ -11215,7 +11302,7 @@ WINDOW. */)
? current_buffer
: XBUFFER (Fget_buffer (buffer_or_name)));
Lisp_Object buffer, value;
- ptrdiff_t count = SPECPDL_INDEX ();
+ specpdl_ref count = SPECPDL_INDEX ();
XSETBUFFER (buffer, b);
@@ -11377,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));
@@ -11447,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);
@@ -11902,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 ();
@@ -12068,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 ();
@@ -12087,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);
@@ -12155,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
@@ -12535,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);
@@ -12606,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)
@@ -12748,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 ();
@@ -13068,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);
@@ -13084,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)
{
@@ -13120,8 +13216,9 @@ gui_consider_frame_title (Lisp_Object frame)
mode_line_noprop_buf; then display the title. */
record_unwind_protect (unwind_format_mode_line,
format_mode_line_unwind_data
- (NULL, current_buffer, Qnil, false));
+ (f, current_buffer, selected_window, false));
+ Fselect_window (f->selected_window, Qt);
set_buffer_internal_1
(XBUFFER (XWINDOW (f->selected_window)->contents));
fmt = FRAME_ICONIFIED_P (f) ? Vicon_title_format : Vframe_title_format;
@@ -13170,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. */
@@ -13189,12 +13300,10 @@ prepare_menu_bars (void)
{
Lisp_Object this = XCAR (ws);
struct window *w = XWINDOW (this);
- if (w->redisplay
- || XFRAME (w->frame)->redisplay
- || XBUFFER (w->contents)->text->redisplay)
- {
- windows = Fcons (this, windows);
- }
+ /* Cf. conditions for redisplaying a window at the
+ beginning of redisplay_window. */
+ if (!needs_no_redisplay (w))
+ windows = Fcons (this, windows);
}
}
safe__call1 (true, Vpre_redisplay_function, windows);
@@ -13242,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;
@@ -13339,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);
@@ -13509,7 +13618,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;
@@ -13928,6 +14037,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
@@ -13935,9 +14046,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);
@@ -14413,7 +14531,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;
@@ -14576,7 +14694,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;
}
@@ -14586,10 +14704,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;
}
@@ -14598,18 +14716,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
@@ -14847,6 +14965,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
@@ -14854,9 +14974,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);
@@ -15073,11 +15200,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);
@@ -15134,11 +15261,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
@@ -15955,7 +16089,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;
@@ -16000,11 +16133,9 @@ redisplay_internal (void)
if (!fr->glyphs_initialized_p)
return;
-#if defined (USE_X_TOOLKIT) || (defined (USE_GTK) && !defined (HAVE_PGTK)) || defined (HAVE_NS)
+#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS)
if (popup_activated ())
- {
- return;
- }
+ return;
#endif
#if defined (HAVE_HAIKU)
@@ -16018,7 +16149,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 ();
@@ -16221,6 +16352,14 @@ redisplay_internal (void)
/* Point must be on the line that we have info recorded about. */
&& PT >= CHARPOS (tlbufpos)
&& PT <= Z - CHARPOS (tlendpos)
+ /* FIXME: The following condition is only needed when
+ significant parts of the buffer are hidden (e.g., under
+ hs-minor-mode), but there doesn't seem to be a simple way of
+ detecting that, so we always disable the one-line redisplay
+ optimizations whenever display-line-numbers-mode is turned on
+ in the buffer. */
+ && (NILP (Vdisplay_line_numbers)
+ || EQ (Vdisplay_line_numbers, Qvisual))
/* All text outside that line, including its final newline,
must be unchanged. */
&& text_outside_line_unchanged_p (w, CHARPOS (tlbufpos),
@@ -16372,7 +16511,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;
@@ -16600,9 +16740,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. */
@@ -16780,6 +16925,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;
}
@@ -16807,7 +16957,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 ();
@@ -16837,6 +16987,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.
@@ -16883,6 +17040,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;
@@ -17010,9 +17168,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;
}
@@ -17031,6 +17199,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.
@@ -17681,7 +17916,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)));
@@ -17727,7 +17962,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. */
@@ -18557,6 +18792,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)
{
@@ -18706,6 +18955,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.
@@ -18775,7 +19051,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;
@@ -18791,14 +19067,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. */
@@ -18869,6 +19138,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;
@@ -19010,7 +19280,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. */
@@ -19037,6 +19314,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,
@@ -19143,7 +19425,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),
@@ -19193,6 +19476,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.) */
@@ -19214,10 +19499,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");
@@ -19293,6 +19582,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
@@ -19698,7 +19998,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);
@@ -20892,6 +21192,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
@@ -21963,7 +22269,7 @@ get_overlay_arrow_glyph_row (struct window *w, Lisp_Object overlay_arrow_string)
struct buffer *buffer = XBUFFER (w->contents);
struct buffer *old = current_buffer;
const unsigned char *arrow_string = SDATA (overlay_arrow_string);
- ptrdiff_t arrow_len = SCHARS (overlay_arrow_string);
+ ptrdiff_t arrow_len = SBYTES (overlay_arrow_string), char_num = 0;
const unsigned char *arrow_end = arrow_string + arrow_len;
const unsigned char *p;
struct it it;
@@ -21994,7 +22300,7 @@ get_overlay_arrow_glyph_row (struct window *w, Lisp_Object overlay_arrow_string)
p += it.len;
/* Get its face. */
- ilisp = make_fixnum (p - arrow_string);
+ ilisp = make_fixnum (char_num++);
face = Fget_text_property (ilisp, Qface, overlay_arrow_string);
it.face_id = compute_char_face (f, it.char_to_display, face);
@@ -22282,6 +22588,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.
@@ -22317,7 +22630,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;
@@ -22518,7 +22831,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
@@ -22646,7 +22959,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. */
@@ -22680,7 +22993,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);
@@ -22730,7 +23043,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;
@@ -22768,7 +23081,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;
@@ -23416,7 +23729,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);
@@ -23442,7 +23755,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)
{
@@ -23870,7 +24183,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
@@ -24869,15 +25182,17 @@ DEFUN ("bidi-find-overridden-directionality",
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,
@@ -24889,12 +25204,19 @@ 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). 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. */)
+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;
@@ -25872,7 +26194,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);
@@ -25964,7 +26286,7 @@ 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.
@@ -26188,8 +26510,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;
@@ -26640,13 +26962,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);
@@ -26665,7 +26987,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
@@ -26729,7 +27051,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;
@@ -27442,7 +27764,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;
@@ -27715,7 +28037,7 @@ display_string (const char *string, Lisp_Object lisp_string, Lisp_Object face_st
face_string);
if (!NILP (display))
{
- Lisp_Object min_width = Fplist_get (display, Qmin_width);
+ Lisp_Object min_width = plist_get (display, Qmin_width);
if (!NILP (min_width))
display_min_width (it, 0, face_string, min_width);
}
@@ -28049,6 +28371,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)
@@ -28105,7 +28432,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
@@ -28117,14 +28444,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))
@@ -28167,7 +28494,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;
}
@@ -28177,7 +28504,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);
}
@@ -28230,16 +28557,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);
@@ -28920,6 +29247,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))
{
@@ -30407,14 +30735,14 @@ 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'
@@ -30451,17 +30779,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
@@ -30477,13 +30831,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
@@ -30495,7 +30849,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)
@@ -31251,8 +31605,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;
@@ -31270,10 +31624,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;
@@ -31824,14 +32178,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)
@@ -31883,6 +32239,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 ();
}
}
@@ -32447,7 +32806,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;
@@ -33734,7 +34093,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))
@@ -33836,7 +34196,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))
@@ -33851,10 +34211,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;
@@ -33865,7 +34225,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 */
@@ -34351,7 +34711,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,
@@ -34369,10 +34729,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;
@@ -34382,7 +34742,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 */
@@ -35556,6 +35916,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");
@@ -35563,7 +35924,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
@@ -35586,8 +35947,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);
@@ -35928,6 +36294,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.
@@ -36025,7 +36397,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
@@ -36249,7 +36621,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;
@@ -36360,12 +36732,20 @@ 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,
@@ -36428,6 +36808,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;
}
diff --git a/src/xfaces.c b/src/xfaces.c
index 3fd31b7f225..8ae922578ec 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -295,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). */
@@ -475,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);
@@ -500,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);
@@ -888,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;
@@ -1445,9 +1454,9 @@ enum xlfd_field
};
/* 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
- set via set-face-font-sort-order. */
+ 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
+ set via 'internal-set-font-selection-order'. */
static int font_sort_order[4];
@@ -1498,16 +1507,22 @@ If FAMILY is omitted or nil, list all families.
Otherwise, FAMILY must be a string, possibly containing wildcards
`?' and `*'.
If FRAME is omitted or nil, use the selected frame.
+
Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
-FAMILY is the font family name. POINT-SIZE is the size of the
-font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
-width, weight and slant of the font. These symbols are the same as for
-face attributes. FIXED-P is non-nil if the font is fixed-pitch.
-FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
-giving the registry and encoding of the font.
-The result list is sorted according to the current setting of
-the face font sort order. */)
+
+FAMILY is the font family name.
+POINT-SIZE is the size of the font in 1/10 pt.
+WIDTH, WEIGHT, and SLANT are symbols describing the width, weight
+ and slant of the font. These symbols are the same as for face
+ attributes, see `set-face-attribute'.
+FIXED-P is non-nil if the font is fixed-pitch.
+FULL is the full name of the font.
+REGISTRY-AND-ENCODING is a string giving the registry and encoding of
+ the font.
+
+The resulting list is sorted according to the current setting of
+the face font sort order, see `face-font-selection-order'. */)
(Lisp_Object family, Lisp_Object frame)
{
Lisp_Object font_spec, list, *drivers, vec;
@@ -1568,7 +1583,15 @@ the face font sort 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);
@@ -1738,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])
@@ -1798,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
}
@@ -1924,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);
@@ -2064,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. */
@@ -2320,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. */
@@ -3068,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)
@@ -3080,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)
@@ -3092,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))
{
@@ -3120,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)
@@ -3132,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)
@@ -3146,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;
@@ -3165,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;
@@ -3203,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))
@@ -3217,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))
@@ -3238,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;
@@ -3300,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))
@@ -3311,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))
@@ -3325,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
@@ -3342,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
@@ -3359,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
@@ -3374,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);
@@ -3384,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)
@@ -3399,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;
@@ -3456,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 */
@@ -3483,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
@@ -4100,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);
@@ -4150,9 +4240,9 @@ If the optional argument FRAME is given, report on face FACE in that frame.
If FRAME is t, report on the defaults for face FACE (for new frames).
The font default for a face is either nil, or a list
of the form (bold), (italic) or (bold italic).
-If FRAME is omitted or nil, use the selected frame. And, in this case,
-if the optional third argument CHARACTER is given,
-return the font name used for CHARACTER. */)
+If FRAME is omitted or nil, use the selected frame.
+If FRAME is anything but t, and the optional third argument CHARACTER
+is given, return the font name used by FACE for CHARACTER on FRAME. */)
(Lisp_Object face, Lisp_Object frame, Lisp_Object character)
{
if (EQ (frame, Qt))
@@ -4428,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 ();
@@ -4857,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);
@@ -5027,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);
}
@@ -5074,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;
@@ -5148,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;
@@ -5592,7 +5717,6 @@ 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);
@@ -5782,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. */
@@ -5880,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));
@@ -5922,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]);
@@ -5978,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;
@@ -6015,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))
@@ -6026,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;
}
}
}
@@ -6041,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))
{
@@ -6050,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))
{
@@ -6064,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. */
@@ -6100,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);
+ }
}
}
@@ -6408,8 +6581,12 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos,
cached faces since we've looked up these faces, we need to look
them up again. */
if (!default_face)
- default_face = FACE_FROM_ID (f,
- lookup_basic_face (w, f, DEFAULT_FACE_ID));
+ {
+ if (FRAME_FACE_CACHE (f)->used == 0)
+ recompute_basic_faces (f);
+ default_face = FACE_FROM_ID (f,
+ lookup_basic_face (w, f, DEFAULT_FACE_ID));
+ }
}
/* Optimize common cases where we can use the default face. */
@@ -6676,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,
@@ -6820,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
@@ -6830,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;
@@ -6870,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)
@@ -6915,6 +7113,7 @@ 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");
@@ -6937,6 +7136,7 @@ syms_of_xfaces (void)
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
diff --git a/src/xfns.c b/src/xfns.c
index fd3b8752449..331f22763ee 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -40,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"
@@ -604,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,
@@ -681,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;
@@ -722,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)
@@ -745,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)
@@ -770,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:
@@ -797,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;
@@ -849,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)
@@ -864,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))
@@ -872,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);
@@ -898,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,
@@ -1157,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 },
-};
+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 {
+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;
@@ -1256,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
@@ -1409,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 ();
@@ -1439,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));
@@ -1461,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))
@@ -1493,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))
@@ -1847,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));
@@ -1868,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
}
@@ -1880,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));
@@ -1915,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
@@ -2201,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
@@ -2218,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
@@ -2325,6 +2557,67 @@ 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). */
@@ -2336,14 +2629,19 @@ static void xic_preedit_caret_callback (XIC, XPointer, XIMPreeditCaretCallbackSt
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 XIMCallback Xxic_preedit_start_callback = { NULL,
- (void *) xic_preedit_start_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. */
@@ -2643,11 +2941,7 @@ best_xim_style (struct x_display_info *dpyinfo,
int nr_supported = ARRAYELTS (supported_xim_styles);
if (dpyinfo->preferred_xim_style)
- {
- for (j = 0; j < xim->count_styles; ++j)
- if (dpyinfo->preferred_xim_style == xim->supported_styles[j])
- return dpyinfo->preferred_xim_style;
- }
+ return dpyinfo->preferred_xim_style;
for (i = 0; i < nr_supported; ++i)
for (j = 0; j < xim->count_styles; ++j)
@@ -2816,20 +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,
- XNPreeditStartCallback, &Xxic_preedit_start_callback,
- XNPreeditDoneCallback, &Xxic_preedit_done_callback,
- XNPreeditDrawCallback, &Xxic_preedit_draw_callback,
- XNPreeditCaretCallback, &Xxic_preedit_caret_callback,
- 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
}
@@ -2905,6 +3228,7 @@ xic_preedit_start_callback (XIC xic, XPointer client_data,
output->preedit_size = 0;
output->preedit_active = true;
+ output->preedit_caret = 0;
if (output->preedit_chars)
xfree (output->preedit_chars);
@@ -2919,7 +3243,55 @@ 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);
+ }
+ }
}
@@ -2930,6 +3302,7 @@ xic_preedit_done_callback (XIC xic, XPointer client_data,
struct frame *f = x_xic_to_frame (xic);
struct x_output *output;
struct input_event ie;
+ EVENT_INIT (ie);
if (f)
{
@@ -2948,17 +3321,68 @@ xic_preedit_done_callback (XIC xic, XPointer client_data,
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;
- ptrdiff_t nbytes;
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)
{
@@ -2973,17 +3397,16 @@ x_xim_text_to_utf8_unix (XIMText *text, ptrdiff_t *length)
return (char *) wchar_buf;
}
- nbytes = strlen (text->string.multi_byte);
- setup_coding_system (Qutf_8_unix, &coding);
- coding.mode |= (CODING_MODE_LAST_BLOCK
- | CODING_MODE_SAFE_ENCODING);
- coding.source = (const unsigned char *) text->string.multi_byte;
- coding.dst_bytes = 2048;
- coding.destination = xmalloc (2048);
- decode_coding_object (&coding, Qnil, 0, 0, nbytes, nbytes, Qnil);
+ data.coding = &coding;
+ data.source = text->string.multi_byte;
- /* coding.destination has either been allocated by us, or
- reallocated by decode_coding_object. */
+ 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;
@@ -2995,12 +3418,13 @@ xic_preedit_draw_callback (XIC xic, XPointer client_data,
{
struct frame *f = x_xic_to_frame (xic);
struct x_output *output;
- ptrdiff_t text_length;
+ 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)
{
@@ -3010,7 +3434,13 @@ xic_preedit_draw_callback (XIC xic, XPointer client_data,
return;
if (call_data->text)
- text = x_xim_text_to_utf8_unix (call_data->text, &text_length);
+ {
+ 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;
@@ -3118,6 +3548,8 @@ xic_preedit_draw_callback (XIC xic, XPointer client_data,
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. */
@@ -3125,6 +3557,14 @@ xic_preedit_draw_callback (XIC xic, XPointer client_data,
XSETFRAME (ie.frame_or_window, f);
ie.arg = make_string_from_utf8 (output->preedit_chars,
output->preedit_size);
+
+ if (SCHARS (ie.arg))
+ Fput_text_property (make_fixnum (min (SCHARS (ie.arg) - 1,
+ max (0, output->preedit_caret))),
+ make_fixnum (min (SCHARS (ie.arg),
+ max (0, output->preedit_caret) + 1)),
+ Qcursor, Qt, ie.arg);
+
XSETINT (ie.x, 0);
XSETINT (ie.y, 0);
@@ -3141,6 +3581,7 @@ xic_preedit_draw_callback (XIC xic, XPointer client_data,
output->preedit_chars = NULL;
output->preedit_size = 0;
output->preedit_active = false;
+ output->preedit_caret = 0;
}
void
@@ -3171,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))
@@ -3192,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 ();
@@ -3208,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))
@@ -3231,12 +3697,12 @@ 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);
- unblock_input ();
}
#if defined HAVE_XINPUT2
@@ -3246,13 +3712,23 @@ 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 USE_GTK
+#ifndef HAVE_GTK3
mask.deviceid = XIAllMasterDevices;
XISetMask (m, XI_ButtonPress);
@@ -3260,18 +3736,30 @@ setup_xi_event_mask (struct frame *f)
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 /* !USE_GTK */
+#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),
@@ -3284,13 +3772,13 @@ setup_xi_event_mask (struct frame *f)
XISetMask (m, XI_PropertyEvent);
XISetMask (m, XI_HierarchyChanged);
XISetMask (m, XI_DeviceChanged);
-#ifdef XI_TouchBegin
+#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 XI_GesturePinchBegin
+#ifdef HAVE_XINPUT2_4
if (FRAME_DISPLAY_INFO (f)->xi2_version >= 4)
{
XISetMask (m, XI_GesturePinchBegin);
@@ -3303,6 +3791,12 @@ setup_xi_event_mask (struct frame *f)
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
@@ -3481,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);
@@ -3532,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;
@@ -3601,6 +4096,8 @@ x_window (struct frame *f)
}
#endif
+ append_wm_protocols (FRAME_DISPLAY_INFO (f), f);
+
#ifdef HAVE_XINPUT2
if (FRAME_DISPLAY_INFO (f)->supports_xi2)
setup_xi_event_mask (f);
@@ -3636,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);
@@ -3689,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
@@ -3707,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;
@@ -3747,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");
}
@@ -3771,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)
@@ -3821,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),
@@ -3840,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
@@ -3959,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))
@@ -4047,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);
}
@@ -4073,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);
@@ -4087,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;
@@ -4101,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");
@@ -4111,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);
@@ -4140,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))
@@ -4156,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;
@@ -4168,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;
@@ -4249,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;
@@ -4312,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);
}
@@ -4334,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);
}
@@ -4377,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);
@@ -4452,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++;
@@ -4476,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))
{
@@ -4489,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 ();
}
@@ -4556,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))
@@ -4570,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);
}
@@ -4591,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. */
@@ -4663,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:
@@ -4690,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:
@@ -4766,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);
@@ -4848,9 +5412,9 @@ DEFUN ("x-server-input-extension-version", Fx_server_input_extension_version,
doc: /* Return the version of the X Input Extension supported by TERMINAL.
The value is nil if TERMINAL's X server doesn't support the X Input
Extension extension, or if Emacs doesn't support the version present
-on that server. Otherwise, the return value is a list of the the
-major and minor versions of the X Input Extension extension running on
-that server. */)
+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
@@ -4895,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));
}
@@ -4912,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));
}
@@ -4967,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");
@@ -5021,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;
@@ -5074,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) */
@@ -5266,6 +5900,12 @@ x_get_monitor_attributes_xrandr (struct x_display_info *dpyinfo)
#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
@@ -5284,6 +5924,9 @@ x_get_monitor_attributes_xrandr (struct x_display_info *dpyinfo)
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)
{
@@ -5294,6 +5937,7 @@ x_get_monitor_attributes_xrandr (struct x_display_info *dpyinfo)
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)
{
@@ -5302,6 +5946,11 @@ x_get_monitor_attributes_xrandr (struct x_display_info *dpyinfo)
}
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;
@@ -5319,6 +5968,29 @@ x_get_monitor_attributes_xrandr (struct x_display_info *dpyinfo)
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;
@@ -5449,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 */
@@ -5956,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;
@@ -5984,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;
}
@@ -6008,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)))
@@ -6016,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);
}
/**
@@ -6096,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 ();
@@ -6110,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))
@@ -6130,20 +6841,195 @@ The coordinates X and Y are interpreted in pixels relative to a position
&deviceid))
{
XIWarpPointer (FRAME_X_DISPLAY (f), deviceid, None,
- DefaultRootWindow (FRAME_X_DISPLAY (f)),
+ 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, DefaultRootWindow (FRAME_X_DISPLAY (f)),
+ 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
************************************************************************/
@@ -6174,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;
@@ -6243,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);
}
@@ -6395,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 ();
}
@@ -6413,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);
@@ -6489,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
{
@@ -6500,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;
}
@@ -6531,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);
@@ -6548,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;
}
@@ -6674,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,
@@ -6704,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;
@@ -6749,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,
@@ -6779,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;
}
@@ -6791,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;
@@ -6840,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)
@@ -6852,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");
@@ -6919,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;
@@ -6975,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);
}
@@ -7002,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;
@@ -7031,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
@@ -7044,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,
@@ -7052,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,
@@ -7064,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)))
@@ -7081,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");
@@ -7148,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;
@@ -7176,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
@@ -7191,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;
}
@@ -7205,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;
@@ -7270,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))
@@ -7287,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);
@@ -7309,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. */
@@ -7319,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
@@ -7349,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);
@@ -7370,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
@@ -7419,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
@@ -7447,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);
@@ -7463,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);
@@ -7477,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;
@@ -7502,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)))
{
@@ -7523,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;
@@ -7648,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);
@@ -7674,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
@@ -7713,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
}
@@ -7789,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);
@@ -7802,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
@@ -7885,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 ();
- (void) x_dispatch_event (&event, FRAME_X_DISPLAY (f));
+ 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 (&copy.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 (&copy, FRAME_X_DISPLAY (f));
+ }
}
/* Get the result. */
@@ -7956,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);
@@ -8017,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");
@@ -8269,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);
@@ -8288,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);
@@ -8320,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
@@ -8366,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,
@@ -8378,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)
{
@@ -8403,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,
@@ -8560,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
@@ -8574,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
@@ -8682,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;
@@ -8692,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)
@@ -8702,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 d22340fc9bc..6e09a15fa84 100644
--- a/src/xgselect.c
+++ b/src/xgselect.c
@@ -33,6 +33,9 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
static ptrdiff_t threads_holding_glib_lock;
static GMainContext *glib_main_context;
+/* The depth of xg_select suppression. */
+static int xg_select_suppress_count;
+
void
release_select_lock (void)
{
@@ -69,6 +72,23 @@ 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
@@ -96,15 +116,21 @@ 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 HAVE_PGTK
+#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 HAVE_PGTK
+#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;
@@ -153,21 +179,26 @@ xg_select (int fds_lim, fd_set *rfds, fd_set *wfds, fd_set *efds,
tmop = &tmo;
}
-#ifndef HAVE_PGTK
+#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 second event is not via a socket, so there are weird status:
- - socket read buffer is empty
- - a key press event is pending
- In that case, we should not sleep, and dispatch the event immediately.
- Bug#52761
- */
+ /* 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;
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 b755f75da02..c006d2bfe21 100644
--- a/src/xmenu.c
+++ b/src/xmenu.c
@@ -52,6 +52,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#endif
#ifdef HAVE_XINPUT2
+#include <math.h>
#include <X11/extensions/XInput2.h>
#endif
@@ -183,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
@@ -197,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)
{
@@ -221,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, &copy);
+
+ 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 */
@@ -240,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.
@@ -271,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
@@ -281,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;
- x_dispatch_event (&event, event.xany.display);
+ 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 (&copy.xkey, 0);
+
+ if ((keysym == XK_g
+ && (copy.xkey.state & ControlMask) != 0)
+ || keysym == XK_Escape) /* Any escape, ignore modifiers. */
+ popup_activated_flag = 0;
+
+ break;
+ }
+ }
+ }
+ }
+
+ if (cookie_claimed_p)
+ XFreeEventData (dpyinfo->display, &event.xcookie);
+#endif
+
+ x_dispatch_event (&copy, copy.xany.display);
}
}
@@ -293,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 ();
@@ -305,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;
@@ -454,14 +649,22 @@ x_activate_menubar (struct frame *f)
Otherwise some versions of Motif will emit a warning and hang,
and lwlib will fail to destroy the menu window. */
- if (dpyinfo->num_devices)
+ if (dpyinfo->supports_xi2
+ && xi_frame_selected_for (f, XI_ButtonPress))
{
for (int i = 0; i < dpyinfo->num_devices; ++i)
- XIUngrabDevice (dpyinfo->display, dpyinfo->devices[i].device_id,
- CurrentTime);
+ {
+ if (dpyinfo->devices[i].grab)
+ XIUngrabDevice (dpyinfo->display,
+ dpyinfo->devices[i].device_id,
+ CurrentTime);
+ }
}
#endif
- XtDispatchEvent (f->output_data.x->saved_menu_event);
+ /* 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 ();
@@ -742,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);
@@ -1282,7 +1485,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
@@ -1342,6 +1545,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);
@@ -1384,6 +1607,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
@@ -1395,6 +1696,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. */
@@ -1410,6 +1728,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));
@@ -1462,26 +1784,82 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv,
/* Don't allow any geometry request from the user. */
XtSetArg (av[ac], (char *) XtNgeometry, 0); ac++;
XtSetValues (menu, av, ac);
-#if defined HAVE_XINPUT2 && defined USE_LUCID
+
+#ifdef HAVE_XINPUT2
struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
- /* Clear the XI2 grab so lwlib can set a core grab. */
- if (dpyinfo->num_devices)
+ /* 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)
- XIUngrabDevice (dpyinfo->display, dpyinfo->devices[i].device_id,
- CurrentTime);
+ {
+ 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);
@@ -1504,13 +1882,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;
- ptrdiff_t specpdl_count = SPECPDL_INDEX ();
+ USE_SAFE_ALLOCA;
+
+ 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));
@@ -1519,6 +1903,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;
}
@@ -1751,6 +2136,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;
@@ -1765,6 +2152,8 @@ x_menu_show (struct frame *f, int x, int y, int menuflags,
}
unblock_input ();
+
+ SAFE_FREE ();
return Qnil;
}
@@ -1797,7 +2186,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. */
@@ -1852,7 +2243,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. */
@@ -1884,7 +2277,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));
@@ -2036,7 +2429,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);
@@ -2157,7 +2550,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));
@@ -2314,18 +2707,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. */
@@ -2349,8 +2742,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);
@@ -2358,7 +2751,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,
@@ -2367,6 +2766,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..80db0d1fe2a 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);
@@ -448,14 +457,6 @@ x_decline_selection_request (struct selection_input_event *event)
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 +474,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;
-static struct selection_data *converted_selections;
+ /* 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;
-/* "Data" to send a requestor for a failed MULTIPLE subtarget. */
-static Atom conversion_fail_tag;
+ selection_request_stack = frame;
+}
+
+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 +536,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 +614,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 +642,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 +697,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 +802,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 +810,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 +849,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 +879,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 +896,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 +918,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 +954,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 +974,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 +995,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 +1054,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 +1069,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);
}
@@ -1073,7 +1182,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 +1198,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 +1247,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 +1286,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 +1325,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 +1622,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 +1639,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 +1663,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 +1679,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 +2022,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 +2055,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 +2129,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 +2157,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 +2321,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 +2611,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);
-
- if (atom && name) XFree (name);
- if (NILP (ret)) ret = empty_unibyte_string;
+ ret = empty_unibyte_string;
- unblock_input ();
+ if (name)
+ {
+ if (!had_errors_p)
+ ret = build_string (name);
+ xfree (name);
+ }
return ret;
}
@@ -2427,13 +2650,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 +2679,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 +2690,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 +2722,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 +2766,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 +2786,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 +2851,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 +2859,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 +2899,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 +2910,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 +2967,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 +3005,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 +3026,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 71d02e61525..c29a844e0a8 100644
--- a/src/xsettings.c
+++ b/src/xsettings.c
@@ -206,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"
@@ -215,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
@@ -273,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 */
@@ -900,6 +1073,16 @@ init_gsettings (void)
dupstring (&current_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 */
@@ -1021,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,
@@ -1073,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 266526df101..5e5df37062b 100644
--- a/src/xsettings.h
+++ b/src/xsettings.h
@@ -21,15 +21,16 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#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;
-#ifndef HAVE_PGTK
-typedef struct x_display_info Display_Info;
-#else
+#ifdef HAVE_PGTK
typedef struct pgtk_display_info Display_Info;
#endif
@@ -42,5 +43,8 @@ extern const char *xsettings_get_system_font (void);
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 b284fdd3123..ac4e210786e 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>
@@ -50,6 +594,26 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#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
@@ -63,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"
@@ -86,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>
@@ -101,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 */
@@ -134,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;
@@ -147,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. */
@@ -174,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;
@@ -183,8 +794,260 @@ 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
+
+/* 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
{
@@ -219,6 +1082,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 *,
@@ -247,7 +1111,3711 @@ 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_ignore_errors_for_next_request (struct x_display_info *);
+static void x_stop_ignoring_errors (struct x_display_info *);
+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. */
@@ -265,6 +4833,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
@@ -308,13 +4910,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;
-#define FRAME_CR_CONTEXT(f) ((f)->output_data.x->cr_context)
-#define FRAME_CR_SURFACE_DESIRED_WIDTH(f) \
- ((f)->output_data.x->cr_surface_desired_width)
-#define FRAME_CR_SURFACE_DESIRED_HEIGHT(f) \
- ((f)->output_data.x->cr_surface_desired_height)
+ masks = FRAME_X_OUTPUT (f)->xi_masks;
+
+ if (!masks)
+ return false;
+
+ for (i = 0; i < FRAME_X_OUTPUT (f)->num_xi_masks; ++i)
+ {
+ if (masks[i].mask_len >= XIMaskLen (event)
+ && XIMaskIsSet (masks[i].mask, event))
+ return true;
+ }
+
+ return false;
+}
+#endif
+
+static void
+x_toolkit_position (struct frame *f, int x, int y,
+ bool *menu_bar_p, bool *tool_bar_p)
+{
+#ifdef USE_GTK
+ GdkRectangle test_rect;
+ int scale;
+
+ y += (FRAME_MENUBAR_HEIGHT (f)
+ + FRAME_TOOLBAR_TOP_HEIGHT (f));
+ x += FRAME_TOOLBAR_LEFT_WIDTH (f);
+
+ if (FRAME_EXTERNAL_MENU_BAR (f))
+ *menu_bar_p = (x >= 0 && x < FRAME_PIXEL_WIDTH (f)
+ && y >= 0 && y < FRAME_MENUBAR_HEIGHT (f));
+
+ if (FRAME_X_OUTPUT (f)->toolbar_widget)
+ {
+ scale = xg_get_scale (f);
+ test_rect.x = x / scale;
+ test_rect.y = y / scale;
+ test_rect.width = 1;
+ test_rect.height = 1;
+
+ *tool_bar_p = gtk_widget_intersect (FRAME_X_OUTPUT (f)->toolbar_widget,
+ &test_rect, NULL);
+ }
+#elif defined USE_X_TOOLKIT
+ *menu_bar_p = (x > 0 && x < FRAME_PIXEL_WIDTH (f)
+ && (y < 0 && y >= -FRAME_MENUBAR_HEIGHT (f)));
+#else
+ *menu_bar_p = (WINDOWP (f->menu_bar_window)
+ && (x > 0 && x < FRAME_PIXEL_WIDTH (f)
+ && (y > 0 && y < FRAME_MENU_BAR_HEIGHT (f))));
+#endif
+}
+
+static void
+x_update_opaque_region (struct frame *f, XEvent *configure)
+{
+ 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 ();
+}
+
+
+#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)
@@ -335,6 +5055,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);
}
}
@@ -348,16 +5069,62 @@ x_extension_initialize (struct x_display_info *dpyinfo)
dpyinfo->ext_codes = ext_codes;
}
+#endif
+
+#ifdef USE_CAIRO
+
+#define FRAME_CR_CONTEXT(f) ((f)->output_data.x->cr_context)
+#define FRAME_CR_SURFACE_DESIRED_WIDTH(f) \
+ ((f)->output_data.x->cr_surface_desired_width)
+#define FRAME_CR_SURFACE_DESIRED_HEIGHT(f) \
+ ((f)->output_data.x->cr_surface_desired_height)
#endif /* HAVE_CAIRO */
#ifdef HAVE_XINPUT2
-/* Free all XI2 devices on dpyinfo. */
+/* 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 ();
@@ -365,10 +5132,11 @@ x_free_xi_devices (struct x_display_info *dpyinfo)
{
for (int i = 0; i < dpyinfo->num_devices; ++i)
{
- XIUngrabDevice (dpyinfo->display, dpyinfo->devices[i].device_id,
- CurrentTime);
+#ifdef HAVE_XINPUT2_1
xfree (dpyinfo->devices[i].valuators);
+#endif
+#ifdef HAVE_XINPUT2_2
tem = dpyinfo->devices[i].touchpoints;
while (tem)
{
@@ -376,6 +5144,7 @@ x_free_xi_devices (struct x_display_info *dpyinfo)
tem = tem->next;
xfree (last);
}
+#endif
}
xfree (dpyinfo->devices);
@@ -386,6 +5155,130 @@ x_free_xi_devices (struct x_display_info *dpyinfo)
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.
@@ -412,12 +5305,18 @@ x_free_xi_devices (struct x_display_info *dpyinfo)
/* 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;
+ int ndevices, actual_devices;
XIDeviceInfo *infos;
+ actual_devices = 0;
block_input ();
x_free_xi_devices (dpyinfo);
infos = XIQueryDevice (dpyinfo->display,
@@ -431,67 +5330,13 @@ x_init_master_valuators (struct x_display_info *dpyinfo)
return;
}
- int actual_devices = 0;
dpyinfo->devices = xmalloc (sizeof *dpyinfo->devices * ndevices);
for (int i = 0; i < ndevices; ++i)
{
- XIDeviceInfo *device = &infos[i];
-
- if (device->enabled)
- {
- int actual_valuator_count = 0;
- struct xi_device_t *xi_device = &dpyinfo->devices[actual_devices++];
- xi_device->device_id = device->deviceid;
- xi_device->grab = 0;
- xi_device->valuators =
- xmalloc (sizeof *xi_device->valuators * device->num_classes);
- xi_device->touchpoints = NULL;
- xi_device->master_p = (device->use == XIMasterKeyboard
- || device->use == XIMasterPointer);
- xi_device->direct_p = false;
-
- for (int c = 0; c < device->num_classes; ++c)
- {
- switch (device->classes[c]->type)
- {
-#ifdef XIScrollClass /* XInput 2.1 */
- case XIScrollClass:
- {
- XIScrollClassInfo *info =
- (XIScrollClassInfo *) device->classes[c];
- struct xi_scroll_valuator_t *valuator;
-
- if (xi_device->master_p)
- {
- 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;
- }
-
- break;
- }
-#endif
-#ifdef XITouchClass /* XInput 2.2 */
- case XITouchClass:
- {
- XITouchClassInfo *info;
-
- info = (XITouchClassInfo *) device->classes[c];
- xi_device->direct_p = info->mode == XIDirectTouch;
- }
-#endif
- default:
- break;
- }
- }
-
- xi_device->scroll_valuator_count = actual_valuator_count;
- }
+ if (infos[i].enabled)
+ xi_populate_device_from_info (&dpyinfo->devices[actual_devices++],
+ &infos[i]);
}
dpyinfo->num_devices = actual_devices;
@@ -499,63 +5344,58 @@ x_init_master_valuators (struct x_display_info *dpyinfo)
unblock_input ();
}
+#ifdef HAVE_XINPUT2_1
/* Return the delta of the scroll valuator VALUATOR_NUMBER under
- DEVICE_ID 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), or if device_id is
- not known to Emacs, DBL_MAX is returned. Otherwise, the valuator
- is returned in VALUATOR_RETURN. */
+ 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, int device_id,
+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)
{
- block_input ();
+ struct xi_scroll_valuator_t *sv;
+ double delta;
+ int i;
- for (int i = 0; i < dpyinfo->num_devices; ++i)
+ for (i = 0; i < device->scroll_valuator_count; ++i)
{
- struct xi_device_t *device = &dpyinfo->devices[i];
+ sv = &device->valuators[i];
- if (device->device_id == device_id && device->master_p)
+ if (sv->number == valuator_number)
{
- for (int j = 0; j < device->scroll_valuator_count; ++j)
- {
- struct xi_scroll_valuator_t *sv = &device->valuators[j];
+ *valuator_return = sv;
- if (sv->number == valuator_number)
- {
- if (sv->invalid_p)
- {
- sv->current_value = value;
- sv->invalid_p = false;
- *valuator_return = sv;
+ if (sv->increment == 0)
+ return DBL_MAX;
- unblock_input ();
- return DBL_MAX;
- }
- else
- {
- double delta = (sv->current_value - value) / sv->increment;
- sv->current_value = value;
- *valuator_return = sv;
+ if (sv->invalid_p)
+ {
+ sv->current_value = value;
+ sv->invalid_p = false;
- unblock_input ();
- return delta;
- }
- }
+ return DBL_MAX;
}
+ else
+ {
+ delta = (sv->current_value - value) / sv->increment;
+ sv->current_value = value;
- unblock_input ();
- return DBL_MAX;
+ return delta;
+ }
}
}
- unblock_input ();
+ *valuator_return = NULL;
return DBL_MAX;
}
-static struct xi_device_t *
+#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)
@@ -567,7 +5407,7 @@ xi_device_from_id (struct x_display_info *dpyinfo, int deviceid)
return NULL;
}
-#ifdef XI_TouchBegin
+#ifdef HAVE_XINPUT2_2
static void
xi_link_touch_point (struct xi_device_t *device,
@@ -622,15 +5462,18 @@ xi_find_touch_point (struct xi_device_t *device, int detail)
return NULL;
}
-#endif /* XI_TouchBegin */
+#endif /* HAVE_XINPUT2_2 */
+
+#ifdef HAVE_XINPUT2_1
static void
-xi_reset_scroll_valuators_for_device_id (struct x_display_info *dpyinfo, int id)
+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 || !device->master_p)
+ if (!device)
return;
if (!device->scroll_valuator_count)
@@ -639,6 +5482,11 @@ xi_reset_scroll_valuators_for_device_id (struct x_display_info *dpyinfo, int id)
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;
}
@@ -646,6 +5494,8 @@ xi_reset_scroll_valuators_for_device_id (struct x_display_info *dpyinfo, int id)
return;
}
+#endif /* HAVE_XINPUT2_1 */
+
#endif
#ifdef USE_CAIRO
@@ -700,11 +5550,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);
@@ -724,29 +5582,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;
@@ -773,6 +5667,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;
@@ -928,7 +5825,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);
}
@@ -945,7 +5842,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);
}
@@ -996,7 +5893,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);
@@ -1082,11 +5979,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);
{
@@ -1102,7 +6025,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);
@@ -1112,8 +6035,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);
@@ -1129,7 +6115,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);
}
@@ -1137,25 +6123,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)
{
@@ -1163,7 +6263,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);
@@ -1181,15 +6281,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
@@ -1200,7 +6309,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);
@@ -1227,7 +6336,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))
{
@@ -1260,7 +6369,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);
@@ -1364,8 +6473,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
@@ -1374,40 +6481,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);
}
/***********************************************************************
@@ -1440,7 +6530,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);
@@ -1473,13 +6563,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
@@ -1487,13 +6577,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
{
@@ -1501,20 +6591,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)
@@ -1525,13 +6617,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
@@ -1539,9 +6630,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 ();
}
@@ -1577,20 +6679,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:
@@ -1626,10 +6793,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
@@ -1696,9 +6863,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
@@ -1713,7 +6880,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);
@@ -1730,18 +6898,27 @@ 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
- if (p->which && p->which < max_fringe_bmp)
+ if (p->which
+ && p->which < max_fringe_bmp
+ && p->which < max_used_fringe_bitmap)
{
XGCValues gcv;
@@ -1751,6 +6928,16 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring
: f->output_data.x->cursor_pixel)
: face->foreground));
XSetBackground (display, gc, face->background);
+ 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);
+ }
x_cr_draw_image (f, gc, fringe_bmp[p->which], 0, p->dh,
p->wd, p->h, p->x, p->y, p->overlay_p);
XSetForeground (display, gc, gcv.foreground);
@@ -1761,15 +6948,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,
@@ -1777,7 +6989,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)
{
@@ -1785,14 +7005,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)
@@ -1819,6 +7068,118 @@ 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))
+ {
+ 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. */
@@ -1859,7 +7220,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,
@@ -1891,7 +7255,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,
@@ -2035,14 +7403,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
@@ -2066,9 +7454,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;
}
@@ -2163,7 +7552,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
@@ -2371,6 +7761,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
@@ -2586,8 +7980,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,
@@ -2613,12 +8006,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;
@@ -2674,63 +8067,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;
}
@@ -2742,40 +8252,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
{
@@ -2846,7 +8428,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;
@@ -2911,7 +8493,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;
@@ -3037,20 +8619,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
@@ -3074,7 +8698,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)
@@ -3083,7 +8707,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)
@@ -3093,7 +8717,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);
@@ -3102,7 +8726,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,
@@ -3110,10 +8734,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,
@@ -3126,90 +8750,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);
+ 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;
- 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);
- }
+ drawable = FRAME_X_DRAWABLE (f);
+ dpy = FRAME_X_DISPLAY (f);
- /* Left. */
- if (left_p)
- {
- if (vwidth == 1)
- XDrawLine (dpy, drawable, gc, left_x, top_y + 1, left_x, bottom_y);
-
- 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);
+
+ if (bot_p && hwidth > 1)
+ XDrawLine (dpy, drawable, black_gc, left_x, bottom_y,
+ right_x + 1, bottom_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 (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
}
@@ -3235,21 +8887,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);
@@ -3333,14 +8989,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);
@@ -3663,7 +9320,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
@@ -3713,14 +9370,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),
@@ -3745,12 +9404,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
@@ -3869,15 +9551,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);
}
@@ -3897,15 +9581,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);
@@ -3932,7 +9621,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);
@@ -3945,7 +9634,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;
@@ -3955,7 +9644,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 */
@@ -4105,6 +9794,21 @@ 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);
@@ -4115,14 +9819,14 @@ x_draw_glyph_string (struct glyph_string *s)
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);
}
}
@@ -4131,8 +9835,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;
@@ -4155,12 +9863,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)
@@ -4168,7 +9877,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
@@ -4188,12 +9899,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;
@@ -4201,7 +9916,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);
@@ -4209,7 +9925,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);
}
}
@@ -4221,7 +9938,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);
@@ -4229,7 +9946,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);
}
}
@@ -4251,7 +9968,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);
@@ -4259,7 +9976,7 @@ 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);
}
}
@@ -4319,6 +10036,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. */
@@ -4348,13 +10073,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)
@@ -4365,20 +10092,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
}
@@ -4425,6 +10184,7 @@ x_show_hourglass (struct frame *f)
if (!x->hourglass_window)
{
+#ifndef USE_XCB
unsigned long mask = CWCursor;
XSetWindowAttributes attrs;
#ifdef USE_GTK
@@ -4437,12 +10197,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
}
}
}
@@ -4457,10 +10246,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;
}
}
@@ -4470,48 +10265,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));
@@ -4519,115 +10281,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
@@ -4799,6 +10546,14 @@ x_scroll_run (struct window *w, struct run *run)
}
#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))
{
@@ -4818,6 +10573,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
@@ -4861,6 +10628,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
@@ -4870,10 +10641,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);
@@ -4882,17 +10653,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);
}
@@ -4907,6 +10684,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)
{
@@ -4914,6 +10705,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);
@@ -4926,12 +10728,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)
{
@@ -4947,7 +10865,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)
@@ -4963,10 +10892,21 @@ 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);
}
@@ -5025,6 +10965,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
@@ -5040,6 +11041,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)
@@ -5161,10 +11169,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.
@@ -5198,27 +11952,26 @@ x_detect_focus_change (struct x_display_info *dpyinfo, struct frame *frame,
#ifdef HAVE_XINPUT2
case GenericEvent:
{
- XIEvent *xi_event = (XIEvent *) event->xcookie.data;
+ 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;
-#ifdef USE_GTK
if (xi_event->evtype == XI_FocusIn
|| xi_event->evtype == XI_FocusOut)
x_focus_changed ((xi_event->evtype == XI_FocusIn
? FocusIn : FocusOut),
- FOCUS_EXPLICIT,
- dpyinfo, frame, bufp);
- else
-#endif
- if ((xi_event->evtype == XI_Enter
- || xi_event->evtype == XI_Leave)
- && (((XIEnterEvent *) xi_event)->detail
- != XINotifyInferior)
- && ((XIEnterEvent *) xi_event)->focus
- && !(focus_state & FOCUS_EXPLICIT))
+ ((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,
@@ -5236,8 +11989,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 ?
@@ -5257,12 +12010,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
@@ -5323,13 +12085,9 @@ x_find_modifier_meanings (struct x_display_info *dpyinfo)
int syms_per_code;
XModifierKeymap *mods;
#ifdef HAVE_XKB
- Atom meta;
- Atom super;
- Atom hyper;
- Atom shiftlock;
- Atom alt;
int i;
int found_meta_p = false;
+ uint vmodmask;
#endif
dpyinfo->meta_mod_mask = 0;
@@ -5338,33 +12096,28 @@ x_find_modifier_meanings (struct x_display_info *dpyinfo)
dpyinfo->super_mod_mask = 0;
dpyinfo->hyper_mod_mask = 0;
- XDisplayKeycodes (dpyinfo->display, &min_code, &max_code);
-
#ifdef HAVE_XKB
- if (dpyinfo->xkb_desc)
+ if (dpyinfo->xkb_desc
+ && dpyinfo->xkb_desc->server)
{
- meta = XInternAtom (dpyinfo->display, "Meta", False);
- super = XInternAtom (dpyinfo->display, "Super", False);
- hyper = XInternAtom (dpyinfo->display, "Hyper", False);
- shiftlock = XInternAtom (dpyinfo->display, "ShiftLock", False);
- alt = XInternAtom (dpyinfo->display, "Alt", False);
-
for (i = 0; i < XkbNumVirtualMods; i++)
{
- uint vmodmask = dpyinfo->xkb_desc->server->vmods[i];
+ vmodmask = dpyinfo->xkb_desc->server->vmods[i];
- if (dpyinfo->xkb_desc->names->vmods[i] == meta)
+ if (dpyinfo->xkb_desc->names->vmods[i] == dpyinfo->Xatom_Meta)
{
dpyinfo->meta_mod_mask |= vmodmask;
- found_meta_p = vmodmask;
+
+ if (vmodmask)
+ found_meta_p = true;
}
- else if (dpyinfo->xkb_desc->names->vmods[i] == alt)
+ else if (dpyinfo->xkb_desc->names->vmods[i] == dpyinfo->Xatom_Alt)
dpyinfo->alt_mod_mask |= vmodmask;
- else if (dpyinfo->xkb_desc->names->vmods[i] == super)
+ else if (dpyinfo->xkb_desc->names->vmods[i] == dpyinfo->Xatom_Super)
dpyinfo->super_mod_mask |= vmodmask;
- else if (dpyinfo->xkb_desc->names->vmods[i] == hyper)
+ else if (dpyinfo->xkb_desc->names->vmods[i] == dpyinfo->Xatom_Hyper)
dpyinfo->hyper_mod_mask |= vmodmask;
- else if (dpyinfo->xkb_desc->names->vmods[i] == shiftlock)
+ else if (dpyinfo->xkb_desc->names->vmods[i] == dpyinfo->Xatom_ShiftLock)
dpyinfo->shift_lock_mask |= vmodmask;
}
@@ -5384,9 +12137,19 @@ x_find_modifier_meanings (struct x_display_info *dpyinfo)
}
#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
@@ -5472,8 +12235,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
@@ -5576,13 +12348,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;
@@ -5594,8 +12379,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;
@@ -5607,10 +12400,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;
@@ -5620,6 +12423,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;
@@ -5627,6 +12431,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;
@@ -5641,6 +12446,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. */
@@ -5652,6 +12458,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.
@@ -5677,8 +12557,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 ();
@@ -5733,9 +12614,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
@@ -5743,7 +12626,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. */
@@ -5769,6 +12653,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
@@ -5831,8 +12731,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
@@ -5848,12 +12760,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 ();
@@ -5863,7 +12791,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)
{
@@ -5876,7 +12804,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
@@ -5886,7 +12814,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;
@@ -5922,9 +12849,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)
{
@@ -6103,6 +13030,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
@@ -6120,8 +13076,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
@@ -6151,7 +13111,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 ();
}
@@ -6646,6 +13607,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
@@ -6847,6 +13832,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
@@ -7233,6 +14242,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)
@@ -7261,7 +14273,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 */
@@ -7335,7 +14391,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;
@@ -7385,10 +14445,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)
@@ -7402,20 +14474,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 ();
}
@@ -7437,6 +14527,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
@@ -7857,29 +14952,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 ();
}
@@ -7895,8 +15040,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 ();
@@ -7914,11 +15065,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;
@@ -7934,8 +15089,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;
@@ -7947,9 +15102,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;
@@ -7965,8 +15120,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;
@@ -7993,6 +15148,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;
@@ -8011,6 +15167,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
@@ -8161,6 +15335,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.
@@ -8168,9 +15352,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 */
}
@@ -8205,13 +15407,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.
@@ -8229,18 +15424,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. */
@@ -8267,6 +15515,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)
@@ -8298,9 +15580,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)
{
@@ -8319,28 +15601,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
@@ -8357,7 +15663,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
{
@@ -8373,6 +15680,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.
@@ -8396,7 +16295,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_
@@ -8405,7 +16303,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;
@@ -8414,10 +16323,10 @@ handle_one_xevent (struct x_display_info *dpyinfo,
inev.ie.kind = NO_EVENT;
inev.ie.arg = Qnil;
-#ifdef HAVE_XKB
- if (event->type != dpyinfo->xkb_event_type)
+ /* Ignore events coming from various extensions, such as XFIXES and
+ XKB. */
+ if (event->type < LASTEvent)
{
-#endif
#ifdef HAVE_XINPUT2
if (event->type != GenericEvent)
#endif
@@ -8426,11 +16335,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
else
any = NULL;
#endif
-#ifdef HAVE_XKB
}
else
any = NULL;
-#endif
if (any && any->wait_event_type == event->type)
any->wait_event_type = 0; /* Indicates we got it. */
@@ -8439,6 +16346,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)
{
@@ -8520,15 +16593,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;
}
@@ -8556,9 +16713,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 */
@@ -8574,7 +16735,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;
@@ -8613,38 +16778,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;
@@ -8659,13 +16842,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);
@@ -8708,6 +16975,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;
@@ -8718,8 +17106,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;
@@ -8732,10 +17138,6 @@ 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;
@@ -8759,15 +17161,22 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (!FRAME_VISIBLE_P (f))
{
block_input ();
- /* The following two are commented out to avoid that a
- plain invisible frame gets reported as iconified. That
- problem occurred first for Emacs 26 and is described in
- https://lists.gnu.org/archive/html/emacs-devel/2017-02/msg00133.html. */
-/** SET_FRAME_VISIBLE (f, 1); **/
-/** SET_FRAME_ICONIFIED (f, false); **/
+ /* By default, do not set the frame's visibility here, see
+ https://lists.gnu.org/archive/html/emacs-devel/2017-02/msg00133.html.
+ The default behavior can be overridden by setting
+ 'x-set-frame-visibility-more-laxly' (Bug#49955,
+ Bug#53298). */
+ if (EQ (x_set_frame_visibility_more_laxly, Qexpose)
+ || EQ (x_set_frame_visibility_more_laxly, Qt))
+ {
+ SET_FRAME_VISIBLE (f, 1);
+ 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 ();
@@ -8792,6 +17201,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. */
@@ -8806,8 +17221,10 @@ handle_one_xevent (struct x_display_info *dpyinfo,
#endif
}
+#ifdef HAVE_XDBE
if (!FRAME_GARBAGED_P (f))
show_back_buffer (f);
+#endif
}
else
{
@@ -8855,8 +17272,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;
@@ -8866,9 +17295,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)
{
@@ -8882,6 +17328,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. */
@@ -8913,6 +17387,25 @@ handle_one_xevent (struct x_display_info *dpyinfo,
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. */
@@ -8921,8 +17414,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
@@ -8961,7 +17455,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);
@@ -8978,7 +17474,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);
@@ -8987,9 +17485,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. */
@@ -9046,10 +17545,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
@@ -9081,20 +17599,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,
@@ -9113,13 +17652,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,
@@ -9130,19 +17712,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;
}
@@ -9154,6 +17748,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;
}
@@ -9163,158 +17769,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. */
-
- /* 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);
- /* 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);
- }
+ Fput_text_property (make_fixnum (0), make_fixnum (nbytes),
+ Qcoding, coding, inev.ie.arg);
- count += nchars;
+#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);
- inev.ie.kind = NO_EVENT; /* Already stored above. */
+ if (source)
+ inev.ie.device = source->name;
+ }
+#endif
+ }
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. */
@@ -9324,7 +17962,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
@@ -9335,8 +17972,11 @@ 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
{
@@ -9366,46 +18006,61 @@ handle_one_xevent (struct x_display_info *dpyinfo,
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;
case FocusIn:
-#ifndef USE_GTK
+#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/deconifying. Check here if we
+ a MapNotify when unminimizing/deiconifying. Check here if we
are deiconizing a window (Bug42655).
- But don't do that on GTK since it may cause a plain invisible
- frame get reported as iconified, compare
+ 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. */
- 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);
- }
+ 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);
goto OTHER;
case LeaveNotify:
+ 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);
@@ -9417,14 +18072,25 @@ handle_one_xevent (struct x_display_info *dpyinfo,
}
}
#endif
- x_display_set_last_user_time (dpyinfo, event->xcrossing.time);
- x_detect_focus_change (dpyinfo, any, event, &inev.ie);
+ if (x_top_window_to_frame (dpyinfo, event->xcrossing.window))
+ x_detect_focus_change (dpyinfo, any, event, &inev.ie);
+
+#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);
-#if defined HAVE_X_TOOLKIT && defined HAVE_XINPUT2
+#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. */
+ 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
@@ -9442,13 +18108,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;
@@ -9458,7 +18131,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;
@@ -9470,8 +18144,235 @@ 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
@@ -9499,8 +18400,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
@@ -9522,7 +18433,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
@@ -9559,6 +18470,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;
@@ -9580,15 +18492,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)
@@ -9598,6 +18637,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
@@ -9618,7 +18659,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);
@@ -9626,6 +18667,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
@@ -9641,15 +18683,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;
}
@@ -9673,6 +18714,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
@@ -9724,18 +18766,32 @@ 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->xmotion.window);
+ struct xwidget_view *xvw = xwidget_view_from_window (event->xbutton.window);
if (xvw)
{
@@ -9759,12 +18815,182 @@ handle_one_xevent (struct x_display_info *dpyinfo,
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,
@@ -9789,7 +19015,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)
@@ -9821,7 +19077,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
@@ -9835,7 +19093,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)
@@ -9867,12 +19126,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 */
}
@@ -9898,11 +19157,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. */
@@ -9917,12 +19175,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;
@@ -9931,6 +19202,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:
@@ -9958,16 +19232,23 @@ 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
@@ -9979,18 +19260,6 @@ handle_one_xevent (struct x_display_info *dpyinfo,
}
XIDeviceEvent *xev = (XIDeviceEvent *) xi_event;
- XILeaveEvent *leave = (XILeaveEvent *) xi_event;
- XIEnterEvent *enter = (XIEnterEvent *) xi_event;
- XIFocusInEvent *focusin = (XIFocusInEvent *) xi_event;
- XIFocusOutEvent *focusout = (XIFocusOutEvent *) xi_event;
- XIValuatorState *states;
- double *values;
- bool found_valuator = false;
-
- /* A fake XMotionEvent for x_note_mouse_movement. */
- XMotionEvent ev;
- /* A fake XButtonEvent for x_construct_mouse_click. */
- XButtonEvent bv;
if (!xi_event)
{
@@ -10001,46 +19270,206 @@ handle_one_xevent (struct x_display_info *dpyinfo,
switch (event->xcookie.evtype)
{
case XI_FocusIn:
- any = x_any_window_to_frame (dpyinfo, focusin->event);
-#ifndef 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/deconifying. Check here if we
- are deiconizing a window (Bug42655).
-
- But don't do that 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. */
- 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);
- }
+ {
+ 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 */
- x_detect_focus_change (dpyinfo, any, event, &inev.ie);
- goto XI_OTHER;
+ {
+ 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:
- any = x_any_window_to_frame (dpyinfo, focusout->event);
- x_detect_focus_change (dpyinfo, any, event, &inev.ie);
- goto XI_OTHER;
- case XI_Enter:
- any = x_any_window_to_frame (dpyinfo, enter->event);
- ev.x = lrint (enter->event_x);
- ev.y = lrint (enter->event_y);
- ev.window = leave->event;
+ {
+ 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);
- x_display_set_last_user_time (dpyinfo, xi_event->time);
- 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);
-#else
- bool xwidget_view = false;
+ 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
@@ -10054,130 +19483,133 @@ handle_one_xevent (struct x_display_info *dpyinfo,
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
- re-enters a frame after its valuators have potentially
- been changed elsewhere. */
- if (enter->detail != XINotifyInferior
- && enter->mode != XINotifyPassiveUngrab
- /* See the comment under FocusIn in
- `x_detect_focus_change'. The main relevant culprit
- these days seems to be XFCE. */
- && enter->mode != XINotifyUngrab
- && (xwidget_view
- || (any && enter->event == FRAME_X_WINDOW (any))))
- xi_reset_scroll_valuators_for_device_id (dpyinfo, enter->deviceid);
-
-#ifdef HAVE_XWIDGETS
- if (xwidget_view)
- {
- /* Don't send an enter event to the xwidget if the
- first button is pressed, to avoid it releasing
- the passive grab. I don't know why that happens,
- but this workaround makes dragging to select text
- work again. */
- if (!(enter->buttons.mask_len
- && XIMaskIsSet (enter->buttons.mask, 1)))
- xwidget_motion_or_crossing (xwidget_view, event);
-
- goto XI_OTHER;
- }
+ 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
- }
-
- f = any;
-
- if (f && x_mouse_click_focus_ignore_position)
- ignore_next_mouse_click_timeout = xi_event->time + 200;
- /* EnterNotify counts as mouse movement,
- so update things that depend on mouse position. */
- if (f && !f->output_data.x->hourglass_p)
- x_note_mouse_movement (f, &ev);
-#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);
-#endif
- goto XI_OTHER;
- case XI_Leave:
- ev.x = lrint (leave->event_x);
- ev.y = lrint (leave->event_y);
- ev.window = leave->event;
- any = x_any_window_to_frame (dpyinfo, leave->event);
+ 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);
+ {
+ struct xwidget_view *xvw
+ = xwidget_view_from_window (leave->event);
- if (xvw)
- {
- *finish = X_EVENT_DROP;
- xwidget_motion_or_crossing (xvw, event);
+ if (xvw)
+ {
+ *finish = X_EVENT_DROP;
+ xwidget_motion_or_crossing (xvw, event);
- goto XI_OTHER;
- }
- }
+ goto XI_OTHER;
+ }
+ }
#endif
- x_display_set_last_user_time (dpyinfo, xi_event->time);
- x_detect_focus_change (dpyinfo, any, event, &inev.ie);
+ if (any)
+ x_detect_focus_change (dpyinfo, any, event, &inev.ie);
#ifndef USE_X_TOOLKIT
- f = x_top_window_to_frame (dpyinfo, leave->event);
+ 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);
+ /* 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)
- {
- if (f == hlinfo->mouse_face_mouse_frame)
- {
- /* If we move outside the frame, then we're
- certainly no longer on any text in the frame. */
- clear_mouse_face (hlinfo);
- hlinfo->mouse_face_mouse_frame = 0;
- }
- /* Generate a nil HELP_EVENT to cancel a help-echo.
- Do it only if there's something to cancel.
- Otherwise, the startup message is cleared when
- the mouse leaves the frame. */
- if (any_help_event_p)
- do_help = -1;
- }
+ 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);
+ /* 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;
+ goto XI_OTHER;
+ }
+
case XI_Motion:
{
- struct xi_device_t *device;
- bool touch_end_event_seen = false;
-
+ 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 || !device->master_p)
+ if (!device)
goto XI_OTHER;
-#ifdef XI_TouchBegin
- if (xev->flags & XIPointerEmulated
- && dpyinfo->xi2_version >= 2)
+#ifdef HAVE_XINPUT2_2
+ if (xev->flags & XIPointerEmulated)
goto XI_OTHER;
#endif
- x_display_set_last_user_time (dpyinfo, xi_event->time);
+ 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++)
{
@@ -10187,26 +19619,79 @@ handle_one_xevent (struct x_display_info *dpyinfo,
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, xev->deviceid,
+ 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)
{
- /* FIXME: figure out what in GTK is
- causing interval values to jump by
- >100 at the end of a touch sequence
- when an xwidget gets a scroll event
- where is_stop is TRUE. */
- if (fabs (delta) > 100)
- continue;
if (val->horizontal)
xv_total_x += delta;
else
@@ -10216,15 +19701,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
continue;
}
#endif
- if (!f)
- {
- f = x_any_window_to_frame (dpyinfo, xev->event);
- if (!f)
- goto XI_OTHER;
- }
-
- found_valuator = true;
+ if (delta == 0.0)
+ found_valuator = true;
if (signbit (delta) != signbit (val->emacs_value))
val->emacs_value = 0;
@@ -10236,28 +19715,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
&& (fabs (delta) > 0))
continue;
- bool s = signbit (val->emacs_value);
- inev.ie.kind = (fabs (delta) > 0
- ? (val->horizontal
- ? HORIZ_WHEEL_EVENT
- : WHEEL_EVENT)
- : TOUCH_END_EVENT);
- 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);
-
- if (fabs (delta) > 0)
- {
- inev.ie.modifiers = !s ? up_modifier : down_modifier;
- inev.ie.modifiers
- |= x_x_to_emacs_modifiers (dpyinfo,
- xev->mods.effective);
- }
-
- window = window_from_coordinates (f, xev->event_x,
- xev->event_y, NULL,
+ window = window_from_coordinates (f, real_x, real_y, NULL,
false, false);
if (WINDOWP (window))
@@ -10273,57 +19731,25 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (NUMBERP (Vx_scroll_event_delta_factor))
scroll_unit *= XFLOATINT (Vx_scroll_event_delta_factor);
- if (fabs (delta) > 0)
- {
- if (val->horizontal)
- {
- inev.ie.arg
- = list3 (Qnil,
- make_float (val->emacs_value
- * scroll_unit),
- make_float (0));
- }
- else
- {
- inev.ie.arg = list3 (Qnil, make_float (0),
- make_float (val->emacs_value
- * scroll_unit));
- }
- }
+ if (val->horizontal)
+ total_x += val->emacs_value * scroll_unit;
else
- {
- inev.ie.arg = Qnil;
- }
-
- if (inev.ie.kind != TOUCH_END_EVENT
- || !touch_end_event_seen)
- {
- kbd_buffer_store_event_hold (&inev.ie, hold_quit);
- touch_end_event_seen = inev.ie.kind == TOUCH_END_EVENT;
- }
+ total_y += val->emacs_value * scroll_unit;
+ found_valuator = true;
val->emacs_value = 0;
}
- values++;
}
-
- inev.ie.kind = NO_EVENT;
}
#ifdef HAVE_XWIDGETS
if (xv)
{
- uint state = xev->mods.effective;
+ unsigned int state;
- if (xev->buttons.mask_len)
- {
- if (XIMaskIsSet (xev->buttons.mask, 1))
- state |= Button1Mask;
- if (XIMaskIsSet (xev->buttons.mask, 2))
- state |= Button2Mask;
- if (XIMaskIsSet (xev->buttons.mask, 3))
- state |= Button3Mask;
- }
+ 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,
@@ -10337,20 +19763,105 @@ handle_one_xevent (struct x_display_info *dpyinfo,
goto XI_OTHER;
}
-#endif
- if (found_valuator)
+ else
{
-#ifdef USE_GTK
- if (f && xg_event_is_for_scrollbar (f, event))
- *finish = X_EVENT_DROP;
#endif
- goto XI_OTHER;
+ 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;
@@ -10363,12 +19874,252 @@ handle_one_xevent (struct x_display_info *dpyinfo,
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))
+ 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). */
@@ -10402,20 +20153,23 @@ handle_one_xevent (struct x_display_info *dpyinfo,
{
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))
+ if (!x_note_mouse_movement (f, &ev, source ? source->name : Qnil))
help_echo_string = previous_help_echo_string;
}
else
{
#ifndef USE_TOOLKIT_SCROLL_BARS
struct scroll_bar *bar
- = x_window_to_scroll_bar (xi_event->display, xev->event, 2);
+ = x_window_to_scroll_bar (dpyinfo->display, xev->event, 2);
if (bar)
x_scroll_bar_note_movement (bar, &ev);
@@ -10433,6 +20187,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
do_help = 1;
goto XI_OTHER;
}
+
case XI_ButtonRelease:
case XI_ButtonPress:
{
@@ -10441,37 +20196,301 @@ handle_one_xevent (struct x_display_info *dpyinfo,
Lisp_Object tab_bar_arg = Qnil;
bool tab_bar_p = false;
bool tool_bar_p = false;
- struct xi_device_t *device;
+ 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 (((dpyinfo->xi2_version == 1
- && xev->detail >= 4
- && xev->detail <= 8)
- || (dpyinfo->xi2_version >= 2))
- && xev->flags & XIPointerEmulated)
+ 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, xev->mods.effective, xev->time);
+ 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;
@@ -10481,7 +20500,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
device = xi_device_from_id (dpyinfo, xev->deviceid);
- if (!device || !device->master_p)
+ if (!device)
goto XI_OTHER;
bv.button = xev->detail;
@@ -10489,18 +20508,16 @@ handle_one_xevent (struct x_display_info *dpyinfo,
bv.x = lrint (xev->event_x);
bv.y = lrint (xev->event_y);
bv.window = xev->event;
- bv.state = xev->mods.effective;
+ bv.state = xi_convert_event_state (xev);
bv.time = xev->time;
- memset (&compose_status, 0, sizeof (compose_status));
dpyinfo->last_mouse_glyph_frame = NULL;
- x_display_set_last_user_time (dpyinfo, xev->time);
f = mouse_or_wdesc_frame (dpyinfo, xev->event);
if (f && xev->evtype == XI_ButtonPress
&& !popup_activated ()
- && !x_window_to_scroll_bar (xev->display, xev->event, 2)
+ && !x_window_to_scroll_bar (dpyinfo->display, xev->event, 2)
&& !FRAME_NO_ACCEPT_FOCUS (f))
{
/* When clicking into a child frame or when clicking
@@ -10521,12 +20538,85 @@ handle_one_xevent (struct x_display_info *dpyinfo,
}
#ifdef USE_GTK
- if (f && xg_event_is_for_scrollbar (f, event))
+ 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)))
@@ -10554,12 +20644,22 @@ handle_one_xevent (struct x_display_info *dpyinfo,
int y = bv.y;
window = window_from_coordinates (f, x, y, 0, true, true);
- tool_bar_p = EQ (window, f->tool_bar_window);
+ /* 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
+ handle_tool_bar_click_with_device
(f, x, y, xev->evtype == XI_ButtonPress,
- x_x_to_emacs_modifiers (dpyinfo, bv.state));
+ x_x_to_emacs_modifiers (dpyinfo, bv.state),
+ source ? source->name : Qt);
}
#endif /* !USE_GTK */
@@ -10589,6 +20689,27 @@ handle_one_xevent (struct x_display_info *dpyinfo,
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)
{
@@ -10609,6 +20730,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
device->grab &= ~(1 << xev->detail);
}
+ if (source && inev.ie.kind != NO_EVENT)
+ inev.ie.device = source->name;
+
if (f)
f->mouse_moved = false;
@@ -10633,6 +20757,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
#endif
goto XI_OTHER;
}
+
case XI_KeyPress:
{
int state = xev->mods.effective;
@@ -10644,24 +20769,55 @@ handle_one_xevent (struct x_display_info *dpyinfo,
KeySym keysym;
char copy_buffer[81];
char *copy_bufptr = copy_buffer;
- unsigned char *copy_ubufptr;
int copy_bufsiz = sizeof (copy_buffer);
ptrdiff_t i;
- int nchars, len;
- struct xi_device_t *device;
+ 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 || !device->master_p)
+ if (!device)
goto XI_OTHER;
#if defined (USE_X_TOOLKIT) || defined (USE_GTK)
/* Dispatch XI_KeyPress events when in menu. */
if (popup_activated ())
- goto XI_OTHER;
+ {
+#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, &copy.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
-#ifdef HAVE_X_I18N
+ 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);
@@ -10669,23 +20825,94 @@ handle_one_xevent (struct x_display_info *dpyinfo,
xkey.type = KeyPress;
xkey.serial = xev->serial;
xkey.send_event = xev->send_event;
- xkey.display = xev->display;
+ 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)
{
@@ -10716,11 +20943,6 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (keysym == NoSymbol)
goto XI_OTHER;
- x_display_set_last_user_time (dpyinfo, xev->time);
- ignore_next_mouse_click_timeout = 0;
-
- f = x_any_window_to_frame (dpyinfo, xev->event);
-
/* If mouse-highlight is an integer, input clears out
mouse highlighting. */
if (!hlinfo->mouse_face_hidden && FIXNUMP (Vmouse_highlight)
@@ -10744,16 +20966,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
(see above). */
*finish = X_EVENT_DROP;
#endif
- /* If not using XIM/XIC, and a compose sequence is in progress,
- we break here. Otherwise, chars_matched is always 0. */
- if (compose_status.chars_matched > 0 && nbytes == 0)
- goto XI_OTHER;
-
- memset (&compose_status, 0, sizeof (compose_status));
XSETFRAME (inev.ie.frame_or_window, f);
- inev.ie.modifiers
- = x_x_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), state);
inev.ie.timestamp = xev->time;
#ifdef HAVE_X_I18N
@@ -10764,11 +20978,12 @@ handle_one_xevent (struct x_display_info *dpyinfo,
&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,
@@ -10800,8 +21015,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
copy_bufsiz, &overflow);
if (overflow)
{
- copy_bufptr = alloca ((copy_bufsiz += overflow)
- * sizeof *copy_bufptr);
+ copy_bufptr = SAFE_ALLOCA ((copy_bufsiz += overflow)
+ * sizeof *copy_bufptr);
overflow = 0;
nbytes = XkbTranslateKeySym (dpyinfo->display, &sym,
state & ~mods_rtrn, copy_bufptr,
@@ -10810,16 +21025,37 @@ handle_one_xevent (struct x_display_info *dpyinfo,
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,
- &compose_status);
+ 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)
@@ -10828,6 +21064,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
inev.ie.kind = ASCII_KEYSTROKE_EVENT;
inev.ie.code = keysym;
+ if (source)
+ inev.ie.device = source->name;
+
goto xi_done_keysym;
}
@@ -10838,6 +21077,10 @@ handle_one_xevent (struct x_display_info *dpyinfo,
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;
}
@@ -10853,6 +21096,10 @@ handle_one_xevent (struct x_display_info *dpyinfo,
? ASCII_KEYSTROKE_EVENT
: MULTIBYTE_CHAR_KEYSTROKE_EVENT);
inev.ie.code = XFIXNAT (c);
+
+ if (source)
+ inev.ie.device = source->name;
+
goto xi_done_keysym;
}
@@ -10911,6 +21158,30 @@ handle_one_xevent (struct x_display_info *dpyinfo,
#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. */
@@ -10933,100 +21204,395 @@ handle_one_xevent (struct x_display_info *dpyinfo,
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, 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. */
-
- setup_coding_system (Vlocale_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, (unsigned char *) copy_bufptr,
- nbytes, Qnil);
- nbytes = coding.produced;
- nchars = coding.produced_char;
- copy_bufptr = (char *) coding.destination;
- }
+ inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT;
+ inev.ie.arg = make_unibyte_string (copy_bufptr, nbytes);
- copy_ubufptr = (unsigned char *) copy_bufptr;
+ Fput_text_property (make_fixnum (0), make_fixnum (nbytes),
+ Qcoding, coding, inev.ie.arg);
- /* Convert the input data to a sequence of
- character events. */
- for (i = 0; i < nbytes; i += len)
- {
- int ch;
- if (nchars == nbytes)
- ch = copy_ubufptr[i], len = 1;
- else
- ch = string_char_and_length (copy_ubufptr + 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;
}
-
- inev.ie.kind = NO_EVENT;
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:
- x_display_set_last_user_time (dpyinfo, xev->time);
-#ifdef HAVE_X_I18N
- XKeyPressedEvent xkey;
+#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);
- memset (&xkey, 0, sizeof xkey);
+ /* Some input methods react differently depending on the
+ buttons that are pressed. */
+ xi_convert_button_state (&xev->buttons, &xkey.state);
- xkey.type = KeyRelease;
- xkey.serial = xev->serial;
- xkey.send_event = xev->send_event;
- xkey.display = xev->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.keycode = xev->detail;
- xkey.same_screen = True;
+ xkey.keycode = xev->detail;
+ xkey.same_screen = True;
- x_filter_event (dpyinfo, (XEvent *) &xkey);
+#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:
- x_init_master_valuators (dpyinfo);
- goto XI_OTHER;
-#ifdef XI_TouchBegin
- case XI_TouchBegin:
{
+ 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);
- x_display_set_last_user_time (dpyinfo, xev->time);
+ 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;
@@ -11041,8 +21607,10 @@ handle_one_xevent (struct x_display_info *dpyinfo,
&& xg_event_is_for_menubar (f, event));
if (f && FRAME_X_OUTPUT (f)->toolbar_widget)
{
- test_rect.x = xev->event_x;
- test_rect.y = xev->event_y;
+ 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;
@@ -11056,9 +21624,13 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (f && device->direct_p)
{
*finish = X_EVENT_DROP;
+
x_catch_errors (dpyinfo->display);
- XIAllowTouchEvents (dpyinfo->display, xev->deviceid,
- xev->detail, xev->event, XIAcceptTouch);
+
+ 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,
@@ -11070,16 +21642,20 @@ handle_one_xevent (struct x_display_info *dpyinfo,
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_after_check ();
+
+ x_uncatch_errors ();
}
#ifndef HAVE_GTK3
- else
+ else if (x_input_grab_touch_events)
{
- x_catch_errors (dpyinfo->display);
+ x_ignore_errors_for_next_request (dpyinfo);
XIAllowTouchEvents (dpyinfo->display, xev->deviceid,
xev->detail, xev->event, XIRejectTouch);
- x_uncatch_errors ();
+ x_stop_ignoring_errors (dpyinfo);
}
#endif
}
@@ -11099,14 +21675,17 @@ handle_one_xevent (struct x_display_info *dpyinfo,
goto XI_OTHER;
}
+
case XI_TouchUpdate:
{
- struct xi_device_t *device;
+ struct xi_device_t *device, *source;
struct xi_touch_point_t *touchpoint;
Lisp_Object arg = Qnil;
device = xi_device_from_id (dpyinfo, xev->deviceid);
- x_display_set_last_user_time (dpyinfo, xev->time);
+ 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;
@@ -11136,18 +21715,24 @@ handle_one_xevent (struct x_display_info *dpyinfo,
arg);
}
+ if (source)
+ inev.ie.device = source->name;
+
inev.ie.arg = arg;
}
goto XI_OTHER;
}
+
case XI_TouchEnd:
{
- struct xi_device_t *device;
+ struct xi_device_t *device, *source;
bool unlinked_p;
device = xi_device_from_id (dpyinfo, xev->deviceid);
- x_display_set_last_user_time (dpyinfo, xev->time);
+ 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;
@@ -11162,27 +21747,35 @@ handle_one_xevent (struct x_display_info *dpyinfo,
{
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 XI_GesturePinchBegin
+
+#ifdef HAVE_XINPUT2_4
case XI_GesturePinchBegin:
case XI_GesturePinchUpdate:
{
- x_display_set_last_user_time (dpyinfo, xi_event->time);
-
-#ifdef HAVE_USABLE_XI_GESTURE_PINCH_EVENT
XIGesturePinchEvent *pev = (XIGesturePinchEvent *) xi_event;
- struct xi_device_t *device = xi_device_from_id (dpyinfo, pev->deviceid);
+ 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 || !device->master_p)
+ if (!device)
goto XI_OTHER;
#ifdef HAVE_XWIDGETS
@@ -11196,7 +21789,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
}
#endif
- any = x_any_window_to_frame (dpyinfo, pev->event);
+ any = x_window_to_frame (dpyinfo, pev->event);
if (any)
{
inev.ie.kind = PINCH_EVENT;
@@ -11209,18 +21802,20 @@ handle_one_xevent (struct x_display_info *dpyinfo,
make_float (pev->delta_y),
make_float (pev->scale),
make_float (pev->delta_angle));
+
+ if (source)
+ inev.ie.device = source->name;
}
-#endif
+
/* Once again GTK seems to crash when confronted by
events it doesn't understand. */
*finish = X_EVENT_DROP;
goto XI_OTHER;
}
+
case XI_GesturePinchEnd:
{
- x_display_set_last_user_time (dpyinfo, xi_event->time);
-
-#if defined HAVE_XWIDGETS && HAVE_USABLE_XI_GESTURE_PINCH_EVENT
+#if defined HAVE_XWIDGETS
XIGesturePinchEvent *pev = (XIGesturePinchEvent *) xi_event;
struct xwidget_view *xvw = xwidget_view_from_window (pev->event);
@@ -11234,14 +21829,22 @@ handle_one_xevent (struct x_display_info *dpyinfo,
default:
goto XI_OTHER;
}
+
xi_done_keysym:
#ifdef HAVE_X_I18N
- if (FRAME_XIC (f) && (FRAME_XIC_STYLE (f) & XIMStatusArea))
- xic_set_statusarea (f);
+ 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);
@@ -11251,7 +21854,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
default:
#ifdef HAVE_XKB
- if (event->type == dpyinfo->xkb_event_type)
+ if (dpyinfo->supports_xkb
+ && event->type == dpyinfo->xkb_event_type)
{
XkbEvent *xkbevent = (XkbEvent *) event;
@@ -11276,19 +21880,348 @@ handle_one_xevent (struct x_display_info *dpyinfo,
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);
+ }
- x_find_modifier_meanings (dpyinfo);
+ 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 ? &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;
}
@@ -11299,6 +22232,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))
{
@@ -11323,21 +22262,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;
@@ -11350,7 +22301,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.
@@ -11367,6 +22317,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. */
@@ -11386,8 +22355,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;
@@ -11421,6 +22401,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
@@ -11595,6 +22589,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);
@@ -11622,8 +22619,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 */
{
@@ -11644,7 +22641,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);
@@ -11680,7 +22677,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)
{
@@ -11726,8 +22725,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
}
@@ -11780,11 +22778,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. */
@@ -11844,70 +22850,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
@@ -11916,6 +22989,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));
+}
+
+static 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++;
+}
+
+static 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.
@@ -11931,17 +23133,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
@@ -11952,13 +23157,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 ();
}
@@ -11970,36 +23191,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;
- if (x_error_message->string[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 ();
+
+ /* 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);
+
+ /* 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
@@ -12017,9 +23281,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
@@ -12038,16 +23305,94 @@ static char *error_msg;
static AVOID
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;
+ 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
@@ -12058,13 +23403,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)
@@ -12115,18 +23471,46 @@ 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 (!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 ();
+
if (terminal_list == 0)
- {
- fprintf (stderr, "%s\n", error_msg);
- Fkill_emacs (make_fixnum (70));
- }
+ Fkill_emacs (make_fixnum (70), Qnil);
totally_unblock_input ();
@@ -12147,16 +23531,61 @@ 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
+ /* 51 is X_XIGrabDevice and 52 is X_XIUngrabDevice.
+
+ 53 is X_XIAllowEvents. We handle errors from that here to avoid
+ a sync in handle_one_xevent. */
+ if (dpyinfo && dpyinfo->supports_xi2
+ && event->request_code == dpyinfo->xi2_opcode
+ && (event->minor_code == 51
+ || event->minor_code == 52
+ || event->minor_code == 53))
+ return 0;
#endif
- if (x_error_message)
- x_error_catcher (display, event);
+ stack = x_find_error_handler (display, event);
+
+ if (stack)
+ x_error_catcher (display, event, stack);
else
x_error_quitter (display, event);
return 0;
@@ -12171,7 +23600,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. */
@@ -12183,8 +23613,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);
}
@@ -12202,6 +23633,7 @@ x_io_error_quitter (Display *display)
DisplayString (display));
x_connection_closed (display, buf, true);
}
+
/* Changing the font of the frame. */
@@ -12328,14 +23760,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);
@@ -12362,6 +23794,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;
@@ -12420,9 +23855,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);
@@ -12447,8 +23884,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);
@@ -12563,7 +23999,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
@@ -12646,10 +24082,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
@@ -12657,47 +24128,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)
@@ -12741,22 +24218,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
@@ -12771,6 +24262,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:
*
@@ -12871,7 +24374,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;
@@ -12883,18 +24387,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 ();
@@ -12956,6 +24466,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
@@ -12978,7 +24490,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. */
@@ -13118,8 +24630,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)
@@ -13140,6 +24654,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;
}
@@ -13236,7 +24751,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;
@@ -13253,7 +24768,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;
}
@@ -13267,11 +24781,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
@@ -13296,9 +24816,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
@@ -13460,16 +24986,15 @@ frame_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y)
if (FRAME_DISPLAY_INFO (f)->supports_xi2)
{
- XGrabServer (FRAME_X_DISPLAY (f));
- if (XIGetClientPointer (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ if (XIGetClientPointer (FRAME_X_DISPLAY (f),
+ FRAME_X_WINDOW (f),
&deviceid))
{
- XIWarpPointer (FRAME_X_DISPLAY (f),
- deviceid, None,
- FRAME_X_WINDOW (f),
- 0, 0, 0, 0, pix_x, pix_y);
+ 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));
}
- XUngrabServer (FRAME_X_DISPLAY (f));
}
else
#endif
@@ -13537,20 +25062,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);
}
}
@@ -13570,7 +25107,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
@@ -13580,28 +25117,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 ();
}
@@ -13644,9 +25179,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. */
@@ -13662,6 +25202,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))
@@ -13686,6 +25231,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
@@ -13697,6 +25246,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))
@@ -13720,6 +25288,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));
@@ -13881,6 +25455,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
@@ -13968,9 +25554,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))
@@ -14020,7 +25610,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
@@ -14046,9 +25636,6 @@ x_free_frame_resources (struct frame *f)
#ifdef HAVE_X_I18N
if (FRAME_XIC (f))
free_frame_xic (f);
-
- if (f->output_data.x->preedit_chars)
- xfree (f->output_data.x->preedit_chars);
#endif
#ifdef USE_CAIRO
@@ -14081,9 +25668,19 @@ x_free_frame_resources (struct frame *f)
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);
@@ -14156,9 +25753,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;
@@ -14185,9 +25792,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. */
@@ -14198,12 +26012,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;
@@ -14211,7 +26028,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
@@ -14299,8 +26172,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 */
@@ -14553,96 +26428,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;
@@ -14661,6 +26446,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 ();
@@ -14822,11 +26613,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;
@@ -14840,7 +26638,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);
@@ -14853,7 +26652,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.
@@ -14880,11 +26679,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 ();
@@ -14930,6 +26735,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;
@@ -14944,21 +26788,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");
@@ -14975,6 +26851,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;
@@ -14983,47 +26905,224 @@ 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;
-#ifdef XI_GesturePinchBegin /* XInput 2.4 */
+ 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 XI_BarrierHit /* XInput 2.3 */
+#elif defined HAVE_XINPUT2_3 /* XInput 2.3 */
int minor = 3;
-#elif defined XI_TouchBegin /* XInput 2.2 */
+#elif defined HAVE_XINPUT2_2 /* XInput 2.2 */
int minor = 2;
-#elif defined XIScrollClass /* XInput 2.1 */
+#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
- int fer, fee;
if (XQueryExtension (dpyinfo->display, "XInputExtension",
- &dpyinfo->xi2_opcode, &fer, &fee))
+ &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
- int xrr_event_base, xrr_error_base;
- bool xrr_ok = false;
- xrr_ok = XRRQueryExtension (dpy, &xrr_event_base, &xrr_error_base);
- if (xrr_ok)
+ 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;
@@ -15046,14 +27145,24 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
XkbGroupNamesMask | XkbVirtualModNamesMask,
dpyinfo->xkb_desc);
- XkbSelectEvents (dpyinfo->display,
- XkbUseCoreKbd,
+ XkbSelectEvents (dpyinfo->display, XkbUseCoreKbd,
XkbNewKeyboardNotifyMask | XkbMapNotifyMask,
XkbNewKeyboardNotifyMask | XkbMapNotifyMask);
}
+#endif
- /* Figure out which modifier bits mean what. */
- x_find_modifier_meanings (dpyinfo);
+#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
@@ -15072,11 +27181,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)
@@ -15097,84 +27201,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";
@@ -15182,24 +27216,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
@@ -15207,7 +27248,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);
@@ -15280,13 +27324,13 @@ 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);
-#ifdef HAVE_X_I18N
if (STRINGP (value))
{
if (!strcmp (SSDATA (value), "callback"))
@@ -15299,27 +27343,84 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
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. */
@@ -15328,6 +27429,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. */
@@ -15343,9 +27446,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
@@ -15357,18 +27489,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);
}
@@ -15485,6 +27629,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
@@ -15515,10 +27681,6 @@ x_delete_terminal (struct terminal *terminal)
if (dpyinfo->xkb_desc)
XkbFreeKeyboard (dpyinfo->xkb_desc, XkbAllComponentsMask, True);
#endif
-#ifdef HAVE_XINPUT2
- if (dpyinfo->supports_xi2)
- x_free_xi_devices (dpyinfo);
-#endif
#ifdef USE_GTK
xg_display_close (dpyinfo->display);
#else
@@ -15528,6 +27690,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;
@@ -15549,6 +27714,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. */
@@ -15573,7 +27757,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;
@@ -15613,6 +27799,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;
@@ -15626,6 +27816,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;
@@ -15682,19 +27873,107 @@ init_xterm (void)
/* 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);
+}
+
+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");
#ifdef USE_GTK
xg_default_icon_file = build_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg");
@@ -15732,9 +28011,21 @@ 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.
@@ -15766,6 +28057,8 @@ With MS Windows, Haiku windowing 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.
@@ -15846,4 +28139,131 @@ always uses gtk_window_move and ignores the value of this variable. */);
This option is only effective when Emacs is built with XInput 2
support. */);
Vx_scroll_event_delta_factor = make_float (1.0);
+ DEFSYM (Qexpose, "expose");
+
+ DEFVAR_BOOL ("x-gtk-use-native-input", x_gtk_use_native_input,
+ doc: /* Non-nil means to use GTK for input method support.
+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.
+If this is nil, Emacs is more strict when marking a frame as visible.
+Since this may cause problems on some window managers, this variable can
+be also set as follows: The value `focus-in' means to mark a frame as
+visible also when a FocusIn event is received for it on GTK builds. The
+value `expose' means to mark a frame as visible also when an Expose
+event is received for it on any X build. The value `t' means to mark a
+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;
}
diff --git a/src/xterm.h b/src/xterm.h
index a796f69ddc1..92e88bb50fa 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
@@ -92,6 +106,10 @@ typedef GtkWidget *xt_or_gtk_widget;
#include <X11/XKBlib.h>
#endif
+#ifdef HAVE_XSYNC
+#include <X11/extensions/sync.h>
+#endif
+
#include "dispextern.h"
#include "termhooks.h"
@@ -117,6 +135,7 @@ INLINE_HEADER_BEGIN
| FocusChangeMask \
| LeaveWindowMask \
| EnterWindowMask \
+ | PropertyChangeMask \
| VisibilityChangeMask)
#ifdef HAVE_X11R6_XIM
@@ -128,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. */
@@ -145,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
@@ -155,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
@@ -163,14 +199,24 @@ 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;
@@ -178,7 +224,9 @@ struct xi_scroll_valuator_t
int number;
int horizontal;
};
+#endif
+#ifdef HAVE_XINPUT2_2
struct xi_touch_point_t
{
struct xi_touch_point_t *next;
@@ -186,23 +234,43 @@ struct xi_touch_point_t
int number;
double x, y;
};
+#endif
struct xi_device_t
{
int device_id;
+#ifdef HAVE_XINPUT2_1
int scroll_valuator_count;
- int grab;
- bool master_p;
+#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. */
@@ -236,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;
@@ -265,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. */
@@ -341,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;
@@ -371,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
@@ -406,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.
@@ -426,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;
@@ -438,7 +543,13 @@ struct x_display_info
#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. */
@@ -446,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
@@ -468,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;
@@ -482,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;
@@ -496,17 +630,46 @@ 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
@@ -520,6 +683,17 @@ struct x_display_info
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
@@ -527,6 +701,74 @@ struct x_display_info
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
@@ -550,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
@@ -591,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. */
@@ -618,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;
@@ -643,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
@@ -747,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;
@@ -754,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
{
@@ -794,6 +1078,12 @@ struct x_output
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
};
@@ -828,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
@@ -905,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
@@ -940,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;
@@ -1130,27 +1445,35 @@ 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_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;
@@ -1164,11 +1487,13 @@ 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);
@@ -1178,37 +1503,47 @@ 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
@@ -1218,7 +1553,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
@@ -1226,16 +1561,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);
@@ -1260,18 +1597,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,
@@ -1286,6 +1619,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 **);
@@ -1340,6 +1682,26 @@ extern void x_session_close (void);
#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? */
#define FRAME_X_EMBEDDED_P(f) (FRAME_X_OUTPUT(f)->explicit_parent != 0)
diff --git a/src/xwidget.c b/src/xwidget.c
index 7d6d256a191..8bdfab02fd4 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -40,6 +40,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <JavaScriptCore/JavaScript.h>
#include <cairo.h>
#ifndef HAVE_PGTK
+#include <cairo-xlib.h>
#include <X11/Xlib.h>
#else
#include <gtk/gtk.h>
@@ -61,6 +62,9 @@ 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 *);
@@ -106,7 +110,8 @@ webkit_decide_policy_cb (WebKitWebView *,
WebKitPolicyDecision *,
WebKitPolicyDecisionType,
gpointer);
-static GtkWidget *find_widget_at_pos (GtkWidget *, int, int, int *, int *);
+static GtkWidget *find_widget_at_pos (GtkWidget *, int, int, int *, int *, bool,
+ struct xwidget_view *);
static gboolean run_file_chooser_cb (WebKitWebView *,
WebKitFileChooserRequest *,
gpointer);
@@ -121,11 +126,12 @@ struct widget_search_data
};
static void find_widget (GtkWidget *t, struct widget_search_data *);
-static void mouse_target_changed (WebKitWebView *, WebKitHitTestResult *, guint,
- gpointer);
#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)
@@ -142,7 +148,7 @@ xw_forward_event_translate (GdkEvent *event, struct xwidget_view *xv,
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);
+ &new_x, &new_y, false, NULL);
if (widget)
{
event->any.window = gtk_widget_get_window (widget);
@@ -155,7 +161,7 @@ xw_forward_event_translate (GdkEvent *event, struct xwidget_view *xv,
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);
+ &new_x, &new_y, false, NULL);
if (widget)
{
event->any.window = gtk_widget_get_window (widget);
@@ -168,7 +174,7 @@ xw_forward_event_translate (GdkEvent *event, struct xwidget_view *xv,
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);
+ &new_x, &new_y, false, NULL);
if (widget)
{
event->any.window = gtk_widget_get_window (widget);
@@ -182,7 +188,7 @@ xw_forward_event_translate (GdkEvent *event, struct xwidget_view *xv,
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);
+ &new_x, &new_y, false, NULL);
if (widget)
{
event->any.window = gtk_widget_get_window (widget);
@@ -223,6 +229,13 @@ xw_forward_event_from_view (GtkWidget *widget, GdkEvent *event,
#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)
@@ -252,6 +265,17 @@ xw_translate_x_modifiers (struct x_display_info *dpyinfo,
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",
@@ -402,11 +426,12 @@ fails. */)
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),
@@ -709,7 +734,7 @@ pick_embedded_child (GdkWindow *window, double x, double y,
return NULL;
child = find_widget_at_pos (widget, lrint (x), lrint (y),
- &xout, &yout);
+ &xout, &yout, false, NULL);
if (!child)
return NULL;
@@ -832,15 +857,34 @@ to_embedder (GdkWindow *window, double x, double y,
}
static GdkDevice *
-find_suitable_pointer (struct frame *f)
+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;
- return gdk_seat_get_pointer (seat);
+ 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 *
@@ -918,9 +962,9 @@ find_widget (GtkWidget *widget,
}
}
- 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))
+ 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. */
@@ -954,9 +998,27 @@ find_widget (GtkWidget *widget,
static GtkWidget *
find_widget_at_pos (GtkWidget *w, int x, int y,
- int *new_x, int *new_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;
@@ -978,6 +1040,7 @@ find_widget_at_pos (GtkWidget *w, int x, int y,
return NULL;
}
+#ifdef HAVE_PGTK
static Emacs_Cursor
cursor_for_hit (guint result, struct frame *frame)
{
@@ -1001,9 +1064,7 @@ static void
define_cursors (struct xwidget *xw, WebKitHitTestResult *res)
{
struct xwidget_view *xvw;
-#ifdef HAVE_PGTK
GdkWindow *wdesc;
-#endif
xw->hit_result = webkit_hit_test_result_get_context (res);
@@ -1017,16 +1078,12 @@ define_cursors (struct xwidget *xw, WebKitHitTestResult *res)
if (XXWIDGET (xvw->model) == xw)
{
xvw->cursor = cursor_for_hit (xw->hit_result, xvw->frame);
-#ifdef HAVE_X_WINDOWS
- if (xvw->wdesc != None)
- XDefineCursor (xvw->dpy, xvw->wdesc, xvw->cursor);
-#else
+
if (gtk_widget_get_realized (xvw->widget))
{
wdesc = gtk_widget_get_window (xvw->widget);
gdk_window_set_cursor (wdesc, xvw->cursor);
}
-#endif
}
}
}
@@ -1039,6 +1096,7 @@ mouse_target_changed (WebKitWebView *webview,
{
define_cursors (xw, hitresult);
}
+#endif
static gboolean
run_file_chooser_cb (WebKitWebView *webview,
@@ -1103,23 +1161,49 @@ run_file_chooser_cb (WebKitWebView *webview,
#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 = gdk_event_new (down_p ? GDK_BUTTON_PRESS : GDK_BUTTON_RELEASE);
+ 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;
- target = find_widget_at_pos (model->widgetwindow_osr, x, y, &x, &y);
+ 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. */
@@ -1131,10 +1215,92 @@ xwidget_button_1 (struct xwidget_view *view,
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);
+ 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
@@ -1149,51 +1315,51 @@ xwidget_button (struct xwidget_view *view,
if (button < 4 || button > 8)
xwidget_button_1 (view, down_p, x, y, button, modifier_state, time);
-#ifndef HAVE_XINPUT2
else
-#else
- else if (!FRAME_DISPLAY_INFO (view->frame)->supports_xi2
- || FRAME_DISPLAY_INFO (view->frame)->xi2_version < 1)
-#endif
{
- GdkEvent *xg_event = gdk_event_new (GDK_SCROLL);
- struct xwidget *model = XXWIDGET (view->model);
- GtkWidget *target;
-
- x += view->clip_left;
- y += view->clip_top;
-
- target = find_widget_at_pos (model->widgetwindow_osr, x, y, &x, &y);
-
- if (!target)
- target = model->widget_osr;
-
- xg_event->any.window = gtk_widget_get_window (target);
- g_object_ref (xg_event->any.window); /* The window will be unrefed
- later by gdk_event_free. */
- if (button == 4)
- xg_event->scroll.direction = GDK_SCROLL_UP;
- else if (button == 5)
- xg_event->scroll.direction = GDK_SCROLL_DOWN;
- else if (button == 6)
- xg_event->scroll.direction = GDK_SCROLL_LEFT;
- else
- xg_event->scroll.direction = GDK_SCROLL_RIGHT;
+ 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);
+ 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.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;
+ xg_event->scroll.delta_x = 0;
+ xg_event->scroll.delta_y = 0;
- gtk_main_do_event (xg_event);
- gdk_event_free (xg_event);
+ gtk_main_do_event (xg_event);
+ gdk_event_free (xg_event);
+ }
}
}
@@ -1217,14 +1383,23 @@ xwidget_motion_notify (struct xwidget_view *view,
target = find_widget_at_pos (model->widgetwindow_osr,
lrint (x + view->clip_left),
lrint (y + view->clip_top),
- &target_x, &target_y);
+ &target_x, &target_y,
+ true, view);
if (!target)
{
- target_x = lrint (x);
- target_y = lrint (y);
+ 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);
@@ -1234,7 +1409,7 @@ xwidget_motion_notify (struct xwidget_view *view,
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);
+ xg_event->motion.device = find_suitable_pointer (view->frame, false);
g_object_ref (xg_event->any.window);
@@ -1260,7 +1435,8 @@ xwidget_scroll (struct xwidget_view *view, double x, double y,
target = find_widget_at_pos (model->widgetwindow_osr,
lrint (x + view->clip_left),
lrint (y + view->clip_top),
- &target_x, &target_y);
+ &target_x, &target_y,
+ true, view);
if (!target)
{
@@ -1280,7 +1456,7 @@ xwidget_scroll (struct xwidget_view *view, double x, double y,
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);
+ xg_event->scroll.device = find_suitable_pointer (view->frame, true);
xg_event->scroll.is_stop = stop_p;
g_object_ref (xg_event->any.window);
@@ -1289,7 +1465,7 @@ xwidget_scroll (struct xwidget_view *view, double x, double y,
gdk_event_free (xg_event);
}
-#ifdef HAVE_USABLE_XI_GESTURE_PINCH_EVENT
+#ifdef HAVE_XINPUT2_4
void
xwidget_pinch (struct xwidget_view *view, XIGesturePinchEvent *xev)
{
@@ -1309,7 +1485,8 @@ xwidget_pinch (struct xwidget_view *view, XIGesturePinchEvent *xev)
target = find_widget_at_pos (model->widgetwindow_osr,
lrint (x + view->clip_left),
lrint (y + view->clip_top),
- &target_x, &target_y);
+ &target_x, &target_y,
+ true, view);
if (!target)
{
@@ -1344,7 +1521,7 @@ xwidget_pinch (struct xwidget_view *view, XIGesturePinchEvent *xev)
break;
}
- gdk_event_set_device (xg_event, find_suitable_pointer (view->frame));
+ 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);
@@ -1376,13 +1553,379 @@ xi_translate_notify_detail (int detail)
}
#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;
- int y;
+ int x, y, toplevel_x, toplevel_y;
GtkWidget *target;
#ifdef HAVE_XINPUT2
XIEnterEvent *xev = NULL;
@@ -1400,14 +1943,15 @@ xwidget_motion_or_crossing (struct xwidget_view *view, const XEvent *event)
: (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,
- (event->type == MotionNotify
- ? event->xmotion.x + view->clip_left
- : event->xcrossing.x + view->clip_left),
- (event->type == MotionNotify
- ? event->xmotion.y + view->clip_top
- : event->xcrossing.y + view->clip_top),
- &x, &y);
+ toplevel_x, toplevel_y, &x, &y,
+ true, view);
}
#ifdef HAVE_XINPUT2
else
@@ -1420,9 +1964,11 @@ xwidget_motion_or_crossing (struct xwidget_view *view, const XEvent *event)
? GDK_ENTER_NOTIFY
: GDK_LEAVE_NOTIFY);
target = find_widget_at_pos (model->widgetwindow_osr,
- lrint (xev->event_x + view->clip_left),
- lrint (xev->event_y + view->clip_top),
- &x, &y);
+ (toplevel_x
+ = lrint (xev->event_x + view->clip_left)),
+ (toplevel_y
+ = lrint (xev->event_y + view->clip_top)),
+ &x, &y, true, view);
}
#endif
@@ -1436,19 +1982,35 @@ xwidget_motion_or_crossing (struct xwidget_view *view, const XEvent *event)
if (event->type == MotionNotify)
{
- xg_event->motion.x = x;
- xg_event->motion.y = y;
- xg_event->motion.x_root = event->xmotion.x_root;
- xg_event->motion.y_root = event->xmotion.y_root;
- xg_event->motion.time = event->xmotion.time;
- xg_event->motion.state = event->xmotion.state;
- xg_event->motion.device = find_suitable_pointer (view->frame);
+ 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 = (gdouble) xev->event_x;
- xg_event->crossing.y = (gdouble) xev->event_y;
+ 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;
@@ -1467,11 +2029,45 @@ xwidget_motion_or_crossing (struct xwidget_view *view, const XEvent *event)
xg_event->crossing.state |= GDK_BUTTON3_MASK;
}
- gdk_event_set_device (xg_event, find_suitable_pointer (view->frame));
+ 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;
@@ -1479,7 +2075,8 @@ xwidget_motion_or_crossing (struct xwidget_view *view, const XEvent *event)
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));
+ gdk_event_set_device (xg_event,
+ find_suitable_pointer (view->frame, false));
}
gtk_main_do_event (xg_event);
@@ -1505,7 +2102,8 @@ synthesize_focus_in_event (GtkWidget *offscreen_window)
if (FRAME_WINDOW_P (SELECTED_FRAME ()))
gdk_event_set_device (focus_event,
- find_suitable_pointer (SELECTED_FRAME ()));
+ find_suitable_pointer (SELECTED_FRAME (),
+ false));
g_object_ref (wnd);
@@ -1855,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;
@@ -2132,8 +2730,10 @@ xwidget_init_view (struct xwidget *xww,
xv->wdesc = None;
xv->frame = s->f;
- xv->cursor = cursor_for_hit (xww->hit_result, 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 ();
@@ -2284,7 +2884,7 @@ x_draw_xwidget_glyph_string (struct glyph_string *s)
XISetMask (m, XI_ButtonRelease);
XISetMask (m, XI_Enter);
XISetMask (m, XI_Leave);
-#ifdef XI_GesturePinchBegin
+#ifdef HAVE_XINPUT2_4
if (FRAME_DISPLAY_INFO (s->f)->xi2_version >= 4)
{
XISetMask (m, XI_GesturePinchBegin);
@@ -2406,8 +3006,11 @@ x_draw_xwidget_glyph_string (struct glyph_string *s)
#endif
#if defined HAVE_XINPUT2 || defined HAVE_PGTK
- record_osr_embedder (xv);
- synthesize_focus_in_event (xww->widget_osr);
+ if (!NILP (xww->buffer))
+ {
+ record_osr_embedder (xv);
+ synthesize_focus_in_event (xww->widget_osr);
+ }
#endif
#ifdef USE_GTK
@@ -2756,6 +3359,22 @@ DEFUN ("delete-xwidget-view",
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
@@ -3355,6 +3974,11 @@ syms_of_xwidget (void)
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
}
diff --git a/src/xwidget.h b/src/xwidget.h
index ee74e53c4d1..502beb67650 100644
--- a/src/xwidget.h
+++ b/src/xwidget.h
@@ -118,6 +118,12 @@ struct xwidget_view
#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;
@@ -217,7 +223,7 @@ 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_USABLE_XI_GESTURE_PINCH_EVENT
+#ifdef HAVE_XINPUT2_4
extern void xwidget_pinch (struct xwidget_view *, XIGesturePinchEvent *);
#endif
#endif