summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/.gdbinit15
-rw-r--r--src/Makefile.in63
-rw-r--r--src/alloc.c464
-rw-r--r--src/bidi.c10
-rw-r--r--src/buffer.c206
-rw-r--r--src/buffer.h3
-rw-r--r--src/bytecode.c1000
-rw-r--r--src/callproc.c85
-rw-r--r--src/casefiddle.c68
-rw-r--r--src/ccl.c5
-rw-r--r--src/character.c21
-rw-r--r--src/character.h20
-rw-r--r--src/charset.c26
-rw-r--r--src/chartab.c2
-rw-r--r--src/cm.c2
-rw-r--r--src/coding.c187
-rw-r--r--src/coding.h2
-rw-r--r--src/composite.c13
-rw-r--r--src/conf_post.h117
-rw-r--r--src/cygw32.c4
-rw-r--r--src/data.c40
-rw-r--r--src/dbusbind.c122
-rw-r--r--src/decompress.c6
-rw-r--r--src/dired.c32
-rw-r--r--src/dispextern.h72
-rw-r--r--src/dispnew.c13
-rw-r--r--src/doc.c278
-rw-r--r--src/doprnt.c26
-rw-r--r--src/dynlib.c1
-rw-r--r--src/editfns.c224
-rw-r--r--src/emacs-module.c178
-rw-r--r--src/emacs-module.h9
-rw-r--r--src/emacs.c566
-rw-r--r--src/emacsgtkfixed.c2
-rw-r--r--src/eval.c214
-rw-r--r--src/fileio.c292
-rw-r--r--src/filelock.c29
-rw-r--r--src/firstfile.c4
-rw-r--r--src/fns.c290
-rw-r--r--src/font.c36
-rw-r--r--src/font.h11
-rw-r--r--src/fontset.c90
-rw-r--r--src/frame.c299
-rw-r--r--src/frame.h109
-rw-r--r--src/fringe.c7
-rw-r--r--src/ftfont.c5
-rw-r--r--src/ftxfont.c14
-rw-r--r--src/gmalloc.c234
-rw-r--r--src/gnutls.c518
-rw-r--r--src/gnutls.h9
-rw-r--r--src/gtkutil.c170
-rw-r--r--src/image.c437
-rw-r--r--src/indent.c35
-rw-r--r--src/insdel.c137
-rw-r--r--src/intervals.c13
-rw-r--r--src/intervals.h14
-rw-r--r--src/keyboard.c135
-rw-r--r--src/keyboard.h2
-rw-r--r--src/keymap.c17
-rw-r--r--src/kqueue.c24
-rw-r--r--src/lastfile.c3
-rw-r--r--src/lisp.h162
-rw-r--r--src/lread.c152
-rw-r--r--src/macfont.m25
-rw-r--r--src/marker.c6
-rw-r--r--src/menu.c9
-rw-r--r--src/minibuf.c59
-rw-r--r--src/msdos.c8
-rw-r--r--src/nsfns.m81
-rw-r--r--src/nsfont.m11
-rw-r--r--src/nsimage.m4
-rw-r--r--src/nsmenu.m45
-rw-r--r--src/nsterm.h72
-rw-r--r--src/nsterm.m584
-rw-r--r--src/print.c64
-rw-r--r--src/process.c1782
-rw-r--r--src/process.h41
-rw-r--r--src/profiler.c11
-rw-r--r--src/puresize.h2
-rw-r--r--src/ralloc.c31
-rw-r--r--src/regex.c645
-rw-r--r--src/regex.h34
-rw-r--r--src/search.c20
-rw-r--r--src/sheap.c83
-rw-r--r--src/sheap.h31
-rw-r--r--src/sound.c4
-rw-r--r--src/syntax.c495
-rw-r--r--src/sysdep.c351
-rw-r--r--src/systty.h1
-rw-r--r--src/term.c44
-rw-r--r--src/termhooks.h8
-rw-r--r--src/textprop.c20
-rw-r--r--src/unexcw.c19
-rw-r--r--src/unexelf.c30
-rw-r--r--src/unexmacosx.c11
-rw-r--r--src/unexw32.c33
-rw-r--r--src/vm-limit.c11
-rw-r--r--src/w32.c286
-rw-r--r--src/w32.h2
-rw-r--r--src/w32console.c27
-rw-r--r--src/w32fns.c1137
-rw-r--r--src/w32font.c9
-rw-r--r--src/w32font.h1
-rw-r--r--src/w32heap.c99
-rw-r--r--src/w32heap.h4
-rw-r--r--src/w32inevt.c135
-rw-r--r--src/w32menu.c27
-rw-r--r--src/w32notify.c334
-rw-r--r--src/w32proc.c78
-rw-r--r--src/w32reg.c4
-rw-r--r--src/w32select.c115
-rw-r--r--src/w32term.c178
-rw-r--r--src/w32term.h48
-rw-r--r--src/w32uniscribe.c6
-rw-r--r--src/w32xfns.c32
-rw-r--r--src/widget.c1
-rw-r--r--src/window.c295
-rw-r--r--src/window.h21
-rw-r--r--src/xdisp.c636
-rw-r--r--src/xfaces.c61
-rw-r--r--src/xfns.c687
-rw-r--r--src/xfont.c19
-rw-r--r--src/xftfont.c31
-rw-r--r--src/xgselect.c1
-rw-r--r--src/xmenu.c6
-rw-r--r--src/xml.c8
-rw-r--r--src/xselect.c73
-rw-r--r--src/xsmfns.c4
-rw-r--r--src/xterm.c397
-rw-r--r--src/xterm.h39
-rw-r--r--src/xwidget.c533
-rw-r--r--src/xwidget.h3
132 files changed, 9976 insertions, 7380 deletions
diff --git a/src/.gdbinit b/src/.gdbinit
index 9160ffa439e..b0c0dfd7e90 100644
--- a/src/.gdbinit
+++ b/src/.gdbinit
@@ -1215,21 +1215,6 @@ document xwhichsymbols
maximum number of symbols referencing it to produce.
end
-define xbytecode
- set $bt = byte_stack_list
- while $bt
- xgetptr $bt->byte_string
- set $ptr = (struct Lisp_String *) $ptr
- xprintbytestr $ptr
- printf "\n0x%x => ", $bt->byte_string
- xwhichsymbols $bt->byte_string 5
- set $bt = $bt->next
- end
-end
-document xbytecode
- Print a backtrace of the byte code stack.
-end
-
# Show Lisp backtrace after normal backtrace.
define hookpost-backtrace
set $bt = backtrace_top ()
diff --git a/src/Makefile.in b/src/Makefile.in
index d54670932d3..dc0bfff9b33 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -236,6 +236,8 @@ IMAGEMAGICK_CFLAGS= @IMAGEMAGICK_CFLAGS@
LIBXML2_LIBS = @LIBXML2_LIBS@
LIBXML2_CFLAGS = @LIBXML2_CFLAGS@
+GETADDRINFO_A_LIBS = @GETADDRINFO_A_LIBS@
+
LIBZ = @LIBZ@
## system-specific libs for dynamic modules, else empty
@@ -252,10 +254,15 @@ XINERAMA_CFLAGS = @XINERAMA_CFLAGS@
XFIXES_LIBS = @XFIXES_LIBS@
XFIXES_CFLAGS = @XFIXES_CFLAGS@
+XDBE_LIBS = @XDBE_LIBS@
+XDBE_CFLAGS = @XDBE_CFLAGS@
+
## widget.o if USE_X_TOOLKIT, otherwise empty.
WIDGET_OBJ=@WIDGET_OBJ@
-## sheap.o if CYGWIN, otherwise empty.
+HYBRID_MALLOC = @HYBRID_MALLOC@
+
+## cygw32.o if CYGWIN, otherwise empty.
CYGWIN_OBJ=@CYGWIN_OBJ@
## fontset.o fringe.o image.o if we have any window system
@@ -299,20 +306,23 @@ CM_OBJ=@CM_OBJ@
LIBGPM = @LIBGPM@
-## -lresolv, or empty.
-LIBRESOLV = @LIBRESOLV@
-
LIBSELINUX_LIBS = @LIBSELINUX_LIBS@
LIBGNUTLS_LIBS = @LIBGNUTLS_LIBS@
LIBGNUTLS_CFLAGS = @LIBGNUTLS_CFLAGS@
+LIBSYSTEMD_LIBS = @LIBSYSTEMD_LIBS@
+LIBSYSTEMD_CFLAGS = @LIBSYSTEMD_CFLAGS@
+
INTERVALS_H = dispextern.h intervals.h composite.h
GETLOADAVG_LIBS = @GETLOADAVG_LIBS@
RUN_TEMACS = ./temacs
+# Whether builds should contain details. '--no-build-details' or empty.
+BUILD_DETAILS = @BUILD_DETAILS@
+
UNEXEC_OBJ = @UNEXEC_OBJ@
CANNOT_DUMP=@CANNOT_DUMP@
@@ -365,10 +375,11 @@ ALL_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \
$(C_SWITCH_MACHINE) $(C_SWITCH_SYSTEM) $(C_SWITCH_X_SITE) \
$(GNUSTEP_CFLAGS) $(CFLAGS_SOUND) $(RSVG_CFLAGS) $(IMAGEMAGICK_CFLAGS) \
$(PNG_CFLAGS) $(LIBXML2_CFLAGS) $(DBUS_CFLAGS) \
- $(XRANDR_CFLAGS) $(XINERAMA_CFLAGS) $(XFIXES_CFLAGS) \
+ $(XRANDR_CFLAGS) $(XINERAMA_CFLAGS) $(XFIXES_CFLAGS) $(XDBE_CFLAGS) \
$(WEBKIT_CFLAGS) \
$(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \
$(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) \
+ $(LIBSYSTEMD_CFLAGS) \
$(LIBGNUTLS_CFLAGS) $(NOTIFY_CFLAGS) $(CAIRO_CFLAGS) \
$(WARN_CFLAGS) $(WERROR_CFLAGS) $(CFLAGS)
ALL_OBJC_CFLAGS=$(ALL_CFLAGS) $(GNU_OBJC_CFLAGS)
@@ -398,6 +409,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \
doprnt.o intervals.o textprop.o composite.o xml.o $(NOTIFY_OBJ) \
$(XWIDGETS_OBJ) \
profiler.o decompress.o \
+ $(if $(HYBRID_MALLOC),sheap.o) \
$(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \
$(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ)
obj = $(base_obj) $(NS_OBJC_OBJ)
@@ -480,11 +492,12 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \
$(WEBKIT_LIBS) \
$(LIB_EACCESS) $(LIB_FDATASYNC) $(LIB_TIMER_TIME) $(DBUS_LIBS) \
$(LIB_EXECINFO) $(XRANDR_LIBS) $(XINERAMA_LIBS) $(XFIXES_LIBS) \
- $(LIBXML2_LIBS) $(LIBGPM) $(LIBRESOLV) $(LIBS_SYSTEM) $(CAIRO_LIBS) \
+ $(XDBE_LIBS) \
+ $(LIBXML2_LIBS) $(LIBGPM) $(LIBS_SYSTEM) $(CAIRO_LIBS) \
$(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \
$(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
- $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) \
- $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES)
+ $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) \
+ $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS)
$(leimdir)/leim-list.el: bootstrap-emacs$(EXEEXT)
$(MAKE) -C ../leim leim-list.el EMACS="$(bootstrap_exe)"
@@ -532,7 +545,7 @@ emacs$(EXEEXT): temacs$(EXEEXT) \
ifeq ($(CANNOT_DUMP),yes)
ln -f temacs$(EXEEXT) $@
else
- LC_ALL=C $(RUN_TEMACS) -batch -l loadup dump
+ LC_ALL=C $(RUN_TEMACS) -batch $(BUILD_DETAILS) -l loadup dump
ifneq ($(PAXCTL_dumped),)
$(PAXCTL_dumped) $@
endif
@@ -584,7 +597,9 @@ globals.h: gl-stamp; @true
$(ALLOBJS): globals.h
-$(lib)/libgnu.a: $(config_h)
+LIBEGNU_ARCHIVE = $(lib)/lib$(if $(HYBRID_MALLOC),e)gnu.a
+
+$(LIBEGNU_ARCHIVE): $(config_h)
$(MAKE) -C $(lib) all
## We have to create $(etc) here because init_cmdargs tests its
@@ -592,9 +607,9 @@ $(lib)/libgnu.a: $(config_h)
## This goes on to affect various things, and the emacs binary fails
## to start if Vinstallation_directory has the wrong value.
temacs$(EXEEXT): $(LIBXMENU) $(ALLOBJS) \
- $(lib)/libgnu.a $(EMACSRES) ${charsets} ${charscript}
+ $(LIBEGNU_ARCHIVE) $(EMACSRES) ${charsets} ${charscript}
$(AM_V_CCLD)$(CC) $(ALL_CFLAGS) $(TEMACS_LDFLAGS) $(LDFLAGS) \
- -o temacs $(ALLOBJS) $(lib)/libgnu.a $(W32_RES_LINK) $(LIBES)
+ -o temacs $(ALLOBJS) $(LIBEGNU_ARCHIVE) $(W32_RES_LINK) $(LIBES)
$(MKDIR_P) $(etc)
ifneq ($(CANNOT_DUMP),yes)
ifneq ($(PAXCTL_notdumped),)
@@ -667,32 +682,34 @@ extraclean: distclean
-rm -f *~ \#*
-ETAGS = ../lib-src/etags
+ETAGS = ../lib-src/etags${EXEEXT}
+
+${ETAGS}: FORCE
+ ${MAKE} -C ../lib-src $(notdir $@)
-ctagsfiles1 = [xyzXYZ]*.[hc]
-ctagsfiles2 = [a-wA-W]*.[hc]
-ctagsfiles3 = [a-zA-Z]*.m
+ctagsfiles1 = $(wildcard ${srcdir}/*.[hc])
+ctagsfiles2 = $(wildcard ${srcdir}/*.m)
## FIXME? In out-of-tree builds, should TAGS be generated in srcdir?
## This does not need to depend on ../lisp and ../lwlib TAGS files,
## because etags "--include" only includes a pointer to the file,
## rather than the file contents.
-TAGS: $(srcdir)/$(ctagsfiles1) $(srcdir)/$(ctagsfiles2) $(srcdir)/$(ctagsfiles3)
- "$(ETAGS)" --include=../lisp/TAGS --include=$(lwlibdir)/TAGS \
+TAGS: ${ETAGS} $(ctagsfiles1) $(ctagsfiles2)
+ ${ETAGS} --include=../lisp/TAGS --include=$(lwlibdir)/TAGS \
--regex='{c}/[ ]*DEFVAR_[A-Z_ (]+"\([^"]+\)"/\1/' \
--regex='{c}/[ ]*DEFVAR_[A-Z_ (]+"[^"]+",[ ]\([A-Za-z0-9_]+\)/\1/' \
- $(srcdir)/$(ctagsfiles1) $(srcdir)/$(ctagsfiles2) \
+ $(ctagsfiles1) \
--regex='{objc}/[ ]*DEFVAR_[A-Z_ (]+"\([^"]+\)"/\1/' \
--regex='{objc}/[ ]*DEFVAR_[A-Z_ (]+"[^"]+",[ ]\([A-Za-z0-9_]+\)/\1/' \
- $(srcdir)/$(ctagsfiles3)
+ $(ctagsfiles2)
## Arrange to make tags tables for ../lisp and ../lwlib,
## which the above TAGS file for the C files includes by reference.
-../lisp/TAGS:
+../lisp/TAGS: FORCE
$(MAKE) -C ../lisp TAGS ETAGS="$(ETAGS)"
-$(lwlibdir)/TAGS:
+$(lwlibdir)/TAGS: FORCE
$(MAKE) -C $(lwlibdir) TAGS ETAGS="$(ETAGS)"
tags: TAGS ../lisp/TAGS $(lwlibdir)/TAGS
@@ -737,7 +754,7 @@ bootstrap-emacs$(EXEEXT): temacs$(EXEEXT)
ifeq ($(CANNOT_DUMP),yes)
ln -f temacs$(EXEEXT) $@
else
- $(RUN_TEMACS) --batch --load loadup bootstrap
+ $(RUN_TEMACS) --batch $(BUILD_DETAILS) --load loadup bootstrap
ifneq ($(PAXCTL_dumped),)
$(PAXCTL_dumped) emacs$(EXEEXT)
endif
diff --git a/src/alloc.c b/src/alloc.c
index d58532b97ff..90c6f9441fa 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -20,12 +20,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
+#include <errno.h>
#include <stdio.h>
+#include <stdlib.h>
#include <limits.h> /* For CHAR_BIT. */
-
-#ifdef ENABLE_CHECKING
-#include <signal.h> /* For SIGABRT. */
-#endif
+#include <signal.h> /* For SIGABRT, SIGDANGER. */
#ifdef HAVE_PTHREAD
#include <pthread.h>
@@ -35,6 +34,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "dispextern.h"
#include "intervals.h"
#include "puresize.h"
+#include "sheap.h"
#include "systime.h"
#include "character.h"
#include "buffer.h"
@@ -47,6 +47,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include TERM_HEADER
#endif /* HAVE_WINDOW_SYSTEM */
+#include <flexmember.h>
#include <verify.h>
#include <execinfo.h> /* For backtrace. */
@@ -58,6 +59,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "dosfns.h" /* For dos_memory_info. */
#endif
+#ifdef HAVE_MALLOC_H
+# include <malloc.h>
+#endif
+
#if (defined ENABLE_CHECKING \
&& defined HAVE_VALGRIND_VALGRIND_H \
&& !defined USE_VALGRIND)
@@ -92,7 +97,7 @@ static bool valgrind_p;
#include "w32heap.h" /* for sbrk */
#endif
-#if defined DOUG_LEA_MALLOC || defined GNU_LINUX
+#ifdef GNU_LINUX
/* The address where the heap starts. */
void *
my_heap_start (void)
@@ -106,8 +111,6 @@ my_heap_start (void)
#ifdef DOUG_LEA_MALLOC
-#include <malloc.h>
-
/* Specify maximum number of areas to mmap. It would be nice to use a
value that explicitly means "no limit". */
@@ -117,18 +120,6 @@ my_heap_start (void)
inside glibc's malloc. */
static void *malloc_state_ptr;
-/* Get and free this pointer; useful around unexec. */
-void
-alloc_unexec_pre (void)
-{
- malloc_state_ptr = malloc_get_state ();
-}
-void
-alloc_unexec_post (void)
-{
- free (malloc_state_ptr);
-}
-
/* Restore the dumped malloc state. Because malloc can be invoked
even before main (e.g. by the dynamic linker), the dumped malloc
state must be restored as early as possible using this special hook. */
@@ -139,7 +130,9 @@ malloc_initialize_hook (void)
if (! initialized)
{
+#ifdef GNU_LINUX
my_heap_start ();
+#endif
malloc_using_checking = getenv ("MALLOC_CHECK_") != NULL;
}
else
@@ -162,21 +155,50 @@ malloc_initialize_hook (void)
}
}
- malloc_set_state (malloc_state_ptr);
+ if (malloc_set_state (malloc_state_ptr) != 0)
+ emacs_abort ();
# ifndef XMALLOC_OVERRUN_CHECK
alloc_unexec_post ();
# endif
}
}
+/* Declare the malloc initialization hook, which runs before 'main' starts.
+ EXTERNALLY_VISIBLE works around Bug#22522. */
# ifndef __MALLOC_HOOK_VOLATILE
# define __MALLOC_HOOK_VOLATILE
# endif
-voidfuncptr __MALLOC_HOOK_VOLATILE __malloc_initialize_hook
+voidfuncptr __MALLOC_HOOK_VOLATILE __malloc_initialize_hook EXTERNALLY_VISIBLE
= malloc_initialize_hook;
#endif
+/* Allocator-related actions to do just before and after unexec. */
+
+void
+alloc_unexec_pre (void)
+{
+#ifdef DOUG_LEA_MALLOC
+ malloc_state_ptr = malloc_get_state ();
+ if (!malloc_state_ptr)
+ fatal ("malloc_get_state: %s", strerror (errno));
+#endif
+#ifdef HYBRID_MALLOC
+ bss_sbrk_did_unexec = true;
+#endif
+}
+
+void
+alloc_unexec_post (void)
+{
+#ifdef DOUG_LEA_MALLOC
+ free (malloc_state_ptr);
+#endif
+#ifdef HYBRID_MALLOC
+ bss_sbrk_did_unexec = false;
+#endif
+}
+
/* Mark, unmark, query mark bit of a Lisp string. S must be a pointer
to a struct Lisp_String. */
@@ -212,12 +234,6 @@ EMACS_INT memory_full_cons_threshold;
bool gc_in_progress;
-/* True means abort if try to GC.
- This is for code which is written on the assumption that
- no GC will happen, so as to verify that assumption. */
-
-bool abort_on_gc;
-
/* Number of live and free conses etc. */
static EMACS_INT total_conses, total_markers, total_symbols, total_buffers;
@@ -460,23 +476,23 @@ static int staticidx;
static void *pure_alloc (size_t, int);
-/* Return X rounded to the next multiple of Y. Arguments should not
- have side effects, as they are evaluated more than once. Assume X
- + Y - 1 does not overflow. Tune for Y being a power of 2. */
+/* True if N is a power of 2. N should be positive. */
-#define ROUNDUP(x, y) ((y) & ((y) - 1) \
- ? ((x) + (y) - 1) - ((x) + (y) - 1) % (y) \
- : ((x) + (y) - 1) & ~ ((y) - 1))
+#define POWER_OF_2(n) (((n) & ((n) - 1)) == 0)
-/* Bug#23764 */
-#ifdef ALIGN
-# undef ALIGN
-#endif
+/* Return X rounded to the next multiple of Y. Y should be positive,
+ and Y - 1 + X should not overflow. Arguments should not have side
+ effects, as they are evaluated more than once. Tune for Y being a
+ power of 2. */
+
+#define ROUNDUP(x, y) (POWER_OF_2 (y) \
+ ? ((y) - 1 + (x)) & ~ ((y) - 1) \
+ : ((y) - 1 + (x)) - ((y) - 1 + (x)) % (y))
/* Return PTR rounded up to the next multiple of ALIGNMENT. */
static void *
-ALIGN (void *ptr, int alignment)
+pointer_align (void *ptr, int alignment)
{
return (void *) ROUNDUP ((uintptr_t) ptr, alignment);
}
@@ -555,6 +571,8 @@ static struct Lisp_Finalizer doomed_finalizers;
Malloc
************************************************************************/
+#if defined SIGDANGER || (!defined SYSTEM_MALLOC && !defined HYBRID_MALLOC)
+
/* Function malloc calls this if it finds we are near exhausting storage. */
void
@@ -563,6 +581,7 @@ malloc_warning (const char *str)
pending_malloc_warning = str;
}
+#endif
/* Display an already-pending malloc warning. */
@@ -623,13 +642,14 @@ buffer_memory_full (ptrdiff_t nbytes)
#define XMALLOC_OVERRUN_CHECK_OVERHEAD \
(2 * XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE)
-/* Define XMALLOC_OVERRUN_SIZE_SIZE so that (1) it's large enough to
- hold a size_t value and (2) the header size is a multiple of the
- alignment that Emacs needs for C types and for USE_LSB_TAG. */
#define XMALLOC_BASE_ALIGNMENT alignof (max_align_t)
#define XMALLOC_HEADER_ALIGNMENT \
COMMON_MULTIPLE (GCALIGNMENT, XMALLOC_BASE_ALIGNMENT)
+
+/* Define XMALLOC_OVERRUN_SIZE_SIZE so that (1) it's large enough to
+ hold a size_t value and (2) the header size is a multiple of the
+ alignment that Emacs needs for C types and for USE_LSB_TAG. */
#define XMALLOC_OVERRUN_SIZE_SIZE \
(((XMALLOC_OVERRUN_CHECK_SIZE + sizeof (size_t) \
+ XMALLOC_HEADER_ALIGNMENT - 1) \
@@ -1110,41 +1130,41 @@ lisp_free (void *block)
/* The entry point is lisp_align_malloc which returns blocks of at most
BLOCK_BYTES and guarantees they are aligned on a BLOCK_ALIGN boundary. */
+/* Byte alignment of storage blocks. */
+#define BLOCK_ALIGN (1 << 10)
+verify (POWER_OF_2 (BLOCK_ALIGN));
+
/* Use aligned_alloc if it or a simple substitute is available.
Address sanitization breaks aligned allocation, as of gcc 4.8.2 and
clang 3.3 anyway. Aligned allocation is incompatible with
unexmacosx.c, so don't use it on Darwin. */
#if ! ADDRESS_SANITIZER && !defined DARWIN_OS
-# if !defined SYSTEM_MALLOC && !defined DOUG_LEA_MALLOC && !defined HYBRID_MALLOC
+# if (defined HAVE_ALIGNED_ALLOC \
+ || (defined HYBRID_MALLOC \
+ ? defined HAVE_POSIX_MEMALIGN \
+ : !defined SYSTEM_MALLOC && !defined DOUG_LEA_MALLOC))
# define USE_ALIGNED_ALLOC 1
-# ifndef HAVE_ALIGNED_ALLOC
-/* Defined in gmalloc.c. */
-void *aligned_alloc (size_t, size_t);
-# endif
-# elif defined HYBRID_MALLOC
-# if defined HAVE_ALIGNED_ALLOC || defined HAVE_POSIX_MEMALIGN
-# define USE_ALIGNED_ALLOC 1
-# define aligned_alloc hybrid_aligned_alloc
-/* Defined in gmalloc.c. */
-void *aligned_alloc (size_t, size_t);
-# endif
-# elif defined HAVE_ALIGNED_ALLOC
-# define USE_ALIGNED_ALLOC 1
-# elif defined HAVE_POSIX_MEMALIGN
+# elif !defined HYBRID_MALLOC && defined HAVE_POSIX_MEMALIGN
# define USE_ALIGNED_ALLOC 1
+# define aligned_alloc my_aligned_alloc /* Avoid collision with lisp.h. */
static void *
aligned_alloc (size_t alignment, size_t size)
{
+ /* POSIX says the alignment must be a power-of-2 multiple of sizeof (void *).
+ Verify this for all arguments this function is given. */
+ verify (BLOCK_ALIGN % sizeof (void *) == 0
+ && POWER_OF_2 (BLOCK_ALIGN / sizeof (void *)));
+ verify (GCALIGNMENT % sizeof (void *) == 0
+ && POWER_OF_2 (GCALIGNMENT / sizeof (void *)));
+ eassert (alignment == BLOCK_ALIGN || alignment == GCALIGNMENT);
+
void *p;
return posix_memalign (&p, alignment, size) == 0 ? p : 0;
}
# endif
#endif
-/* BLOCK_ALIGN has to be a power of 2. */
-#define BLOCK_ALIGN (1 << 10)
-
/* Padding to leave at the end of a malloc'd block. This is to give
malloc a chance to minimize the amount of memory wasted to alignment.
It should be tuned to the particular malloc library used.
@@ -1171,16 +1191,18 @@ struct ablock
char payload[BLOCK_BYTES];
struct ablock *next_free;
} x;
- /* `abase' is the aligned base of the ablocks. */
- /* It is overloaded to hold the virtual `busy' field that counts
- the number of used ablock in the parent ablocks.
- The first ablock has the `busy' field, the others have the `abase'
- field. To tell the difference, we assume that pointers will have
- integer values larger than 2 * ABLOCKS_SIZE. The lowest bit of `busy'
- is used to tell whether the real base of the parent ablocks is `abase'
- (if not, the word before the first ablock holds a pointer to the
- real base). */
+
+ /* ABASE is the aligned base of the ablocks. It is overloaded to
+ hold a virtual "busy" field that counts twice the number of used
+ ablock values in the parent ablocks, plus one if the real base of
+ the parent ablocks is ABASE (if the "busy" field is even, the
+ word before the first ablock holds a pointer to the real base).
+ The first ablock has a "busy" ABASE, and the others have an
+ ordinary pointer ABASE. To tell the difference, the code assumes
+ that pointers, when cast to uintptr_t, are at least 2 *
+ ABLOCKS_SIZE + 1. */
struct ablocks *abase;
+
/* The padding of all but the last ablock is unused. The padding of
the last ablock in an ablocks is not allocated. */
#if BLOCK_PADDING
@@ -1199,18 +1221,18 @@ struct ablocks
#define ABLOCK_ABASE(block) \
(((uintptr_t) (block)->abase) <= (1 + 2 * ABLOCKS_SIZE) \
- ? (struct ablocks *)(block) \
+ ? (struct ablocks *) (block) \
: (block)->abase)
/* Virtual `busy' field. */
-#define ABLOCKS_BUSY(abase) ((abase)->blocks[0].abase)
+#define ABLOCKS_BUSY(a_base) ((a_base)->blocks[0].abase)
/* Pointer to the (not necessarily aligned) malloc block. */
#ifdef USE_ALIGNED_ALLOC
#define ABLOCKS_BASE(abase) (abase)
#else
#define ABLOCKS_BASE(abase) \
- (1 & (intptr_t) ABLOCKS_BUSY (abase) ? abase : ((void **)abase)[-1])
+ (1 & (intptr_t) ABLOCKS_BUSY (abase) ? abase : ((void **) (abase))[-1])
#endif
/* The list of free ablock. */
@@ -1236,7 +1258,7 @@ lisp_align_malloc (size_t nbytes, enum mem_type type)
if (!free_ablock)
{
int i;
- intptr_t aligned; /* int gets warning casting to 64-bit pointer. */
+ bool aligned;
#ifdef DOUG_LEA_MALLOC
if (!mmap_lisp_allowed_p ())
@@ -1244,10 +1266,11 @@ lisp_align_malloc (size_t nbytes, enum mem_type type)
#endif
#ifdef USE_ALIGNED_ALLOC
+ verify (ABLOCKS_BYTES % BLOCK_ALIGN == 0);
abase = base = aligned_alloc (BLOCK_ALIGN, ABLOCKS_BYTES);
#else
base = malloc (ABLOCKS_BYTES);
- abase = ALIGN (base, BLOCK_ALIGN);
+ abase = pointer_align (base, BLOCK_ALIGN);
#endif
if (base == 0)
@@ -1292,13 +1315,14 @@ lisp_align_malloc (size_t nbytes, enum mem_type type)
abase->blocks[i].x.next_free = free_ablock;
free_ablock = &abase->blocks[i];
}
- ABLOCKS_BUSY (abase) = (struct ablocks *) aligned;
+ intptr_t ialigned = aligned;
+ ABLOCKS_BUSY (abase) = (struct ablocks *) ialigned;
- eassert (0 == ((uintptr_t) abase) % BLOCK_ALIGN);
+ eassert ((uintptr_t) abase % BLOCK_ALIGN == 0);
eassert (ABLOCK_ABASE (&abase->blocks[3]) == abase); /* 3 is arbitrary */
eassert (ABLOCK_ABASE (&abase->blocks[0]) == abase);
eassert (ABLOCKS_BASE (abase) == base);
- eassert (aligned == (intptr_t) ABLOCKS_BUSY (abase));
+ eassert ((intptr_t) ABLOCKS_BUSY (abase) == aligned);
}
abase = ABLOCK_ABASE (free_ablock);
@@ -1334,12 +1358,14 @@ lisp_align_free (void *block)
ablock->x.next_free = free_ablock;
free_ablock = ablock;
/* Update busy count. */
- ABLOCKS_BUSY (abase)
- = (struct ablocks *) (-2 + (intptr_t) ABLOCKS_BUSY (abase));
+ intptr_t busy = (intptr_t) ABLOCKS_BUSY (abase) - 2;
+ eassume (0 <= busy && busy <= 2 * ABLOCKS_SIZE - 1);
+ ABLOCKS_BUSY (abase) = (struct ablocks *) busy;
- if (2 > (intptr_t) ABLOCKS_BUSY (abase))
+ if (busy < 2)
{ /* All the blocks are free. */
- int i = 0, aligned = (intptr_t) ABLOCKS_BUSY (abase);
+ int i = 0;
+ bool aligned = busy;
struct ablock **tem = &free_ablock;
struct ablock *atop = &abase->blocks[aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1];
@@ -1367,15 +1393,21 @@ lisp_align_free (void *block)
# define __alignof__(type) alignof (type)
#endif
-/* True if malloc returns a multiple of GCALIGNMENT. In practice this
- holds if __alignof__ (max_align_t) is a multiple. Use __alignof__
- if available, as otherwise this check would fail with GCC x86.
+/* True if malloc (N) is known to return a multiple of GCALIGNMENT
+ whenever N is also a multiple. In practice this is true if
+ __alignof__ (max_align_t) is a multiple as well, assuming
+ GCALIGNMENT is 8; other values of GCALIGNMENT have not been looked
+ into. Use __alignof__ if available, as otherwise
+ MALLOC_IS_GC_ALIGNED would be false on GCC x86 even though the
+ alignment is OK there.
+
This is a macro, not an enum constant, for portability to HP-UX
10.20 cc and AIX 3.2.5 xlc. */
-#define MALLOC_IS_GC_ALIGNED (__alignof__ (max_align_t) % GCALIGNMENT == 0)
+#define MALLOC_IS_GC_ALIGNED \
+ (GCALIGNMENT == 8 && __alignof__ (max_align_t) % GCALIGNMENT == 0)
-/* True if P is suitably aligned for SIZE, where Lisp alignment may be
- needed if SIZE is Lisp-aligned. */
+/* True if a malloc-returned pointer P is suitably aligned for SIZE,
+ where Lisp alignment may be needed if SIZE is Lisp-aligned. */
static bool
laligned (void *p, size_t size)
@@ -1404,24 +1436,20 @@ static void *
lmalloc (size_t size)
{
#if USE_ALIGNED_ALLOC
- if (! MALLOC_IS_GC_ALIGNED)
+ if (! MALLOC_IS_GC_ALIGNED && size % GCALIGNMENT == 0)
return aligned_alloc (GCALIGNMENT, size);
#endif
- void *p;
while (true)
{
- p = malloc (size);
+ void *p = malloc (size);
if (laligned (p, size))
- break;
+ return p;
free (p);
- size_t bigger;
- if (! INT_ADD_WRAPV (size, GCALIGNMENT, &bigger))
+ size_t bigger = size + GCALIGNMENT;
+ if (size < bigger)
size = bigger;
}
-
- eassert ((intptr_t) p % GCALIGNMENT == 0);
- return p;
}
static void *
@@ -1431,14 +1459,11 @@ lrealloc (void *p, size_t size)
{
p = realloc (p, size);
if (laligned (p, size))
- break;
- size_t bigger;
- if (! INT_ADD_WRAPV (size, GCALIGNMENT, &bigger))
+ return p;
+ size_t bigger = size + GCALIGNMENT;
+ if (size < bigger)
size = bigger;
}
-
- eassert ((intptr_t) p % GCALIGNMENT == 0);
- return p;
}
@@ -1730,27 +1755,23 @@ static char const string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] =
#ifdef GC_CHECK_STRING_BYTES
-#define SDATA_SIZE(NBYTES) \
- ((SDATA_DATA_OFFSET \
- + (NBYTES) + 1 \
- + sizeof (ptrdiff_t) - 1) \
- & ~(sizeof (ptrdiff_t) - 1))
+#define SDATA_SIZE(NBYTES) FLEXSIZEOF (struct sdata, data, NBYTES)
#else /* not GC_CHECK_STRING_BYTES */
/* The 'max' reserves space for the nbytes union member even when NBYTES + 1 is
less than the size of that member. The 'max' is not needed when
- SDATA_DATA_OFFSET is a multiple of sizeof (ptrdiff_t), because then the
- alignment code reserves enough space. */
+ SDATA_DATA_OFFSET is a multiple of FLEXALIGNOF (struct sdata),
+ because then the alignment code reserves enough space. */
#define SDATA_SIZE(NBYTES) \
((SDATA_DATA_OFFSET \
- + (SDATA_DATA_OFFSET % sizeof (ptrdiff_t) == 0 \
+ + (SDATA_DATA_OFFSET % FLEXALIGNOF (struct sdata) == 0 \
? NBYTES \
- : max (NBYTES, sizeof (ptrdiff_t) - 1)) \
+ : max (NBYTES, FLEXALIGNOF (struct sdata) - 1)) \
+ 1 \
- + sizeof (ptrdiff_t) - 1) \
- & ~(sizeof (ptrdiff_t) - 1))
+ + FLEXALIGNOF (struct sdata) - 1) \
+ & ~(FLEXALIGNOF (struct sdata) - 1))
#endif /* not GC_CHECK_STRING_BYTES */
@@ -1970,7 +1991,7 @@ allocate_string_data (struct Lisp_String *s,
if (nbytes > LARGE_STRING_BYTES)
{
- size_t size = offsetof (struct sblock, data) + needed;
+ size_t size = FLEXSIZEOF (struct sblock, data, needed);
#ifdef DOUG_LEA_MALLOC
if (!mmap_lisp_allowed_p ())
@@ -1984,9 +2005,9 @@ allocate_string_data (struct Lisp_String *s,
mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
#endif
- b->next_free = b->data;
- b->data[0].string = NULL;
+ data = b->data;
b->next = large_sblocks;
+ b->next_free = data;
large_sblocks = b;
}
else if (current_sblock == NULL
@@ -1996,9 +2017,9 @@ allocate_string_data (struct Lisp_String *s,
{
/* Not enough room in the current sblock. */
b = lisp_malloc (SBLOCK_SIZE, MEM_TYPE_NON_LISP);
- b->next_free = b->data;
- b->data[0].string = NULL;
+ data = b->data;
b->next = NULL;
+ b->next_free = data;
if (current_sblock)
current_sblock->next = b;
@@ -2007,14 +2028,16 @@ allocate_string_data (struct Lisp_String *s,
current_sblock = b;
}
else
- b = current_sblock;
+ {
+ b = current_sblock;
+ data = b->next_free;
+ }
- data = b->next_free;
+ data->string = s;
b->next_free = (sdata *) ((char *) data + needed + GC_STRING_EXTRA);
MALLOC_UNBLOCK_INPUT;
- data->string = s;
s->data = SDATA_DATA (data);
#ifdef GC_CHECK_STRING_BYTES
SDATA_NBYTES (data) = nbytes;
@@ -2171,89 +2194,96 @@ free_large_strings (void)
static void
compact_small_strings (void)
{
- struct sblock *b, *tb, *next;
- sdata *from, *to, *end, *tb_end;
- sdata *to_end, *from_end;
-
/* TB is the sblock we copy to, TO is the sdata within TB we copy
to, and TB_END is the end of TB. */
- tb = oldest_sblock;
- tb_end = (sdata *) ((char *) tb + SBLOCK_SIZE);
- to = tb->data;
-
- /* Step through the blocks from the oldest to the youngest. We
- expect that old blocks will stabilize over time, so that less
- copying will happen this way. */
- for (b = oldest_sblock; b; b = b->next)
+ struct sblock *tb = oldest_sblock;
+ if (tb)
{
- end = b->next_free;
- eassert ((char *) end <= (char *) b + SBLOCK_SIZE);
+ sdata *tb_end = (sdata *) ((char *) tb + SBLOCK_SIZE);
+ sdata *to = tb->data;
- for (from = b->data; from < end; from = from_end)
+ /* Step through the blocks from the oldest to the youngest. We
+ expect that old blocks will stabilize over time, so that less
+ copying will happen this way. */
+ struct sblock *b = tb;
+ do
{
- /* Compute the next FROM here because copying below may
- overwrite data we need to compute it. */
- ptrdiff_t nbytes;
- struct Lisp_String *s = from->string;
+ sdata *end = b->next_free;
+ eassert ((char *) end <= (char *) b + SBLOCK_SIZE);
+
+ for (sdata *from = b->data; from < end; )
+ {
+ /* Compute the next FROM here because copying below may
+ overwrite data we need to compute it. */
+ ptrdiff_t nbytes;
+ struct Lisp_String *s = from->string;
#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. */
- if (s && string_bytes (s) != SDATA_NBYTES (from))
- emacs_abort ();
+ /* Check that the string size recorded in the string is the
+ same as the one recorded in the sdata structure. */
+ if (s && string_bytes (s) != SDATA_NBYTES (from))
+ emacs_abort ();
#endif /* GC_CHECK_STRING_BYTES */
- nbytes = s ? STRING_BYTES (s) : SDATA_NBYTES (from);
- eassert (nbytes <= LARGE_STRING_BYTES);
+ nbytes = s ? STRING_BYTES (s) : SDATA_NBYTES (from);
+ eassert (nbytes <= LARGE_STRING_BYTES);
- nbytes = SDATA_SIZE (nbytes);
- from_end = (sdata *) ((char *) from + nbytes + GC_STRING_EXTRA);
+ nbytes = SDATA_SIZE (nbytes);
+ sdata *from_end = (sdata *) ((char *) from
+ + nbytes + GC_STRING_EXTRA);
#ifdef GC_CHECK_STRING_OVERRUN
- if (memcmp (string_overrun_cookie,
- (char *) from_end - GC_STRING_OVERRUN_COOKIE_SIZE,
- GC_STRING_OVERRUN_COOKIE_SIZE))
- emacs_abort ();
+ if (memcmp (string_overrun_cookie,
+ (char *) from_end - GC_STRING_OVERRUN_COOKIE_SIZE,
+ GC_STRING_OVERRUN_COOKIE_SIZE))
+ emacs_abort ();
#endif
- /* Non-NULL S means it's alive. Copy its data. */
- if (s)
- {
- /* If TB is full, proceed with the next sblock. */
- to_end = (sdata *) ((char *) to + nbytes + GC_STRING_EXTRA);
- if (to_end > tb_end)
+ /* Non-NULL S means it's alive. Copy its data. */
+ if (s)
{
- tb->next_free = to;
- tb = tb->next;
- tb_end = (sdata *) ((char *) tb + SBLOCK_SIZE);
- to = tb->data;
- to_end = (sdata *) ((char *) to + nbytes + GC_STRING_EXTRA);
- }
+ /* If TB is full, proceed with the next sblock. */
+ sdata *to_end = (sdata *) ((char *) to
+ + nbytes + GC_STRING_EXTRA);
+ if (to_end > tb_end)
+ {
+ tb->next_free = to;
+ tb = tb->next;
+ tb_end = (sdata *) ((char *) tb + SBLOCK_SIZE);
+ to = tb->data;
+ to_end = (sdata *) ((char *) to + nbytes + GC_STRING_EXTRA);
+ }
- /* Copy, and update the string's `data' pointer. */
- if (from != to)
- {
- eassert (tb != b || to < from);
- memmove (to, from, nbytes + GC_STRING_EXTRA);
- to->string->data = SDATA_DATA (to);
- }
+ /* Copy, and update the string's `data' pointer. */
+ if (from != to)
+ {
+ eassert (tb != b || to < from);
+ memmove (to, from, nbytes + GC_STRING_EXTRA);
+ to->string->data = SDATA_DATA (to);
+ }
- /* Advance past the sdata we copied to. */
- to = to_end;
+ /* Advance past the sdata we copied to. */
+ to = to_end;
+ }
+ from = from_end;
}
+ b = b->next;
}
- }
+ while (b);
- /* The rest of the sblocks following TB don't contain live data, so
- we can free them. */
- for (b = tb->next; b; b = next)
- {
- next = b->next;
- lisp_free (b);
+ /* The rest of the sblocks following TB don't contain live data, so
+ we can free them. */
+ for (b = tb->next; b; )
+ {
+ struct sblock *next = b->next;
+ lisp_free (b);
+ b = next;
+ }
+
+ tb->next_free = to;
+ tb->next = NULL;
}
- tb->next_free = to;
- tb->next = NULL;
current_sblock = tb;
}
@@ -2919,15 +2949,15 @@ set_next_vector (struct Lisp_Vector *v, struct Lisp_Vector *p)
enum
{
/* Alignment of struct Lisp_Vector objects. */
- vector_alignment = COMMON_MULTIPLE (ALIGNOF_STRUCT_LISP_VECTOR,
- GCALIGNMENT),
+ vector_alignment = COMMON_MULTIPLE (FLEXALIGNOF (struct Lisp_Vector),
+ GCALIGNMENT),
/* Vector size requests are a multiple of this. */
roundup_size = COMMON_MULTIPLE (vector_alignment, word_size)
};
/* Verify assumptions described above. */
-verify ((VECTOR_BLOCK_SIZE % roundup_size) == 0);
+verify (VECTOR_BLOCK_SIZE % roundup_size == 0);
verify (VECTOR_BLOCK_SIZE <= (1 << PSEUDOVECTOR_SIZE_BITS));
/* Round up X to nearest mult-of-ROUNDUP_SIZE --- use at compile time. */
@@ -3396,22 +3426,13 @@ allocate_buffer (void)
DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0,
doc: /* Return a newly created vector of length LENGTH, with each element being INIT.
See also the function `vector'. */)
- (register Lisp_Object length, Lisp_Object init)
+ (Lisp_Object length, Lisp_Object init)
{
- Lisp_Object vector;
- register ptrdiff_t sizei;
- register ptrdiff_t i;
- register struct Lisp_Vector *p;
-
CHECK_NATNUM (length);
-
- p = allocate_vector (XFASTINT (length));
- sizei = XFASTINT (length);
- for (i = 0; i < sizei; i++)
+ struct Lisp_Vector *p = allocate_vector (XFASTINT (length));
+ for (ptrdiff_t i = 0; i < XFASTINT (length); i++)
p->contents[i] = init;
-
- XSETVECTOR (vector, p);
- return vector;
+ return make_lisp_ptr (p, Lisp_Vectorlike);
}
DEFUN ("vector", Fvector, Svector, 0, MANY, 0,
@@ -3420,12 +3441,9 @@ Any number of arguments, even zero arguments, are allowed.
usage: (vector &rest OBJECTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- ptrdiff_t i;
- register Lisp_Object val = make_uninit_vector (nargs);
- register struct Lisp_Vector *p = XVECTOR (val);
-
- for (i = 0; i < nargs; i++)
- p->contents[i] = args[i];
+ Lisp_Object val = make_uninit_vector (nargs);
+ struct Lisp_Vector *p = XVECTOR (val);
+ memcpy (p->contents, args, nargs * sizeof *args);
return val;
}
@@ -3464,9 +3482,8 @@ stack before executing the byte-code.
usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- ptrdiff_t i;
- register Lisp_Object val = make_uninit_vector (nargs);
- register struct Lisp_Vector *p = XVECTOR (val);
+ Lisp_Object val = make_uninit_vector (nargs);
+ struct Lisp_Vector *p = XVECTOR (val);
/* 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
@@ -3476,8 +3493,7 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT
just wasteful and other times plainly wrong (e.g. those free vars may want
to be setcar'd). */
- for (i = 0; i < nargs; i++)
- p->contents[i] = args[i];
+ memcpy (p->contents, args, nargs * sizeof *args);
make_byte_code (p);
XSETCOMPILED (val, p);
return val;
@@ -5173,7 +5189,7 @@ pure_alloc (size_t size, int type)
{
/* Allocate space for a Lisp object from the beginning of the free
space with taking account of alignment. */
- result = ALIGN (purebeg + pure_bytes_used_lisp, GCALIGNMENT);
+ result = pointer_align (purebeg + pure_bytes_used_lisp, GCALIGNMENT);
pure_bytes_used_lisp = ((char *)result - (char *)purebeg) + size;
}
else
@@ -5436,7 +5452,7 @@ purecopy (Lisp_Object obj)
}
else
{
- Lisp_Object fmt = build_pure_c_string ("Don't know how to purify: %S");
+ AUTO_STRING (fmt, "Don't know how to purify: %S");
Fsignal (Qerror, list1 (CALLN (Fformat, fmt, obj)));
}
@@ -5662,16 +5678,13 @@ garbage_collect_1 (void *end)
Lisp_Object retval = Qnil;
size_t tot_before = 0;
- if (abort_on_gc)
- emacs_abort ();
-
/* Can't GC if pure storage overflowed because we can't determine
if something is a pure object or not. */
if (pure_bytes_used_before_overflow)
return Qnil;
/* Record this function, so it appears on the profiler's backtraces. */
- record_in_backtrace (Qautomatic_gc, 0, 0);
+ record_in_backtrace (QAutomatic_GC, 0, 0);
check_cons_list ();
@@ -5798,8 +5811,6 @@ garbage_collect_1 (void *end)
gc_sweep ();
- relocate_byte_stack ();
-
/* Clear the mark bits that we set in certain root slots. */
VECTOR_UNMARK (&buffer_defaults);
VECTOR_UNMARK (&buffer_local_symbols);
@@ -6134,7 +6145,7 @@ mark_face_cache (struct face_cache *c)
int i, j;
for (i = 0; i < c->used; ++i)
{
- struct face *face = FACE_FROM_ID (c->f, i);
+ struct face *face = FACE_FROM_ID_OR_NULL (c->f, i);
if (face)
{
@@ -7044,7 +7055,7 @@ We divide the value by 1024 to make sure it fits in a Lisp integer. */)
{
Lisp_Object end;
-#ifdef HAVE_NS
+#if defined HAVE_NS || !HAVE_SBRK
/* Avoid warning. sbrk has no relation to memory allocated anyway. */
XSETINT (end, 0);
#else
@@ -7232,21 +7243,6 @@ die (const char *msg, const char *file, int line)
#if defined (ENABLE_CHECKING) && USE_STACK_LISP_OBJECTS
-/* Debugging check whether STR is ASCII-only. */
-
-const char *
-verify_ascii (const char *str)
-{
- const unsigned char *ptr = (unsigned char *) str, *end = ptr + strlen (str);
- while (ptr < end)
- {
- int c = STRING_CHAR_ADVANCE (ptr);
- if (!ASCII_CHAR_P (c))
- emacs_abort ();
- }
- return str;
-}
-
/* Stress alloca with inconveniently sized requests and check
whether all allocated areas may be used for Lisp_Object. */
@@ -7402,7 +7398,7 @@ do hash-consing of the objects allocated to pure space. */);
DEFSYM (Qstring_bytes, "string-bytes");
DEFSYM (Qvector_slots, "vector-slots");
DEFSYM (Qheap, "heap");
- DEFSYM (Qautomatic_gc, "Automatic GC");
+ DEFSYM (QAutomatic_GC, "Automatic GC");
DEFSYM (Qgc_cons_threshold, "gc-cons-threshold");
DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots");
diff --git a/src/bidi.c b/src/bidi.c
index c2208cd12c2..5824de54ad8 100644
--- a/src/bidi.c
+++ b/src/bidi.c
@@ -1107,15 +1107,9 @@ bidi_initialize (void)
emacs_abort ();
staticpro (&bidi_brackets_table);
- DEFSYM (Qparagraph_start, "paragraph-start");
- paragraph_start_re = Fsymbol_value (Qparagraph_start);
- if (!STRINGP (paragraph_start_re))
- paragraph_start_re = build_string ("\f\\|[ \t]*$");
+ paragraph_start_re = build_string ("^\\(\f\\|[ \t]*\\)$");
staticpro (&paragraph_start_re);
- DEFSYM (Qparagraph_separate, "paragraph-separate");
- paragraph_separate_re = Fsymbol_value (Qparagraph_separate);
- if (!STRINGP (paragraph_separate_re))
- paragraph_separate_re = build_string ("[ \t\f]*$");
+ paragraph_separate_re = build_string ("^[ \t\f]*$");
staticpro (&paragraph_separate_re);
bidi_cache_sp = 0;
diff --git a/src/buffer.c b/src/buffer.c
index 89f4479740a..aa556b75bc6 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -25,12 +25,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <sys/param.h>
#include <errno.h>
#include <stdio.h>
+#include <stdlib.h>
#include <unistd.h>
#include <verify.h>
#include "lisp.h"
-#include "coding.h"
#include "intervals.h"
#include "systime.h"
#include "window.h"
@@ -1051,44 +1051,36 @@ it is in the sequence to be tried) even if a buffer with that name exists.
If NAME begins with a space (i.e., a buffer that is not normally
visible to users), then if buffer NAME already exists a random number
is first appended to NAME, to speed up finding a non-existent buffer. */)
- (register Lisp_Object name, Lisp_Object ignore)
+ (Lisp_Object name, Lisp_Object ignore)
{
- register Lisp_Object gentemp, tem, tem2;
- ptrdiff_t count;
- char number[INT_BUFSIZE_BOUND (ptrdiff_t) + sizeof "<>"];
+ Lisp_Object genbase;
CHECK_STRING (name);
- tem = Fstring_equal (name, ignore);
- if (!NILP (tem))
- return name;
- tem = Fget_buffer (name);
- if (NILP (tem))
+ if (!NILP (Fstring_equal (name, ignore)) || NILP (Fget_buffer (name)))
return name;
- if (!strncmp (SSDATA (name), " ", 1)) /* see bug#1229 */
+ if (SREF (name, 0) != ' ') /* See bug#1229. */
+ genbase = name;
+ else
{
/* Note fileio.c:make_temp_name does random differently. */
- tem2 = concat2 (name, make_formatted_string
- (number, "-%"pI"d",
- XFASTINT (Frandom (make_number (999999)))));
- tem = Fget_buffer (tem2);
- if (NILP (tem))
- return tem2;
+ char number[sizeof "-999999"];
+ int i = XFASTINT (Frandom (make_number (999999)));
+ AUTO_STRING_WITH_LEN (lnumber, number, sprintf (number, "-%d", i));
+ genbase = concat2 (name, lnumber);
+ if (NILP (Fget_buffer (genbase)))
+ return genbase;
}
- else
- tem2 = name;
- count = 1;
- while (1)
+ for (ptrdiff_t count = 2; ; count++)
{
- gentemp = concat2 (tem2, make_formatted_string
- (number, "<%"pD"d>", ++count));
- tem = Fstring_equal (gentemp, ignore);
- if (!NILP (tem))
- return gentemp;
- tem = Fget_buffer (gentemp);
- if (NILP (tem))
+ char number[INT_BUFSIZE_BOUND (ptrdiff_t) + sizeof "<>"];
+ AUTO_STRING_WITH_LEN (lnumber, number,
+ sprintf (number, "<%"pD"d>", count));
+ Lisp_Object gentemp = concat2 (genbase, lnumber);
+ if (!NILP (Fstring_equal (gentemp, ignore))
+ || NILP (Fget_buffer (gentemp)))
return gentemp;
}
}
@@ -1993,7 +1985,9 @@ the current buffer's major mode. */)
function = BVAR (current_buffer, major_mode);
}
- if (NILP (function) || EQ (function, Qfundamental_mode))
+ if (NILP (function)) /* If function is `fundamental-mode', allow it to run
+ so that `run-mode-hooks' and thus
+ `hack-local-variables' get run. */
return Qnil;
count = SPECPDL_INDEX ();
@@ -2001,7 +1995,7 @@ the current buffer's major mode. */)
/* To select a nonfundamental mode,
select the buffer temporarily and then call the mode function. */
- record_unwind_protect (save_excursion_restore, save_excursion_save ());
+ record_unwind_current_buffer ();
Fset_buffer (buffer);
call0 (function);
@@ -3562,8 +3556,8 @@ void
fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end)
{
Lisp_Object overlay;
- struct Lisp_Overlay *before_list IF_LINT (= NULL);
- struct Lisp_Overlay *after_list IF_LINT (= NULL);
+ struct Lisp_Overlay *before_list;
+ struct Lisp_Overlay *after_list;
/* These are either nil, indicating that before_list or after_list
should be assigned, or the cons cell the cdr of which should be
assigned. */
@@ -3710,7 +3704,7 @@ fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos)
/* If parent is nil, replace overlays_before; otherwise, parent->next. */
struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair;
Lisp_Object tem;
- ptrdiff_t end IF_LINT (= 0);
+ ptrdiff_t end;
/* After the insertion, the several overlays may be in incorrect
order. The possibility is that, in the list `overlays_before',
@@ -3917,7 +3911,8 @@ buffer. */)
struct buffer *b, *ob = 0;
Lisp_Object obuffer;
ptrdiff_t count = SPECPDL_INDEX ();
- ptrdiff_t n_beg, n_end, o_beg IF_LINT (= 0), o_end IF_LINT (= 0);
+ ptrdiff_t n_beg, n_end;
+ ptrdiff_t o_beg UNINIT, o_end UNINIT;
CHECK_OVERLAY (overlay);
if (NILP (buffer))
@@ -5279,7 +5274,7 @@ init_buffer (int initialized)
if (NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))
Fset_buffer_multibyte (Qnil);
- pwd = get_current_dir_name ();
+ pwd = emacs_get_current_dir_name ();
if (!pwd)
{
@@ -5418,144 +5413,6 @@ syms_of_buffer (void)
Fput (Qprotected_field, Qerror_message,
build_pure_c_string ("Attempt to modify a protected field"));
- DEFVAR_BUFFER_DEFAULTS ("default-mode-line-format",
- mode_line_format,
- doc: /* Default value of `mode-line-format' for buffers that don't override it.
-This is the same as (default-value \\='mode-line-format). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-header-line-format",
- header_line_format,
- doc: /* Default value of `header-line-format' for buffers that don't override it.
-This is the same as (default-value \\='header-line-format). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-cursor-type", cursor_type,
- doc: /* Default value of `cursor-type' for buffers that don't override it.
-This is the same as (default-value \\='cursor-type). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-line-spacing",
- extra_line_spacing,
- doc: /* Default value of `line-spacing' for buffers that don't override it.
-This is the same as (default-value \\='line-spacing). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-cursor-in-non-selected-windows",
- cursor_in_non_selected_windows,
- doc: /* Default value of `cursor-in-non-selected-windows'.
-This is the same as (default-value \\='cursor-in-non-selected-windows). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-abbrev-mode",
- abbrev_mode,
- doc: /* Default value of `abbrev-mode' for buffers that do not override it.
-This is the same as (default-value \\='abbrev-mode). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-ctl-arrow",
- ctl_arrow,
- doc: /* Default value of `ctl-arrow' for buffers that do not override it.
-This is the same as (default-value \\='ctl-arrow). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-enable-multibyte-characters",
- enable_multibyte_characters,
- doc: /* Default value of `enable-multibyte-characters' for buffers not overriding it.
-This is the same as (default-value \\='enable-multibyte-characters). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-buffer-file-coding-system",
- buffer_file_coding_system,
- doc: /* Default value of `buffer-file-coding-system' for buffers not overriding it.
-This is the same as (default-value \\='buffer-file-coding-system). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-truncate-lines",
- truncate_lines,
- doc: /* Default value of `truncate-lines' for buffers that do not override it.
-This is the same as (default-value \\='truncate-lines). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-fill-column",
- fill_column,
- doc: /* Default value of `fill-column' for buffers that do not override it.
-This is the same as (default-value \\='fill-column). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-left-margin",
- left_margin,
- doc: /* Default value of `left-margin' for buffers that do not override it.
-This is the same as (default-value \\='left-margin). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-tab-width",
- tab_width,
- doc: /* Default value of `tab-width' for buffers that do not override it.
-NOTE: This controls the display width of a TAB character, and not
-the size of an indentation step.
-This is the same as (default-value \\='tab-width). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-case-fold-search",
- case_fold_search,
- doc: /* Default value of `case-fold-search' for buffers that don't override it.
-This is the same as (default-value \\='case-fold-search). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-left-margin-width",
- left_margin_cols,
- doc: /* Default value of `left-margin-width' for buffers that don't override it.
-This is the same as (default-value \\='left-margin-width). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-right-margin-width",
- right_margin_cols,
- doc: /* Default value of `right-margin-width' for buffers that don't override it.
-This is the same as (default-value \\='right-margin-width). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-left-fringe-width",
- left_fringe_width,
- doc: /* Default value of `left-fringe-width' for buffers that don't override it.
-This is the same as (default-value \\='left-fringe-width). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-right-fringe-width",
- right_fringe_width,
- doc: /* Default value of `right-fringe-width' for buffers that don't override it.
-This is the same as (default-value \\='right-fringe-width). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-fringes-outside-margins",
- fringes_outside_margins,
- doc: /* Default value of `fringes-outside-margins' for buffers that don't override it.
-This is the same as (default-value \\='fringes-outside-margins). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-scroll-bar-width",
- scroll_bar_width,
- doc: /* Default value of `scroll-bar-width' for buffers that don't override it.
-This is the same as (default-value \\='scroll-bar-width). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-vertical-scroll-bar",
- vertical_scroll_bar_type,
- doc: /* Default value of `vertical-scroll-bar' for buffers that don't override it.
-This is the same as (default-value \\='vertical-scroll-bar). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-indicate-empty-lines",
- indicate_empty_lines,
- doc: /* Default value of `indicate-empty-lines' for buffers that don't override it.
-This is the same as (default-value \\='indicate-empty-lines). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-indicate-buffer-boundaries",
- indicate_buffer_boundaries,
- doc: /* Default value of `indicate-buffer-boundaries' for buffers that don't override it.
-This is the same as (default-value \\='indicate-buffer-boundaries). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-fringe-indicator-alist",
- fringe_indicator_alist,
- doc: /* Default value of `fringe-indicator-alist' for buffers that don't override it.
-This is the same as (default-value \\='fringe-indicator-alist). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-fringe-cursor-alist",
- fringe_cursor_alist,
- doc: /* Default value of `fringe-cursor-alist' for buffers that don't override it.
-This is the same as (default-value \\='fringe-cursor-alist). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-scroll-up-aggressively",
- scroll_up_aggressively,
- doc: /* Default value of `scroll-up-aggressively'.
-This value applies in buffers that don't have their own local values.
-This is the same as (default-value \\='scroll-up-aggressively). */);
-
- DEFVAR_BUFFER_DEFAULTS ("default-scroll-down-aggressively",
- scroll_down_aggressively,
- doc: /* Default value of `scroll-down-aggressively'.
-This value applies in buffers that don't have their own local values.
-This is the same as (default-value \\='scroll-down-aggressively). */);
-
DEFVAR_PER_BUFFER ("header-line-format",
&BVAR (current_buffer, header_line_format),
Qnil,
@@ -5626,9 +5483,6 @@ A string is printed verbatim in the mode line except for %-constructs:
%% -- print %. %- -- print infinitely many dashes.
Decimal digits after the % specify field width to which to pad. */);
- DEFVAR_BUFFER_DEFAULTS ("default-major-mode", major_mode,
- doc: /* Value of `major-mode' for new buffers. */);
-
DEFVAR_PER_BUFFER ("major-mode", &BVAR (current_buffer, major_mode),
Qsymbolp,
doc: /* Symbol for current buffer's major mode.
diff --git a/src/buffer.h b/src/buffer.h
index a53ef12f35e..6ac161c1c91 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -1187,8 +1187,7 @@ buffer_has_overlays (void)
INLINE int
FETCH_MULTIBYTE_CHAR (ptrdiff_t pos)
{
- unsigned char *p = ((pos >= GPT_BYTE ? GAP_SIZE : 0)
- + pos + BEG_ADDR - BEG_BYTE);
+ unsigned char *p = BYTE_POS_ADDR (pos);
return STRING_CHAR (p);
}
diff --git a/src/bytecode.c b/src/bytecode.c
index 9ae2e820d51..e2d8ab706c7 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -17,22 +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 <http://www.gnu.org/licenses/>. */
-/*
-hacked on by jwz@lucid.com 17-jun-91
- o added a compile-time switch to turn on simple sanity checking;
- o put back the obsolete byte-codes for error-detection;
- o added a new instruction, unbind_all, which I will use for
- tail-recursion elimination;
- o made temp_output_buffer_show be called with the right number
- of args;
- o made the new bytecodes be called with args in the right order;
- o added metering support.
-
-by Hallvard:
- o added relative jump instructions;
- o all conditionals now only do QUIT if they jump.
- */
-
#include <config.h>
#include "lisp.h"
@@ -43,18 +27,19 @@ by Hallvard:
#include "syntax.h"
#include "window.h"
-#ifdef CHECK_FRAME_FONT
-#include "frame.h"
-#include "xterm.h"
+/* Work around GCC bug 54561. */
+#if GNUC_PREREQ (4, 3, 0)
+# pragma GCC diagnostic ignored "-Wclobbered"
+#endif
+
+/* Define BYTE_CODE_SAFE true to enable some minor sanity checking,
+ useful for debugging the byte compiler. It defaults to false. */
+
+#ifndef BYTE_CODE_SAFE
+# define BYTE_CODE_SAFE false
#endif
-/*
- * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for
- * debugging the byte compiler...)
- *
- * define BYTE_CODE_METER to enable generation of a byte-op usage histogram.
- */
-/* #define BYTE_CODE_SAFE */
+/* Define BYTE_CODE_METER to generate a byte-op usage histogram. */
/* #define BYTE_CODE_METER */
/* If BYTE_CODE_THREADED is defined, then the interpreter will be
@@ -62,14 +47,15 @@ by Hallvard:
as currently implemented, is incompatible with BYTE_CODE_SAFE and
BYTE_CODE_METER. */
#if (defined __GNUC__ && !defined __STRICT_ANSI__ \
- && !defined BYTE_CODE_SAFE && !defined BYTE_CODE_METER)
+ && !BYTE_CODE_SAFE && !defined BYTE_CODE_METER)
#define BYTE_CODE_THREADED
#endif
#ifdef BYTE_CODE_METER
-#define METER_2(code1, code2) AREF (AREF (Vbyte_code_meter, code1), code2)
+#define METER_2(code1, code2) \
+ (*aref_addr (AREF (Vbyte_code_meter, code1), code2))
#define METER_1(code) METER_2 (0, code)
#define METER_CODE(last_code, this_code) \
@@ -289,87 +275,25 @@ enum byte_code_op
BYTE_CODES
#undef DEFINE
-#ifdef BYTE_CODE_SAFE
+#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
};
-
-/* Whether to maintain a `top' and `bottom' field in the stack frame. */
-#define BYTE_MAINTAIN_TOP BYTE_CODE_SAFE
-
-/* Structure describing a value stack used during byte-code execution
- in Fbyte_code. */
-
-struct byte_stack
-{
- /* Program counter. This points into the byte_string below
- and is relocated when that string is relocated. */
- const unsigned char *pc;
-
- /* Top and bottom of stack. The bottom points to an area of memory
- allocated with alloca in Fbyte_code. */
-#if BYTE_MAINTAIN_TOP
- Lisp_Object *top, *bottom;
-#endif
-
- /* The string containing the byte-code, and its current address.
- Storing this here protects it from GC because mark_byte_stack
- marks it. */
- Lisp_Object byte_string;
- const unsigned char *byte_string_start;
-
- /* Next entry in byte_stack_list. */
- struct byte_stack *next;
-};
-
-/* A list of currently active byte-code execution value stacks.
- Fbyte_code adds an entry to the head of this list before it starts
- processing byte-code, and it removes the entry again when it is
- done. Signaling an error truncates the list. */
-
-struct byte_stack *byte_stack_list;
-
-
-/* Relocate program counters in the stacks on byte_stack_list. Called
- when GC has completed. */
-
-void
-relocate_byte_stack (void)
-{
- struct byte_stack *stack;
-
- for (stack = byte_stack_list; stack; stack = stack->next)
- {
- if (stack->byte_string_start != SDATA (stack->byte_string))
- {
- ptrdiff_t offset = stack->pc - stack->byte_string_start;
- stack->byte_string_start = SDATA (stack->byte_string);
- stack->pc = stack->byte_string_start + offset;
- }
- }
-}
-
/* Fetch the next byte from the bytecode stream. */
-#ifdef BYTE_CODE_SAFE
-#define FETCH (eassert (stack.byte_string_start == SDATA (stack.byte_string)), *stack.pc++)
-#else
-#define FETCH *stack.pc++
-#endif
+#define FETCH (*pc++)
/* Fetch two bytes from the bytecode stream and make a 16-bit number
out of them. */
#define FETCH2 (op = FETCH, op + (FETCH << 8))
-/* Push x onto the execution stack. This used to be #define PUSH(x)
- (*++stackp = (x)) This oddity is necessary because Alliant can't be
- bothered to compile the preincrement operator properly, as of 4/91.
- -JimB */
+/* Push X onto the execution stack. The expression X should not
+ contain TOP, to avoid competing side effects. */
-#define PUSH(x) (top++, *top = (x))
+#define PUSH(x) (*++top = (x))
/* Pop a value off the execution stack. */
@@ -384,60 +308,6 @@ relocate_byte_stack (void)
#define TOP (*top)
-/* Actions that must be performed before and after calling a function
- that might GC. */
-
-#if !BYTE_MAINTAIN_TOP
-#define BEFORE_POTENTIAL_GC() ((void)0)
-#define AFTER_POTENTIAL_GC() ((void)0)
-#else
-#define BEFORE_POTENTIAL_GC() stack.top = top
-#define AFTER_POTENTIAL_GC() stack.top = NULL
-#endif
-
-/* Garbage collect if we have consed enough since the last time.
- We do this at every branch, to avoid loops that never GC. */
-
-#define MAYBE_GC() \
- do { \
- BEFORE_POTENTIAL_GC (); \
- maybe_gc (); \
- AFTER_POTENTIAL_GC (); \
- } while (0)
-
-/* Check for jumping out of range. */
-
-#ifdef BYTE_CODE_SAFE
-
-#define CHECK_RANGE(ARG) \
- if (ARG >= bytestr_length) emacs_abort ()
-
-#else /* not BYTE_CODE_SAFE */
-
-#define CHECK_RANGE(ARG)
-
-#endif /* not BYTE_CODE_SAFE */
-
-/* A version of the QUIT macro which makes sure that the stack top is
- set before signaling `quit'. */
-
-#define BYTE_CODE_QUIT \
- do { \
- if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \
- { \
- Lisp_Object flag = Vquit_flag; \
- Vquit_flag = Qnil; \
- BEFORE_POTENTIAL_GC (); \
- if (EQ (Vthrow_on_input, flag)) \
- Fthrow (Vthrow_on_input, Qt); \
- Fsignal (Qquit, Qnil); \
- AFTER_POTENTIAL_GC (); \
- } \
- else if (pending_signals) \
- process_pending_signals (); \
- } while (0)
-
-
DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
doc: /* Function used internally in byte-compiled code.
The first argument, BYTESTR, is a string of byte code;
@@ -467,41 +337,15 @@ Lisp_Object
exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
Lisp_Object args_template, ptrdiff_t nargs, Lisp_Object *args)
{
- ptrdiff_t count = SPECPDL_INDEX ();
#ifdef BYTE_CODE_METER
int volatile this_op = 0;
- int prev_op;
-#endif
- int op;
- /* Lisp_Object v1, v2; */
- Lisp_Object *vectorp;
-#ifdef BYTE_CODE_SAFE
- ptrdiff_t const_length;
- Lisp_Object *stacke;
- ptrdiff_t bytestr_length;
-#endif
- struct byte_stack stack;
- Lisp_Object *top;
- Lisp_Object result;
- enum handlertype type;
-
-#if 0 /* CHECK_FRAME_FONT */
- {
- struct frame *f = SELECTED_FRAME ();
- if (FRAME_X_P (f)
- && FRAME_FONT (f)->direction != 0
- && FRAME_FONT (f)->direction != 1)
- emacs_abort ();
- }
#endif
CHECK_STRING (bytestr);
CHECK_VECTOR (vector);
CHECK_NATNUM (maxdepth);
-#ifdef BYTE_CODE_SAFE
- const_length = ASIZE (vector);
-#endif
+ ptrdiff_t const_length = ASIZE (vector);
if (STRING_MULTIBYTE (bytestr))
/* BYTESTR must have been produced by Emacs 20.2 or the earlier
@@ -511,90 +355,59 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
convert them back to the originally intended unibyte form. */
bytestr = Fstring_as_unibyte (bytestr);
-#ifdef BYTE_CODE_SAFE
- bytestr_length = SBYTES (bytestr);
-#endif
- vectorp = XVECTOR (vector)->contents;
-
- stack.byte_string = bytestr;
- stack.pc = stack.byte_string_start = SDATA (bytestr);
- if (MAX_ALLOCA / word_size <= XFASTINT (maxdepth))
- memory_full (SIZE_MAX);
- top = alloca ((XFASTINT (maxdepth) + 1) * sizeof *top);
-#if BYTE_MAINTAIN_TOP
- stack.bottom = top + 1;
- stack.top = NULL;
-#endif
- stack.next = byte_stack_list;
- byte_stack_list = &stack;
-
-#ifdef BYTE_CODE_SAFE
- stacke = stack.bottom - 1 + XFASTINT (maxdepth);
-#endif
+ ptrdiff_t bytestr_length = SBYTES (bytestr);
+ Lisp_Object *vectorp = XVECTOR (vector)->contents;
+
+ unsigned char quitcounter = 1;
+ EMACS_INT stack_items = XFASTINT (maxdepth) + 1;
+ USE_SAFE_ALLOCA;
+ Lisp_Object *stack_base;
+ SAFE_ALLOCA_LISP_EXTRA (stack_base, stack_items, bytestr_length);
+ Lisp_Object *stack_lim = stack_base + stack_items;
+ Lisp_Object *top = stack_base;
+ memcpy (stack_lim, SDATA (bytestr), bytestr_length);
+ void *void_stack_lim = stack_lim;
+ unsigned char const *bytestr_data = void_stack_lim;
+ unsigned char const *pc = bytestr_data;
+ ptrdiff_t count = SPECPDL_INDEX ();
- if (INTEGERP (args_template))
+ if (!NILP (args_template))
{
+ eassert (INTEGERP (args_template));
ptrdiff_t at = XINT (args_template);
bool rest = (at & 128) != 0;
int mandatory = at & 127;
ptrdiff_t nonrest = at >> 8;
- eassert (mandatory <= nonrest);
- if (nargs <= nonrest)
- {
- ptrdiff_t i;
- for (i = 0 ; i < nargs; i++, args++)
- PUSH (*args);
- if (nargs < mandatory)
- /* Too few arguments. */
- Fsignal (Qwrong_number_of_arguments,
- list2 (Fcons (make_number (mandatory),
- rest ? Qand_rest : make_number (nonrest)),
- make_number (nargs)));
- else
- {
- for (; i < nonrest; i++)
- PUSH (Qnil);
- if (rest)
- PUSH (Qnil);
- }
- }
- else if (rest)
- {
- ptrdiff_t i;
- for (i = 0 ; i < nonrest; i++, args++)
- PUSH (*args);
- PUSH (Flist (nargs - nonrest, args));
- }
- else
- /* Too many arguments. */
+ ptrdiff_t maxargs = rest ? PTRDIFF_MAX : nonrest;
+ if (! (mandatory <= nargs && nargs <= maxargs))
Fsignal (Qwrong_number_of_arguments,
list2 (Fcons (make_number (mandatory), make_number (nonrest)),
make_number (nargs)));
- }
- else if (! NILP (args_template))
- /* We should push some arguments on the stack. */
- {
- error ("Unknown args template!");
+ 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 (1)
+ while (true)
{
-#ifdef BYTE_CODE_SAFE
- if (top > stacke)
- emacs_abort ();
- else if (top < stack.bottom - 1)
+ int op;
+ enum handlertype type;
+
+ if (BYTE_CODE_SAFE && ! (stack_base <= top && top < stack_lim))
emacs_abort ();
-#endif
#ifdef BYTE_CODE_METER
- prev_op = this_op;
+ int prev_op = this_op;
this_op = op = FETCH;
METER_CODE (prev_op, op);
-#else
-#ifndef BYTE_CODE_THREADED
+#elif !defined BYTE_CODE_THREADED
op = FETCH;
#endif
-#endif
/* The interpreter can be compiled one of two ways: as an
ordinary switch-based interpreter, or as a threaded
@@ -637,7 +450,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
the table clearer. */
#define LABEL(OP) [OP] = &&insn_ ## OP
-#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__)
+#if GNUC_PREREQ (4, 6, 0)
# pragma GCC diagnostic push
# pragma GCC diagnostic ignored "-Woverride-init"
#elif defined __clang__
@@ -656,7 +469,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
#undef DEFINE
};
-#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__) || defined __clang__
+#if GNUC_PREREQ (4, 6, 0) || defined __clang__
# pragma GCC diagnostic pop
#endif
@@ -675,7 +488,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
CASE (Bvarref3):
CASE (Bvarref4):
CASE (Bvarref5):
- op = op - Bvarref;
+ op -= Bvarref;
goto varref;
/* This seems to be the most frequently executed byte-code
@@ -684,92 +497,51 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
op = FETCH;
varref:
{
- Lisp_Object v1, v2;
-
- v1 = vectorp[op];
- if (SYMBOLP (v1))
- {
- if (XSYMBOL (v1)->redirect != SYMBOL_PLAINVAL
- || (v2 = SYMBOL_VAL (XSYMBOL (v1)),
- EQ (v2, Qunbound)))
- {
- BEFORE_POTENTIAL_GC ();
- v2 = Fsymbol_value (v1);
- AFTER_POTENTIAL_GC ();
- }
- }
- else
- {
- BEFORE_POTENTIAL_GC ();
- v2 = Fsymbol_value (v1);
- AFTER_POTENTIAL_GC ();
- }
+ Lisp_Object v1 = vectorp[op], v2;
+ if (!SYMBOLP (v1)
+ || XSYMBOL (v1)->redirect != SYMBOL_PLAINVAL
+ || (v2 = SYMBOL_VAL (XSYMBOL (v1)), EQ (v2, Qunbound)))
+ v2 = Fsymbol_value (v1);
PUSH (v2);
NEXT;
}
CASE (Bgotoifnil):
{
- Lisp_Object v1;
- MAYBE_GC ();
+ Lisp_Object v1 = POP;
op = FETCH2;
- v1 = POP;
if (NILP (v1))
- {
- BYTE_CODE_QUIT;
- CHECK_RANGE (op);
- stack.pc = stack.byte_string_start + op;
- }
+ goto op_branch;
NEXT;
}
CASE (Bcar):
- {
- Lisp_Object v1;
- v1 = TOP;
- if (CONSP (v1))
- TOP = XCAR (v1);
- else if (NILP (v1))
- TOP = Qnil;
- else
- {
- BEFORE_POTENTIAL_GC ();
- wrong_type_argument (Qlistp, v1);
- }
- NEXT;
- }
+ if (CONSP (TOP))
+ TOP = XCAR (TOP);
+ else if (!NILP (TOP))
+ wrong_type_argument (Qlistp, TOP);
+ NEXT;
CASE (Beq):
{
- Lisp_Object v1;
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = EQ (v1, TOP) ? Qt : Qnil;
NEXT;
}
CASE (Bmemq):
{
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = Fmemq (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bcdr):
{
- Lisp_Object v1;
- v1 = TOP;
- if (CONSP (v1))
- TOP = XCDR (v1);
- else if (NILP (v1))
- TOP = Qnil;
- else
- {
- BEFORE_POTENTIAL_GC ();
- wrong_type_argument (Qlistp, v1);
- }
+ if (CONSP (TOP))
+ TOP = XCDR (TOP);
+ else if (!NILP (TOP))
+ wrong_type_argument (Qlistp, TOP);
NEXT;
}
@@ -790,10 +562,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
op = FETCH;
varset:
{
- Lisp_Object sym, val;
-
- sym = vectorp[op];
- val = TOP;
+ Lisp_Object sym = vectorp[op];
+ Lisp_Object val = POP;
/* Inline the most common case. */
if (SYMBOLP (sym)
@@ -802,19 +572,13 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
&& !SYMBOL_CONSTANT_P (sym))
SET_SYMBOL_VAL (XSYMBOL (sym), val);
else
- {
- BEFORE_POTENTIAL_GC ();
- set_internal (sym, val, Qnil, 0);
- AFTER_POTENTIAL_GC ();
- }
+ set_internal (sym, val, Qnil, false);
}
- (void) POP;
NEXT;
CASE (Bdup):
{
- Lisp_Object v1;
- v1 = TOP;
+ Lisp_Object v1 = TOP;
PUSH (v1);
NEXT;
}
@@ -838,9 +602,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
op -= Bvarbind;
varbind:
/* Specbind can signal and thus GC. */
- BEFORE_POTENTIAL_GC ();
specbind (vectorp[op], POP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bcall6):
@@ -860,15 +622,12 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
op -= Bcall;
docall:
{
- BEFORE_POTENTIAL_GC ();
DISCARD (op);
#ifdef BYTE_CODE_METER
if (byte_metering_on && SYMBOLP (TOP))
{
- Lisp_Object v1, v2;
-
- v1 = TOP;
- v2 = Fget (v1, Qbyte_code_meter);
+ Lisp_Object v1 = TOP;
+ Lisp_Object v2 = Fget (v1, Qbyte_code_meter);
if (INTEGERP (v2)
&& XINT (v2) < MOST_POSITIVE_FIXNUM)
{
@@ -878,7 +637,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
}
#endif
TOP = Ffuncall (op + 1, &TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
}
@@ -898,124 +656,85 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
CASE (Bunbind5):
op -= Bunbind;
dounbind:
- BEFORE_POTENTIAL_GC ();
unbind_to (SPECPDL_INDEX () - op, Qnil);
- AFTER_POTENTIAL_GC ();
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. */
- BEFORE_POTENTIAL_GC ();
unbind_to (count, Qnil);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bgoto):
- MAYBE_GC ();
- BYTE_CODE_QUIT;
- op = FETCH2; /* pc = FETCH2 loses since FETCH2 contains pc++ */
- CHECK_RANGE (op);
- stack.pc = stack.byte_string_start + op;
+ 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))
+ emacs_abort ();
+ quitcounter += op < 0;
+ if (!quitcounter)
+ {
+ quitcounter = 1;
+ maybe_gc ();
+ QUIT;
+ }
+ pc += op;
NEXT;
CASE (Bgotoifnonnil):
- {
- Lisp_Object v1;
- MAYBE_GC ();
- op = FETCH2;
- v1 = POP;
- if (!NILP (v1))
- {
- BYTE_CODE_QUIT;
- CHECK_RANGE (op);
- stack.pc = stack.byte_string_start + op;
- }
- NEXT;
- }
+ op = FETCH2;
+ if (!NILP (POP))
+ goto op_branch;
+ NEXT;
CASE (Bgotoifnilelsepop):
- MAYBE_GC ();
op = FETCH2;
if (NILP (TOP))
- {
- BYTE_CODE_QUIT;
- CHECK_RANGE (op);
- stack.pc = stack.byte_string_start + op;
- }
- else DISCARD (1);
+ goto op_branch;
+ DISCARD (1);
NEXT;
CASE (Bgotoifnonnilelsepop):
- MAYBE_GC ();
op = FETCH2;
if (!NILP (TOP))
- {
- BYTE_CODE_QUIT;
- CHECK_RANGE (op);
- stack.pc = stack.byte_string_start + op;
- }
- else DISCARD (1);
+ goto op_branch;
+ DISCARD (1);
NEXT;
CASE (BRgoto):
- MAYBE_GC ();
- BYTE_CODE_QUIT;
- stack.pc += (int) *stack.pc - 127;
- NEXT;
+ op = FETCH - 128;
+ goto op_relative_branch;
CASE (BRgotoifnil):
- {
- Lisp_Object v1;
- MAYBE_GC ();
- v1 = POP;
- if (NILP (v1))
- {
- BYTE_CODE_QUIT;
- stack.pc += (int) *stack.pc - 128;
- }
- stack.pc++;
- NEXT;
- }
+ op = FETCH - 128;
+ if (NILP (POP))
+ goto op_relative_branch;
+ NEXT;
CASE (BRgotoifnonnil):
- {
- Lisp_Object v1;
- MAYBE_GC ();
- v1 = POP;
- if (!NILP (v1))
- {
- BYTE_CODE_QUIT;
- stack.pc += (int) *stack.pc - 128;
- }
- stack.pc++;
- NEXT;
- }
+ op = FETCH - 128;
+ if (!NILP (POP))
+ goto op_relative_branch;
+ NEXT;
CASE (BRgotoifnilelsepop):
- MAYBE_GC ();
- op = *stack.pc++;
+ op = FETCH - 128;
if (NILP (TOP))
- {
- BYTE_CODE_QUIT;
- stack.pc += op - 128;
- }
- else DISCARD (1);
+ goto op_relative_branch;
+ DISCARD (1);
NEXT;
CASE (BRgotoifnonnilelsepop):
- MAYBE_GC ();
- op = *stack.pc++;
+ op = FETCH - 128;
if (!NILP (TOP))
- {
- BYTE_CODE_QUIT;
- stack.pc += op - 128;
- }
- else DISCARD (1);
+ goto op_relative_branch;
+ DISCARD (1);
NEXT;
CASE (Breturn):
- result = POP;
goto exit;
CASE (Bdiscard):
@@ -1041,10 +760,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
ptrdiff_t count1 = SPECPDL_INDEX ();
record_unwind_protect (restore_window_configuration,
Fcurrent_window_configuration (Qnil));
- BEFORE_POTENTIAL_GC ();
TOP = Fprogn (TOP);
unbind_to (count1, TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
}
@@ -1055,11 +772,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
CASE (Bcatch): /* Obsolete since 24.4. */
{
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = internal_catch (TOP, eval_sub, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
@@ -1070,93 +784,70 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
type = CONDITION_CASE;
pushhandler:
{
- Lisp_Object tag = POP;
- int dest = FETCH2;
-
- struct handler *c = push_handler (tag, type);
- c->bytecode_dest = dest;
+ struct handler *c = push_handler (POP, type);
+ c->bytecode_dest = FETCH2;
c->bytecode_top = top;
if (sys_setjmp (c->jmp))
{
struct handler *c = handlerlist;
- int dest;
top = c->bytecode_top;
- dest = c->bytecode_dest;
+ op = c->bytecode_dest;
handlerlist = c->next;
PUSH (c->val);
- CHECK_RANGE (dest);
- /* Might have been re-set by longjmp! */
- stack.byte_string_start = SDATA (stack.byte_string);
- stack.pc = stack.byte_string_start + dest;
+ goto op_branch;
}
NEXT;
}
CASE (Bpophandler): /* New in 24.4. */
- {
- handlerlist = handlerlist->next;
- NEXT;
- }
+ handlerlist = handlerlist->next;
+ NEXT;
CASE (Bunwind_protect): /* FIXME: avoid closure for lexbind. */
{
Lisp_Object handler = POP;
/* Support for a function here is new in 24.4. */
- record_unwind_protect (NILP (Ffunctionp (handler))
- ? unwind_body : bcall0,
+ record_unwind_protect ((NILP (Ffunctionp (handler))
+ ? unwind_body : bcall0),
handler);
NEXT;
}
CASE (Bcondition_case): /* Obsolete since 24.4. */
{
- Lisp_Object handlers, body;
- handlers = POP;
- body = POP;
- BEFORE_POTENTIAL_GC ();
+ Lisp_Object handlers = POP, body = POP;
TOP = internal_lisp_condition_case (TOP, body, handlers);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Btemp_output_buffer_setup): /* Obsolete since 24.1. */
- BEFORE_POTENTIAL_GC ();
CHECK_STRING (TOP);
temp_output_buffer_setup (SSDATA (TOP));
- AFTER_POTENTIAL_GC ();
TOP = Vstandard_output;
NEXT;
CASE (Btemp_output_buffer_show): /* Obsolete since 24.1. */
{
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
temp_output_buffer_show (TOP);
TOP = v1;
/* pop binding of standard-output */
unbind_to (SPECPDL_INDEX () - 1, Qnil);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bnth):
{
- Lisp_Object v1, v2;
- EMACS_INT n;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
- v2 = TOP;
- CHECK_NUMBER (v2);
- n = XINT (v2);
- immediate_quit = 1;
- while (--n >= 0 && CONSP (v1))
- v1 = XCDR (v1);
- immediate_quit = 0;
- TOP = CAR (v1);
- AFTER_POTENTIAL_GC ();
+ Lisp_Object v2 = POP, v1 = TOP;
+ CHECK_NUMBER (v1);
+ EMACS_INT n = XINT (v1);
+ immediate_quit = true;
+ while (--n >= 0 && CONSP (v2))
+ v2 = XCDR (v2);
+ immediate_quit = false;
+ TOP = CAR (v2);
NEXT;
}
@@ -1182,8 +873,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
CASE (Bcons):
{
- Lisp_Object v1;
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = Fcons (TOP, v1);
NEXT;
}
@@ -1194,8 +884,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
CASE (Blist2):
{
- Lisp_Object v1;
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = list2 (TOP, v1);
NEXT;
}
@@ -1217,305 +906,191 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
NEXT;
CASE (Blength):
- BEFORE_POTENTIAL_GC ();
TOP = Flength (TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Baref):
{
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = Faref (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Baset):
{
- Lisp_Object v1, v2;
- BEFORE_POTENTIAL_GC ();
- v2 = POP; v1 = POP;
+ Lisp_Object v2 = POP, v1 = POP;
TOP = Faset (TOP, v1, v2);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bsymbol_value):
- BEFORE_POTENTIAL_GC ();
TOP = Fsymbol_value (TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bsymbol_function):
- BEFORE_POTENTIAL_GC ();
TOP = Fsymbol_function (TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bset):
{
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = Fset (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bfset):
{
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = Ffset (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bget):
{
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = Fget (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bsubstring):
{
- Lisp_Object v1, v2;
- BEFORE_POTENTIAL_GC ();
- v2 = POP; v1 = POP;
+ Lisp_Object v2 = POP, v1 = POP;
TOP = Fsubstring (TOP, v1, v2);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bconcat2):
- BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fconcat (2, &TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bconcat3):
- BEFORE_POTENTIAL_GC ();
DISCARD (2);
TOP = Fconcat (3, &TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bconcat4):
- BEFORE_POTENTIAL_GC ();
DISCARD (3);
TOP = Fconcat (4, &TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (BconcatN):
op = FETCH;
- BEFORE_POTENTIAL_GC ();
DISCARD (op - 1);
TOP = Fconcat (op, &TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bsub1):
- {
- Lisp_Object v1;
- v1 = TOP;
- if (INTEGERP (v1))
- {
- XSETINT (v1, XINT (v1) - 1);
- TOP = v1;
- }
- else
- {
- BEFORE_POTENTIAL_GC ();
- TOP = Fsub1 (v1);
- AFTER_POTENTIAL_GC ();
- }
- NEXT;
- }
+ TOP = INTEGERP (TOP) ? make_number (XINT (TOP) - 1) : Fsub1 (TOP);
+ NEXT;
CASE (Badd1):
- {
- Lisp_Object v1;
- v1 = TOP;
- if (INTEGERP (v1))
- {
- XSETINT (v1, XINT (v1) + 1);
- TOP = v1;
- }
- else
- {
- BEFORE_POTENTIAL_GC ();
- TOP = Fadd1 (v1);
- AFTER_POTENTIAL_GC ();
- }
- NEXT;
- }
+ TOP = INTEGERP (TOP) ? make_number (XINT (TOP) + 1) : Fadd1 (TOP);
+ NEXT;
CASE (Beqlsign):
{
- Lisp_Object v1, v2;
- BEFORE_POTENTIAL_GC ();
- v2 = POP; v1 = TOP;
+ Lisp_Object v2 = POP, v1 = TOP;
CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1);
CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2);
- AFTER_POTENTIAL_GC ();
+ bool equal;
if (FLOATP (v1) || FLOATP (v2))
{
- double f1, f2;
-
- f1 = (FLOATP (v1) ? XFLOAT_DATA (v1) : XINT (v1));
- f2 = (FLOATP (v2) ? XFLOAT_DATA (v2) : XINT (v2));
- TOP = (f1 == f2 ? Qt : Qnil);
+ double f1 = FLOATP (v1) ? XFLOAT_DATA (v1) : XINT (v1);
+ double f2 = FLOATP (v2) ? XFLOAT_DATA (v2) : XINT (v2);
+ equal = f1 == f2;
}
else
- TOP = (XINT (v1) == XINT (v2) ? Qt : Qnil);
+ equal = XINT (v1) == XINT (v2);
+ TOP = equal ? Qt : Qnil;
NEXT;
}
CASE (Bgtr):
{
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = arithcompare (TOP, v1, ARITH_GRTR);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Blss):
{
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = arithcompare (TOP, v1, ARITH_LESS);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bleq):
{
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = arithcompare (TOP, v1, ARITH_LESS_OR_EQUAL);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bgeq):
{
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = arithcompare (TOP, v1, ARITH_GRTR_OR_EQUAL);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bdiff):
- BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fminus (2, &TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bnegate):
- {
- Lisp_Object v1;
- v1 = TOP;
- if (INTEGERP (v1))
- {
- XSETINT (v1, - XINT (v1));
- TOP = v1;
- }
- else
- {
- BEFORE_POTENTIAL_GC ();
- TOP = Fminus (1, &TOP);
- AFTER_POTENTIAL_GC ();
- }
- NEXT;
- }
+ TOP = INTEGERP (TOP) ? make_number (- XINT (TOP)) : Fminus (1, &TOP);
+ NEXT;
CASE (Bplus):
- BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fplus (2, &TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bmax):
- BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fmax (2, &TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bmin):
- BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fmin (2, &TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bmult):
- BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Ftimes (2, &TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bquo):
- BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fquo (2, &TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Brem):
{
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = Frem (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bpoint):
- {
- Lisp_Object v1;
- XSETFASTINT (v1, PT);
- PUSH (v1);
- NEXT;
- }
+ PUSH (make_natnum (PT));
+ NEXT;
CASE (Bgoto_char):
- BEFORE_POTENTIAL_GC ();
TOP = Fgoto_char (TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Binsert):
- BEFORE_POTENTIAL_GC ();
TOP = Finsert (1, &TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (BinsertN):
op = FETCH;
- BEFORE_POTENTIAL_GC ();
DISCARD (op - 1);
TOP = Finsert (op, &TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bpoint_max):
@@ -1527,53 +1102,27 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
}
CASE (Bpoint_min):
- {
- Lisp_Object v1;
- XSETFASTINT (v1, BEGV);
- PUSH (v1);
- NEXT;
- }
+ PUSH (make_natnum (BEGV));
+ NEXT;
CASE (Bchar_after):
- BEFORE_POTENTIAL_GC ();
TOP = Fchar_after (TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bfollowing_char):
- {
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = Ffollowing_char ();
- AFTER_POTENTIAL_GC ();
- PUSH (v1);
- NEXT;
- }
+ PUSH (Ffollowing_char ());
+ NEXT;
CASE (Bpreceding_char):
- {
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = Fprevious_char ();
- AFTER_POTENTIAL_GC ();
- PUSH (v1);
- NEXT;
- }
+ PUSH (Fprevious_char ());
+ NEXT;
CASE (Bcurrent_column):
- {
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- XSETFASTINT (v1, current_column ());
- AFTER_POTENTIAL_GC ();
- PUSH (v1);
- NEXT;
- }
+ PUSH (make_natnum (current_column ()));
+ NEXT;
CASE (Bindent_to):
- BEFORE_POTENTIAL_GC ();
TOP = Findent_to (TOP, Qnil);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Beolp):
@@ -1597,63 +1146,43 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
NEXT;
CASE (Bset_buffer):
- BEFORE_POTENTIAL_GC ();
TOP = Fset_buffer (TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Binteractive_p): /* Obsolete since 24.1. */
- BEFORE_POTENTIAL_GC ();
PUSH (call0 (intern ("interactive-p")));
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bforward_char):
- BEFORE_POTENTIAL_GC ();
TOP = Fforward_char (TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bforward_word):
- BEFORE_POTENTIAL_GC ();
TOP = Fforward_word (TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bskip_chars_forward):
{
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = Fskip_chars_forward (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bskip_chars_backward):
{
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = Fskip_chars_backward (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bforward_line):
- BEFORE_POTENTIAL_GC ();
TOP = Fforward_line (TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bchar_syntax):
{
- int c;
-
- BEFORE_POTENTIAL_GC ();
CHECK_CHARACTER (TOP);
- AFTER_POTENTIAL_GC ();
- c = XFASTINT (TOP);
+ int c = XFASTINT (TOP);
if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
MAKE_CHAR_MULTIBYTE (c);
XSETFASTINT (TOP, syntax_code_spec[SYNTAX (c)]);
@@ -1662,239 +1191,169 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
CASE (Bbuffer_substring):
{
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = Fbuffer_substring (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bdelete_region):
{
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = Fdelete_region (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bnarrow_to_region):
{
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = Fnarrow_to_region (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bwiden):
- BEFORE_POTENTIAL_GC ();
PUSH (Fwiden ());
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bend_of_line):
- BEFORE_POTENTIAL_GC ();
TOP = Fend_of_line (TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bset_marker):
{
- Lisp_Object v1, v2;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
- v2 = POP;
- TOP = Fset_marker (TOP, v2, v1);
- AFTER_POTENTIAL_GC ();
+ Lisp_Object v2 = POP, v1 = POP;
+ TOP = Fset_marker (TOP, v1, v2);
NEXT;
}
CASE (Bmatch_beginning):
- BEFORE_POTENTIAL_GC ();
TOP = Fmatch_beginning (TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bmatch_end):
- BEFORE_POTENTIAL_GC ();
TOP = Fmatch_end (TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bupcase):
- BEFORE_POTENTIAL_GC ();
TOP = Fupcase (TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bdowncase):
- BEFORE_POTENTIAL_GC ();
TOP = Fdowncase (TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bstringeqlsign):
{
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = Fstring_equal (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bstringlss):
{
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = Fstring_lessp (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bequal):
{
- Lisp_Object v1;
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = Fequal (TOP, v1);
NEXT;
}
CASE (Bnthcdr):
{
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = Fnthcdr (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Belt):
{
- Lisp_Object v1, v2;
if (CONSP (TOP))
{
/* Exchange args and then do nth. */
- EMACS_INT n;
- BEFORE_POTENTIAL_GC ();
- v2 = POP;
- v1 = TOP;
+ Lisp_Object v2 = POP, v1 = TOP;
CHECK_NUMBER (v2);
- AFTER_POTENTIAL_GC ();
- n = XINT (v2);
- immediate_quit = 1;
+ EMACS_INT n = XINT (v2);
+ immediate_quit = true;
while (--n >= 0 && CONSP (v1))
v1 = XCDR (v1);
- immediate_quit = 0;
+ immediate_quit = false;
TOP = CAR (v1);
}
else
{
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = Felt (TOP, v1);
- AFTER_POTENTIAL_GC ();
}
NEXT;
}
CASE (Bmember):
{
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = Fmember (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bassq):
{
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = Fassq (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bnreverse):
- BEFORE_POTENTIAL_GC ();
TOP = Fnreverse (TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bsetcar):
{
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = Fsetcar (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bsetcdr):
{
- Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
- v1 = POP;
+ Lisp_Object v1 = POP;
TOP = Fsetcdr (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bcar_safe):
- {
- Lisp_Object v1;
- v1 = TOP;
- TOP = CAR_SAFE (v1);
- NEXT;
- }
+ TOP = CAR_SAFE (TOP);
+ NEXT;
CASE (Bcdr_safe):
- {
- Lisp_Object v1;
- v1 = TOP;
- TOP = CDR_SAFE (v1);
- NEXT;
- }
+ TOP = CDR_SAFE (TOP);
+ NEXT;
CASE (Bnconc):
- BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fnconc (2, &TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bnumberp):
- TOP = (NUMBERP (TOP) ? Qt : Qnil);
+ TOP = NUMBERP (TOP) ? Qt : Qnil;
NEXT;
CASE (Bintegerp):
TOP = INTEGERP (TOP) ? Qt : Qnil;
NEXT;
-#ifdef BYTE_CODE_SAFE
+#if BYTE_CODE_SAFE
/* These are intentionally written using 'case' syntax,
because they are incompatible with the threaded
interpreter. */
case Bset_mark:
- BEFORE_POTENTIAL_GC ();
error ("set-mark is an obsolete bytecode");
- AFTER_POTENTIAL_GC ();
break;
case Bscan_buffer:
- BEFORE_POTENTIAL_GC ();
error ("scan-buffer is an obsolete bytecode");
- AFTER_POTENTIAL_GC ();
break;
#endif
@@ -1905,7 +1364,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
call3 (Qerror,
build_string ("Invalid byte opcode: op=%s, ptr=%d"),
make_number (op),
- make_number ((stack.pc - 1) - stack.byte_string_start));
+ make_number (pc - 1 - bytestr_data));
/* Handy byte-codes for lexical binding. */
CASE (Bstack_ref1):
@@ -1914,32 +1373,32 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
CASE (Bstack_ref4):
CASE (Bstack_ref5):
{
- Lisp_Object *ptr = top - (op - Bstack_ref);
- PUSH (*ptr);
+ Lisp_Object v1 = top[Bstack_ref - op];
+ PUSH (v1);
NEXT;
}
CASE (Bstack_ref6):
{
- Lisp_Object *ptr = top - (FETCH);
- PUSH (*ptr);
+ Lisp_Object v1 = top[- FETCH];
+ PUSH (v1);
NEXT;
}
CASE (Bstack_ref7):
{
- Lisp_Object *ptr = top - (FETCH2);
- PUSH (*ptr);
+ Lisp_Object v1 = top[- FETCH2];
+ PUSH (v1);
NEXT;
}
CASE (Bstack_set):
/* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos. */
{
- Lisp_Object *ptr = top - (FETCH);
+ Lisp_Object *ptr = top - FETCH;
*ptr = POP;
NEXT;
}
CASE (Bstack_set2):
{
- Lisp_Object *ptr = top - (FETCH2);
+ Lisp_Object *ptr = top - FETCH2;
*ptr = POP;
NEXT;
}
@@ -1955,27 +1414,16 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
CASE_DEFAULT
CASE (Bconstant):
-#ifdef BYTE_CODE_SAFE
- if (op < Bconstant)
- {
- emacs_abort ();
- }
- if ((op -= Bconstant) >= const_length)
- {
- emacs_abort ();
- }
- PUSH (vectorp[op]);
-#else
+ if (BYTE_CODE_SAFE
+ && ! (Bconstant <= op && op < Bconstant + const_length))
+ emacs_abort ();
PUSH (vectorp[op - Bconstant]);
-#endif
NEXT;
}
}
exit:
- byte_stack_list = byte_stack_list->next;
-
/* Binds and unbinds are supposed to be compiled balanced. */
if (SPECPDL_INDEX () != count)
{
@@ -1984,9 +1432,25 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
error ("binding stack not balanced (serious byte compiler bug)");
}
+ Lisp_Object result = TOP;
+ SAFE_FREE ();
return result;
}
+/* `args_template' has the same meaning as in exec_byte_code() above. */
+Lisp_Object
+get_byte_code_arity (Lisp_Object args_template)
+{
+ eassert (NATNUMP (args_template));
+ EMACS_INT at = XINT (args_template);
+ bool rest = (at & 128) != 0;
+ int mandatory = at & 127;
+ EMACS_INT nonrest = at >> 8;
+
+ return Fcons (make_number (mandatory),
+ rest ? Qmany : make_number (nonrest));
+}
+
void
syms_of_bytecode (void)
{
@@ -2008,7 +1472,7 @@ The variable byte-code-meter indicates how often each byte opcode is used.
If a symbol has a property named `byte-code-meter' whose value is an
integer, it is incremented each time that symbol's function is called. */);
- byte_metering_on = 0;
+ byte_metering_on = false;
Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0));
DEFSYM (Qbyte_code_meter, "byte-code-meter");
{
diff --git a/src/callproc.c b/src/callproc.c
index 76b5caa4465..dc3ca4ac102 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -22,6 +22,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <errno.h>
#include <stdio.h>
+#include <stdlib.h>
#include <sys/types.h>
#include <unistd.h>
@@ -565,8 +566,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
{
/* Since CRLF is converted to LF within `decode_coding', we
can always open a file with binary mode. */
- callproc_fd[CALLPROC_PIPEREAD] = emacs_open (tempfile,
- O_RDONLY | O_BINARY, 0);
+ callproc_fd[CALLPROC_PIPEREAD] = emacs_open (tempfile, O_RDONLY, 0);
if (callproc_fd[CALLPROC_PIPEREAD] < 0)
{
int open_errno = errno;
@@ -1085,10 +1085,6 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
return unbind_to (count, val);
}
-#ifndef WINDOWSNT
-static int relocate_fd (int fd, int minfd);
-#endif
-
static char **
add_env (char **env, char **new_env, char *string)
{
@@ -1307,7 +1303,7 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp,
#ifdef WINDOWSNT
prepare_standard_handles (in, out, err, handles);
- set_process_dir (SDATA (current_dir));
+ set_process_dir (SSDATA (current_dir));
/* Spawn the child. (See w32proc.c:sys_spawnve). */
cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env);
reset_standard_handles (in, out, err, handles);
@@ -1317,43 +1313,23 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp,
return cpid;
#else /* not WINDOWSNT */
- /* Make sure that in, out, and err are not actually already in
- descriptors zero, one, or two; this could happen if Emacs is
- started with its standard in, out, or error closed, as might
- happen under X. */
- {
- int oin = in, oout = out;
-
- /* We have to avoid relocating the same descriptor twice! */
- in = relocate_fd (in, 3);
-
- if (out == oin)
- out = in;
- else
- out = relocate_fd (out, 3);
+#ifndef MSDOS
- if (err == oin)
- err = in;
- else if (err == oout)
- err = out;
- else
- err = relocate_fd (err, 3);
- }
+ restore_nofile_limit ();
-#ifndef MSDOS
/* Redirect file descriptors and clear the close-on-exec flag on the
redirected ones. IN, OUT, and ERR are close-on-exec so they
need not be closed explicitly. */
- dup2 (in, 0);
- dup2 (out, 1);
- dup2 (err, 2);
+ dup2 (in, STDIN_FILENO);
+ dup2 (out, STDOUT_FILENO);
+ dup2 (err, STDERR_FILENO);
setpgid (0, 0);
tcsetpgrp (0, pid);
- execve (new_argv[0], new_argv, env);
- exec_failed (new_argv[0], errno);
+ int errnum = emacs_exec_file (new_argv[0], new_argv, env);
+ exec_failed (new_argv[0], errnum);
#else /* MSDOS */
pid = run_msdos_command (new_argv, pwd_var + 4, in, out, err, env);
@@ -1366,31 +1342,6 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp,
#endif /* not WINDOWSNT */
}
-#ifndef WINDOWSNT
-/* Move the file descriptor FD so that its number is not less than MINFD.
- If the file descriptor is moved at all, the original is closed on MSDOS,
- but not elsewhere as the caller will close it anyway. */
-static int
-relocate_fd (int fd, int minfd)
-{
- if (fd >= minfd)
- return fd;
- else
- {
- int new = fcntl (fd, F_DUPFD_CLOEXEC, minfd);
- if (new == -1)
- {
- emacs_perror ("while setting up child");
- _exit (EXIT_CANCELED);
- }
-#ifdef MSDOS
- emacs_close (fd);
-#endif
- return new;
- }
-}
-#endif /* not WINDOWSNT */
-
static bool
getenv_internal_1 (const char *var, ptrdiff_t varlen, char **value,
ptrdiff_t *valuelen, Lisp_Object env)
@@ -1402,7 +1353,7 @@ getenv_internal_1 (const char *var, ptrdiff_t varlen, char **value,
&& SBYTES (entry) >= varlen
#ifdef WINDOWSNT
/* NT environment variables are case insensitive. */
- && ! strnicmp (SDATA (entry), var, varlen)
+ && ! strnicmp (SSDATA (entry), var, varlen)
#else /* not WINDOWSNT */
&& ! memcmp (SDATA (entry), var, varlen)
#endif /* not WINDOWSNT */
@@ -1435,6 +1386,20 @@ getenv_internal (const char *var, ptrdiff_t varlen, char **value,
Vprocess_environment))
return *value ? 1 : 0;
+ /* On Windows we make some modifications to Emacs' environment
+ without recording them in Vprocess_environment. */
+#ifdef WINDOWSNT
+ {
+ char* tmpval = getenv (var);
+ if (tmpval)
+ {
+ *value = tmpval;
+ *valuelen = strlen (tmpval);
+ return 1;
+ }
+ }
+#endif
+
/* For DISPLAY try to get the values from the frame or the initial env. */
if (strcmp (var, "DISPLAY") == 0)
{
diff --git a/src/casefiddle.c b/src/casefiddle.c
index c5bfa366630..2d32f498d0c 100644
--- a/src/casefiddle.c
+++ b/src/casefiddle.c
@@ -196,7 +196,7 @@ casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e)
ptrdiff_t start_byte;
/* Position of first and last changes. */
- ptrdiff_t first = -1, last IF_LINT (= 0);
+ ptrdiff_t first = -1, last;
ptrdiff_t opoint = PT;
ptrdiff_t opoint_byte = PT_BYTE;
@@ -294,15 +294,31 @@ casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e)
}
}
-DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 2, "r",
+DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 3,
+ "(list (region-beginning) (region-end) (region-noncontiguous-p))",
doc: /* Convert the region to upper case. In programs, wants two arguments.
These arguments specify the starting and ending character numbers of
the region to operate on. When used as a command, the text between
point and the mark is operated on.
See also `capitalize-region'. */)
- (Lisp_Object beg, Lisp_Object end)
+ (Lisp_Object beg, Lisp_Object end, Lisp_Object region_noncontiguous_p)
{
- casify_region (CASE_UP, beg, end);
+ Lisp_Object bounds = Qnil;
+
+ if (!NILP (region_noncontiguous_p))
+ {
+ bounds = call1 (Fsymbol_value (intern ("region-extract-function")),
+ intern ("bounds"));
+
+ while (CONSP (bounds))
+ {
+ casify_region (CASE_UP, XCAR (XCAR (bounds)), XCDR (XCAR (bounds)));
+ bounds = XCDR (bounds);
+ }
+ }
+ else
+ casify_region (CASE_UP, beg, end);
+
return Qnil;
}
@@ -360,22 +376,16 @@ character positions to operate on. */)
}
static Lisp_Object
-operate_on_word (Lisp_Object arg, ptrdiff_t *newpoint)
+casify_word (enum case_action flag, Lisp_Object arg)
{
- Lisp_Object val;
- ptrdiff_t farend;
- EMACS_INT iarg;
-
CHECK_NUMBER (arg);
- iarg = XINT (arg);
- farend = scan_words (PT, iarg);
+ ptrdiff_t farend = scan_words (PT, XINT (arg));
if (!farend)
- farend = iarg > 0 ? ZV : BEGV;
-
- *newpoint = PT > farend ? PT : farend;
- XSETFASTINT (val, farend);
-
- return val;
+ farend = XINT (arg) <= 0 ? BEGV : ZV;
+ ptrdiff_t newpoint = max (PT, farend);
+ casify_region (flag, make_number (PT), make_number (farend));
+ SET_PT (newpoint);
+ return Qnil;
}
DEFUN ("upcase-word", Fupcase_word, Supcase_word, 1, 1, "p",
@@ -388,13 +398,7 @@ With negative argument, convert previous words but do not move.
See also `capitalize-word'. */)
(Lisp_Object arg)
{
- Lisp_Object beg, end;
- ptrdiff_t newpoint;
- XSETFASTINT (beg, PT);
- end = operate_on_word (arg, &newpoint);
- casify_region (CASE_UP, beg, end);
- SET_PT (newpoint);
- return Qnil;
+ return casify_word (CASE_UP, arg);
}
DEFUN ("downcase-word", Fdowncase_word, Sdowncase_word, 1, 1, "p",
@@ -406,13 +410,7 @@ is ignored when moving forward.
With negative argument, convert previous words but do not move. */)
(Lisp_Object arg)
{
- Lisp_Object beg, end;
- ptrdiff_t newpoint;
- XSETFASTINT (beg, PT);
- end = operate_on_word (arg, &newpoint);
- casify_region (CASE_DOWN, beg, end);
- SET_PT (newpoint);
- return Qnil;
+ return casify_word (CASE_DOWN, arg);
}
DEFUN ("capitalize-word", Fcapitalize_word, Scapitalize_word, 1, 1, "p",
@@ -427,13 +425,7 @@ is ignored when moving forward.
With negative argument, capitalize previous words but do not move. */)
(Lisp_Object arg)
{
- Lisp_Object beg, end;
- ptrdiff_t newpoint;
- XSETFASTINT (beg, PT);
- end = operate_on_word (arg, &newpoint);
- casify_region (CASE_CAPITALIZE, beg, end);
- SET_PT (newpoint);
- return Qnil;
+ return casify_word (CASE_CAPITALIZE, arg);
}
void
diff --git a/src/ccl.c b/src/ccl.c
index d9620340f09..b9dc52e2568 100644
--- a/src/ccl.c
+++ b/src/ccl.c
@@ -1908,8 +1908,6 @@ ccl_get_compiled_code (Lisp_Object ccl_prog, ptrdiff_t *idx)
bool
setup_ccl_program (struct ccl_program *ccl, Lisp_Object ccl_prog)
{
- int i;
-
if (! NILP (ccl_prog))
{
struct Lisp_Vector *vp;
@@ -1931,8 +1929,7 @@ setup_ccl_program (struct ccl_program *ccl, Lisp_Object ccl_prog)
}
}
ccl->ic = CCL_HEADER_MAIN;
- for (i = 0; i < 8; i++)
- ccl->reg[i] = 0;
+ memset (ccl->reg, 0, sizeof ccl->reg);
ccl->last_block = false;
ccl->status = 0;
ccl->stack_idx = 0;
diff --git a/src/character.c b/src/character.c
index 9f60aa718d5..75a7dab6845 100644
--- a/src/character.c
+++ b/src/character.c
@@ -278,7 +278,7 @@ If the multibyte character does not represent a byte, return -1. */)
static ptrdiff_t
char_width (int c, struct Lisp_Char_Table *dp)
{
- ptrdiff_t width = CHAR_WIDTH (c);
+ ptrdiff_t width = CHARACTER_WIDTH (c);
if (dp)
{
@@ -291,7 +291,7 @@ char_width (int c, struct Lisp_Char_Table *dp)
ch = AREF (disp, i);
if (CHARACTERP (ch))
{
- int w = CHAR_WIDTH (XFASTINT (ch));
+ int w = CHARACTER_WIDTH (XFASTINT (ch));
if (INT_ADD_WRAPV (width, w, &width))
string_overflow ();
}
@@ -983,17 +983,26 @@ alphabeticp (int c)
|| gen_cat == UNICODE_CATEGORY_Nl);
}
-/* Return true if C is a decimal-number character. */
+/* Return true if C is a alphabetic or decimal-number character. */
bool
-decimalnump (int c)
+alphanumericp (int c)
{
Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c);
if (! INTEGERP (category))
return false;
EMACS_INT gen_cat = XINT (category);
- /* See UTS #18. */
- return gen_cat == UNICODE_CATEGORY_Nd;
+ /* See UTS #18. Same comment as for alphabeticp applies. FIXME. */
+ return (gen_cat == UNICODE_CATEGORY_Lu
+ || gen_cat == UNICODE_CATEGORY_Ll
+ || gen_cat == UNICODE_CATEGORY_Lt
+ || gen_cat == UNICODE_CATEGORY_Lm
+ || gen_cat == UNICODE_CATEGORY_Lo
+ || gen_cat == UNICODE_CATEGORY_Mn
+ || gen_cat == UNICODE_CATEGORY_Mc
+ || gen_cat == UNICODE_CATEGORY_Me
+ || gen_cat == UNICODE_CATEGORY_Nl
+ || gen_cat == UNICODE_CATEGORY_Nd);
}
/* Return true if C is a graphic character. */
diff --git a/src/character.h b/src/character.h
index a94ec6d22dd..fc8a0dd74d2 100644
--- a/src/character.h
+++ b/src/character.h
@@ -588,9 +588,10 @@ sanitize_char_width (EMACS_INT width)
/* Return the width of character C. The width is measured by how many
columns C will occupy on the screen when displayed in the current
- buffer. */
+ buffer. The name CHARACTER_WIDTH avoids a collision with <limits.h>
+ CHAR_WIDTH when enabled; see ISO/IEC TS 18661-1:2014. */
-#define CHAR_WIDTH(c) \
+#define CHARACTER_WIDTH(c) \
(ASCII_CHAR_P (c) \
? ASCII_CHAR_WIDTH (c) \
: sanitize_char_width (XINT (CHAR_TABLE_REF (Vchar_width_table, c))))
@@ -605,14 +606,13 @@ sanitize_char_width (EMACS_INT width)
: (c) <= 0xE01EF ? (c) - 0xE0100 + 17 \
: 0)
-/* If C is a high surrogate, return 1. If C is a low surrogate,
- return 2. Otherwise, return 0. */
+/* Return true if C is a surrogate. */
-#define CHAR_SURROGATE_PAIR_P(c) \
- ((c) < 0xD800 ? 0 \
- : (c) <= 0xDBFF ? 1 \
- : (c) <= 0xDFFF ? 2 \
- : 0)
+INLINE bool
+char_surrogate_p (int c)
+{
+ return 0xD800 <= c && c <= 0xDFFF;
+}
/* Data type for Unicode general category.
@@ -677,7 +677,7 @@ extern Lisp_Object Vchar_unify_table;
extern Lisp_Object string_escape_byte8 (Lisp_Object);
extern bool alphabeticp (int);
-extern bool decimalnump (int);
+extern bool alphanumericp (int);
extern bool graphicp (int);
extern bool printablep (int);
diff --git a/src/charset.c b/src/charset.c
index 8ff469e13a3..ff937bc5a13 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -30,6 +30,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <errno.h>
#include <stdio.h>
+#include <stdlib.h>
#include <unistd.h>
#include <limits.h>
#include <sys/types.h>
@@ -240,7 +241,8 @@ struct charset_map_entries
static void
load_charset_map (struct charset *charset, struct charset_map_entries *entries, int n_entries, int control_flag)
{
- Lisp_Object vec IF_LINT (= Qnil), table IF_LINT (= Qnil);
+ Lisp_Object vec;
+ Lisp_Object table UNINIT;
unsigned max_code = CHARSET_MAX_CODE (charset);
bool ascii_compatible_p = charset->ascii_compatible_p;
int min_char, max_char, nonascii_min_char;
@@ -434,7 +436,7 @@ read_hex (FILE *fp, bool *eof, bool *overflow)
n = 0;
while (c_isxdigit (c = getc (fp)))
{
- if (UINT_MAX >> 4 < n)
+ if (INT_LEFT_SHIFT_OVERFLOW (n, 4))
*overflow = 1;
n = ((n << 4)
| (c - ('0' <= c && c <= '9' ? '0'
@@ -842,9 +844,9 @@ usage: (define-charset-internal ...) */)
int nchars;
if (nargs != charset_arg_max)
- return Fsignal (Qwrong_number_of_arguments,
- Fcons (intern ("define-charset-internal"),
- make_number (nargs)));
+ Fsignal (Qwrong_number_of_arguments,
+ Fcons (intern ("define-charset-internal"),
+ make_number (nargs)));
attrs = Fmake_vector (make_number (charset_attr_max), Qnil);
@@ -1050,8 +1052,8 @@ usage: (define-charset-internal ...) */)
/* Here, we just copy the parent's fast_map. It's not accurate,
but at least it works for quickly detecting which character
DOESN'T belong to this charset. */
- for (i = 0; i < 190; i++)
- charset.fast_map[i] = parent_charset->fast_map[i];
+ memcpy (charset.fast_map, parent_charset->fast_map,
+ sizeof charset.fast_map);
/* We also copy these for parents. */
charset.min_char = parent_charset->min_char;
@@ -1400,7 +1402,7 @@ check_iso_charset_parameter (Lisp_Object dimension, Lisp_Object chars,
int final_ch = XFASTINT (final_char);
if (! ('0' <= final_ch && final_ch <= '~'))
- error ("Invalid FINAL-CHAR '%c', it should be '0'..'~'", final_ch);
+ error ("Invalid FINAL-CHAR `%c', it should be `0'..`~'", final_ch);
return chars_flag;
}
@@ -1838,12 +1840,12 @@ encode_char (struct charset *charset, int c)
}
-DEFUN ("decode-char", Fdecode_char, Sdecode_char, 2, 3, 0,
+DEFUN ("decode-char", Fdecode_char, Sdecode_char, 2, 2, 0,
doc: /* Decode the pair of CHARSET and CODE-POINT into a character.
Return nil if CODE-POINT is not valid in CHARSET.
CODE-POINT may be a cons (HIGHER-16-BIT-VALUE . LOWER-16-BIT-VALUE). */)
- (Lisp_Object charset, Lisp_Object code_point, Lisp_Object restriction)
+ (Lisp_Object charset, Lisp_Object code_point)
{
int c, id;
unsigned code;
@@ -1857,10 +1859,10 @@ CODE-POINT may be a cons (HIGHER-16-BIT-VALUE . LOWER-16-BIT-VALUE). */)
}
-DEFUN ("encode-char", Fencode_char, Sencode_char, 2, 3, 0,
+DEFUN ("encode-char", Fencode_char, Sencode_char, 2, 2, 0,
doc: /* Encode the character CH into a code-point of CHARSET.
Return nil if CHARSET doesn't include CH. */)
- (Lisp_Object ch, Lisp_Object charset, Lisp_Object restriction)
+ (Lisp_Object ch, Lisp_Object charset)
{
int c, id;
unsigned code;
diff --git a/src/chartab.c b/src/chartab.c
index 6cf8fea0b6d..fa5a8e41164 100644
--- a/src/chartab.c
+++ b/src/chartab.c
@@ -492,7 +492,7 @@ char_table_set_range (Lisp_Object table, int from, int to, Lisp_Object val)
int lim = CHARTAB_IDX (to, 0, 0);
int i, c;
- for (i = CHARTAB_IDX (from, 0, 0), c = 0; i <= lim;
+ for (i = CHARTAB_IDX (from, 0, 0), c = i * chartab_chars[0]; i <= lim;
i++, c += chartab_chars[0])
{
if (c > to)
diff --git a/src/cm.c b/src/cm.c
index 4f94c079315..e135889f17c 100644
--- a/src/cm.c
+++ b/src/cm.c
@@ -321,7 +321,7 @@ cmgoto (struct tty_display_info *tty, int row, int col)
llcost,
relcost,
directcost;
- int use IF_LINT (= 0);
+ int use UNINIT;
char *p;
const char *dcm;
diff --git a/src/coding.c b/src/coding.c
index 3e4af722e4c..feed9c8274c 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -2365,7 +2365,8 @@ decode_coding_emacs_mule (struct coding_system *coding)
while (1)
{
- int c, id IF_LINT (= 0);
+ int c;
+ int id UNINIT;
src_base = src;
consumed_chars_base = consumed_chars;
@@ -2410,7 +2411,7 @@ decode_coding_emacs_mule (struct coding_system *coding)
}
else
{
- int nchars IF_LINT (= 0), nbytes IF_LINT (= 0);
+ int nchars UNINIT, nbytes UNINIT;
/* emacs_mule_char can load a charset map from a file, which
allocates a large structure and might cause buffer text
to be relocated as result. Thus, we need to remember the
@@ -6814,39 +6815,33 @@ decode_eol (struct coding_system *coding)
else if (EQ (eol_type, Qdos))
{
ptrdiff_t n = 0;
+ ptrdiff_t pos = coding->dst_pos;
+ ptrdiff_t pos_byte = coding->dst_pos_byte;
+ ptrdiff_t pos_end = pos_byte + coding->produced - 1;
- if (NILP (coding->dst_object))
- {
- /* Start deleting '\r' from the tail to minimize the memory
- movement. */
- for (p = pend - 2; p >= pbeg; p--)
- if (*p == '\r')
- {
- memmove (p, p + 1, pend-- - p - 1);
- n++;
- }
- }
- else
+ /* This assertion is here instead of code, now deleted, that
+ handled the NILP case, which no longer happens with the
+ current codebase. */
+ eassert (!NILP (coding->dst_object));
+
+ while (pos_byte < pos_end)
{
- ptrdiff_t pos = coding->dst_pos;
- ptrdiff_t pos_byte = coding->dst_pos_byte;
- ptrdiff_t pos_end = pos_byte + coding->produced - 1;
+ int incr;
+
+ p = BYTE_POS_ADDR (pos_byte);
+ if (coding->dst_multibyte)
+ incr = BYTES_BY_CHAR_HEAD (*p);
+ else
+ incr = 1;
- while (pos_byte < pos_end)
+ if (*p == '\r' && p[1] == '\n')
{
- p = BYTE_POS_ADDR (pos_byte);
- if (*p == '\r' && p[1] == '\n')
- {
- del_range_2 (pos, pos_byte, pos + 1, pos_byte + 1, 0);
- n++;
- pos_end--;
- }
- pos++;
- if (coding->dst_multibyte)
- pos_byte += BYTES_BY_CHAR_HEAD (*p);
- else
- pos_byte++;
+ del_range_2 (pos, pos_byte, pos + 1, pos_byte + 1, 0);
+ n++;
+ pos_end--;
}
+ pos++;
+ pos_byte += incr;
}
coding->produced -= n;
coding->produced_char -= n;
@@ -6957,18 +6952,21 @@ get_translation_table (Lisp_Object attrs, bool encodep, int *max_lookup)
/* Return a translation of character(s) at BUF according to TRANS.
- TRANS is TO-CHAR or ((FROM . TO) ...) where
- FROM = [FROM-CHAR ...], TO is TO-CHAR or [TO-CHAR ...].
- The return value is TO-CHAR or ([FROM-CHAR ...] . TO) if a
- translation is found, and Qnil if not found..
- If BUF is too short to lookup characters in FROM, return Qt. */
+ TRANS is TO-CHAR, [TO-CHAR ...], or ((FROM . TO) ...) where FROM =
+ [FROM-CHAR ...], TO is TO-CHAR or [TO-CHAR ...]. The return value
+ is TO-CHAR or [TO-CHAR ...] if a translation is found, Qnil if not
+ found, or Qt if BUF is too short to lookup characters in FROM. As
+ a side effect, if a translation is found, *NCHARS is set to the
+ number of characters being translated. */
static Lisp_Object
-get_translation (Lisp_Object trans, int *buf, int *buf_end)
+get_translation (Lisp_Object trans, int *buf, int *buf_end, ptrdiff_t *nchars)
{
-
- if (INTEGERP (trans))
- return trans;
+ if (INTEGERP (trans) || VECTORP (trans))
+ {
+ *nchars = 1;
+ return trans;
+ }
for (; CONSP (trans); trans = XCDR (trans))
{
Lisp_Object val = XCAR (trans);
@@ -6984,7 +6982,10 @@ get_translation (Lisp_Object trans, int *buf, int *buf_end)
break;
}
if (i == len)
- return val;
+ {
+ *nchars = len;
+ return XCDR (val);
+ }
}
return Qnil;
}
@@ -7027,20 +7028,13 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table,
LOOKUP_TRANSLATION_TABLE (translation_table, c, trans);
if (! NILP (trans))
{
- trans = get_translation (trans, buf, buf_end);
+ trans = get_translation (trans, buf, buf_end, &from_nchars);
if (INTEGERP (trans))
c = XINT (trans);
- else if (CONSP (trans))
+ else if (VECTORP (trans))
{
- from_nchars = ASIZE (XCAR (trans));
- trans = XCDR (trans);
- if (INTEGERP (trans))
- c = XINT (trans);
- else
- {
- to_nchars = ASIZE (trans);
- c = XINT (AREF (trans, 0));
- }
+ to_nchars = ASIZE (trans);
+ c = XINT (AREF (trans, 0));
}
else if (EQ (trans, Qt) && ! last_block)
break;
@@ -7681,22 +7675,16 @@ consume_chars (struct coding_system *coding, Lisp_Object translation_table,
for (i = 1; i < max_lookup && p < src_end; i++)
lookup_buf[i] = STRING_CHAR_ADVANCE (p);
lookup_buf_end = lookup_buf + i;
- trans = get_translation (trans, lookup_buf, lookup_buf_end);
+ trans = get_translation (trans, lookup_buf, lookup_buf_end,
+ &from_nchars);
if (INTEGERP (trans))
c = XINT (trans);
- else if (CONSP (trans))
+ else if (VECTORP (trans))
{
- from_nchars = ASIZE (XCAR (trans));
- trans = XCDR (trans);
- if (INTEGERP (trans))
- c = XINT (trans);
- else
- {
- to_nchars = ASIZE (trans);
- if (buf_end - buf < to_nchars)
- break;
- c = XINT (AREF (trans, 0));
- }
+ to_nchars = ASIZE (trans);
+ if (buf_end - buf < to_nchars)
+ break;
+ c = XINT (AREF (trans, 0));
}
else
break;
@@ -7863,6 +7851,15 @@ code_conversion_save (bool with_work_buf, bool multibyte)
return workbuf;
}
+static void
+coding_restore_undo_list (Lisp_Object arg)
+{
+ Lisp_Object undo_list = XCAR (arg);
+ struct buffer *buf = XBUFFER (XCDR (arg));
+
+ bset_undo_list (buf, undo_list);
+}
+
void
decode_coding_gap (struct coding_system *coding,
ptrdiff_t chars, ptrdiff_t bytes)
@@ -7975,13 +7972,19 @@ decode_coding_gap (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 ();
+ record_unwind_protect (coding_restore_undo_list,
+ Fcons (undo_list, Fcurrent_buffer ()));
+ bset_undo_list (current_buffer, Qt);
TEMP_SET_PT_BOTH (coding->dst_pos, coding->dst_pos_byte);
val = call1 (CODING_ATTR_POST_READ (attrs),
make_number (coding->produced_char));
CHECK_NATNUM (val);
coding->produced_char += Z - prev_Z;
coding->produced += Z_BYTE - prev_Z_BYTE;
+ unbind_to (count1, Qnil);
}
unbind_to (count, Qnil);
@@ -8025,12 +8028,12 @@ decode_coding_object (struct coding_system *coding,
Lisp_Object dst_object)
{
ptrdiff_t count = SPECPDL_INDEX ();
- unsigned char *destination IF_LINT (= NULL);
- ptrdiff_t dst_bytes IF_LINT (= 0);
+ unsigned char *destination;
+ ptrdiff_t dst_bytes;
ptrdiff_t chars = to - from;
ptrdiff_t bytes = to_byte - from_byte;
Lisp_Object attrs;
- ptrdiff_t saved_pt = -1, saved_pt_byte IF_LINT (= 0);
+ ptrdiff_t saved_pt = -1, saved_pt_byte;
bool need_marker_adjustment = 0;
Lisp_Object old_deactivate_mark;
@@ -8122,13 +8125,19 @@ 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 ();
+ record_unwind_protect (coding_restore_undo_list,
+ Fcons (undo_list, Fcurrent_buffer ()));
+ bset_undo_list (current_buffer, Qt);
TEMP_SET_PT_BOTH (coding->dst_pos, coding->dst_pos_byte);
val = safe_call1 (CODING_ATTR_POST_READ (attrs),
make_number (coding->produced_char));
CHECK_NATNUM (val);
coding->produced_char += Z - prev_Z;
coding->produced += Z_BYTE - prev_Z_BYTE;
+ unbind_to (count1, Qnil);
}
if (EQ (dst_object, Qt))
@@ -8208,7 +8217,7 @@ encode_coding_object (struct coding_system *coding,
ptrdiff_t chars = to - from;
ptrdiff_t bytes = to_byte - from_byte;
Lisp_Object attrs;
- ptrdiff_t saved_pt = -1, saved_pt_byte IF_LINT (= 0);
+ ptrdiff_t saved_pt = -1, saved_pt_byte;
bool need_marker_adjustment = 0;
bool kill_src_buffer = 0;
Lisp_Object old_deactivate_mark;
@@ -8429,11 +8438,10 @@ from_unicode (Lisp_Object str)
Lisp_Object
from_unicode_buffer (const wchar_t *wstr)
{
- return from_unicode (
- make_unibyte_string (
- (char *) wstr,
- /* we get one of the two final 0 bytes for free. */
- 1 + sizeof (wchar_t) * wcslen (wstr)));
+ /* We get one of the two final null bytes for free. */
+ ptrdiff_t len = 1 + sizeof (wchar_t) * wcslen (wstr);
+ AUTO_STRING_WITH_LEN (str, (char *) wstr, len);
+ return from_unicode (str);
}
wchar_t *
@@ -8583,8 +8591,8 @@ detect_coding_system (const unsigned char *src,
base_category = XINT (CODING_ATTR_CATEGORY (attrs));
if (base_category == coding_category_undecided)
{
- enum coding_category category IF_LINT (= 0);
- struct coding_system *this IF_LINT (= NULL);
+ enum coding_category category UNINIT;
+ struct coding_system *this UNINIT;
int c, i;
bool inhibit_nbd = inhibit_flag (coding.spec.undecided.inhibit_nbd,
inhibit_null_byte_detection);
@@ -9854,7 +9862,8 @@ usage: (find-operation-coding-system OPERATION ARGUMENTS...) */)
if (!(STRINGP (target)
|| (EQ (operation, Qinsert_file_contents) && CONSP (target)
&& STRINGP (XCAR (target)) && BUFFERP (XCDR (target)))
- || (EQ (operation, Qopen_network_stream) && INTEGERP (target))))
+ || (EQ (operation, Qopen_network_stream)
+ && (INTEGERP (target) || EQ (target, Qt)))))
error ("Invalid argument %"pI"d of operation `%s'",
XFASTINT (target_idx) + 1, SDATA (SYMBOL_NAME (operation)));
if (CONSP (target))
@@ -10558,9 +10567,9 @@ usage: (define-coding-system-internal ...) */)
return Qnil;
short_args:
- return Fsignal (Qwrong_number_of_arguments,
- Fcons (intern ("define-coding-system-internal"),
- make_number (nargs)));
+ Fsignal (Qwrong_number_of_arguments,
+ Fcons (intern ("define-coding-system-internal"),
+ make_number (nargs)));
}
@@ -11319,24 +11328,4 @@ internal character representation. */);
#endif
staticpro (&system_eol_type);
}
-
-char *
-emacs_strerror (int error_number)
-{
- char *str;
-
- synchronize_system_messages_locale ();
- str = strerror (error_number);
-
- if (! NILP (Vlocale_coding_system))
- {
- Lisp_Object dec = code_convert_string_norecord (build_string (str),
- Vlocale_coding_system,
- 0);
- str = SSDATA (dec);
- }
-
- return str;
-}
-
#endif /* emacs */
diff --git a/src/coding.h b/src/coding.h
index 93ddff0c6bd..426be6277ca 100644
--- a/src/coding.h
+++ b/src/coding.h
@@ -768,8 +768,6 @@ extern Lisp_Object preferred_coding_system (void);
#ifdef emacs
-extern char *emacs_strerror (int);
-
/* Coding system to be used to encode text for terminal display when
terminal coding system is nil. */
extern struct coding_system safe_terminal_coding;
diff --git a/src/composite.c b/src/composite.c
index 49b00036361..da921358e9f 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -335,7 +335,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
ch = XINT (key_contents[i]);
/* TAB in a composition means display glyphs with padding
space on the left or right. */
- this_width = (ch == '\t' ? 1 : CHAR_WIDTH (ch));
+ this_width = (ch == '\t' ? 1 : CHARACTER_WIDTH (ch));
if (cmp->width < this_width)
cmp->width = this_width;
}
@@ -346,7 +346,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
double leftmost = 0.0, rightmost;
ch = XINT (key_contents[0]);
- rightmost = ch != '\t' ? CHAR_WIDTH (ch) : 1;
+ rightmost = ch != '\t' ? CHARACTER_WIDTH (ch) : 1;
for (i = 1; i < glyph_len; i += 2)
{
@@ -356,7 +356,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
rule = XINT (key_contents[i]);
ch = XINT (key_contents[i + 1]);
- this_width = ch != '\t' ? CHAR_WIDTH (ch) : 1;
+ this_width = ch != '\t' ? CHARACTER_WIDTH (ch) : 1;
/* A composition rule is specified by an integer value
that encodes global and new reference points (GREF and
@@ -891,7 +891,6 @@ autocmp_chars (Lisp_Object rule, ptrdiff_t charpos, ptrdiff_t bytepos,
if (len <= 0)
return unbind_to (count, Qnil);
to = limit = charpos + len;
-#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
{
font_object = font_range (charpos, bytepos, &to, win, face, string);
@@ -902,7 +901,6 @@ autocmp_chars (Lisp_Object rule, ptrdiff_t charpos, ptrdiff_t bytepos,
return unbind_to (count, Qnil);
}
else
-#endif /* not HAVE_WINDOW_SYSTEM */
font_object = win->frame;
lgstring = Fcomposition_get_gstring (pos, make_number (to), font_object,
string);
@@ -1308,7 +1306,8 @@ composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos,
int
composition_update_it (struct composition_it *cmp_it, ptrdiff_t charpos, ptrdiff_t bytepos, Lisp_Object string)
{
- int i, c IF_LINT (= 0);
+ int i;
+ int c UNINIT;
if (cmp_it->ch < 0)
{
@@ -1384,7 +1383,7 @@ composition_update_it (struct composition_it *cmp_it, ptrdiff_t charpos, ptrdiff
{
c = XINT (LGSTRING_CHAR (gstring, from + i));
cmp_it->nbytes += CHAR_BYTES (c);
- cmp_it->width += CHAR_WIDTH (c);
+ cmp_it->width += CHARACTER_WIDTH (c);
}
}
return c;
diff --git a/src/conf_post.h b/src/conf_post.h
index d8070fad8e7..060b912fafb 100644
--- a/src/conf_post.h
+++ b/src/conf_post.h
@@ -18,31 +18,33 @@ 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 <http://www.gnu.org/licenses/>. */
-/* Commentary:
+/* Put the code here rather than in configure.ac using AH_BOTTOM.
+ This way, the code does not get processed by autoheader. For
+ example, undefs here are not commented out.
- Rather than writing this code directly in AH_BOTTOM, we include it
- via this file. This is so that it does not get processed by
- autoheader. Eg, any undefs here would otherwise be commented out.
-*/
+ To help make dependencies clearer elsewhere, this file typically
+ does not #include other files. The exceptions are first stdbool.h
+ because it is unlikely to interfere with configuration and bool is
+ such a core part of the C language, and second ms-w32.h (DOS_NT
+ only) because it historically was included here and changing that
+ would take some work. */
-/* Code: */
+#include <stdbool.h>
-/* Include any platform specific configuration file. */
-#ifdef config_opsysfile
-# include config_opsysfile
+#if defined DOS_NT && !defined DEFER_MS_W32_H
+# include <ms-w32.h>
#endif
-#include <stdbool.h>
-
/* GNUC_PREREQ (V, W, X) is true if this is GNU C version V.W.X or later.
It can be used in a preprocessor expression. */
#ifndef __GNUC_MINOR__
# define GNUC_PREREQ(v, w, x) false
#elif ! defined __GNUC_PATCHLEVEL__
-# define GNUC_PREREQ(v, w, x) ((v) < __GNUC__ + ((w) <= __GNUC_MINOR__))
+# define GNUC_PREREQ(v, w, x) \
+ ((v) < __GNUC__ + ((w) < __GNUC_MINOR__ + ((x) == 0))
#else
# define GNUC_PREREQ(v, w, x) \
- ((v) < __GNUC__ + ((w) <= __GNUC_MINOR__ + ((x) <= __GNUC_PATCHLEVEL__)))
+ ((v) < __GNUC__ + ((w) < __GNUC_MINOR__ + ((x) <= __GNUC_PATCHLEVEL__)))
#endif
/* The type of bool bitfields. Needed to compile Objective-C with
@@ -54,25 +56,23 @@ typedef unsigned int bool_bf;
typedef bool bool_bf;
#endif
-#ifndef WINDOWSNT
-/* On AIX 3 this must be included before any other include file. */
-#include <alloca.h>
-#if ! HAVE_ALLOCA
-# error "alloca not available on this machine"
-#endif
-#endif
-
/* Simulate __has_attribute on compilers that lack it. It is used only
on arguments like alloc_size that are handled in this simulation. */
#ifndef __has_attribute
# define __has_attribute(a) __has_attribute_##a
-# define __has_attribute_alloc_size (4 < __GNUC__ + (3 <= __GNUC_MINOR__))
-# define __has_attribute_cleanup (3 < __GNUC__ + (4 <= __GNUC_MINOR__))
-# define __has_attribute_externally_visible \
- (4 < __GNUC__ + (1 <= __GNUC_MINOR__))
+# define __has_attribute_alloc_size GNUC_PREREQ (4, 3, 0)
+# define __has_attribute_cleanup GNUC_PREREQ (3, 4, 0)
+# define __has_attribute_externally_visible GNUC_PREREQ (4, 1, 0)
# define __has_attribute_no_address_safety_analysis false
-# define __has_attribute_no_sanitize_address \
- (4 < __GNUC__ + (8 <= __GNUC_MINOR__))
+# define __has_attribute_no_sanitize_address GNUC_PREREQ (4, 8, 0)
+#endif
+
+/* Simulate __has_builtin on compilers that lack it. It is used only
+ on arguments like __builtin_assume_aligned that are handled in this
+ simulation. */
+#ifndef __has_builtin
+# define __has_builtin(a) __has_builtin_##a
+# define __has_builtin___builtin_assume_aligned GNUC_PREREQ (4, 7, 0)
#endif
/* Simulate __has_feature on compilers that lack it. It is used only
@@ -88,6 +88,11 @@ typedef bool bool_bf;
# define ADDRESS_SANITIZER false
#endif
+/* Yield PTR, which must be aligned to ALIGNMENT. */
+#if ! __has_builtin (__builtin_assume_aligned)
+# define __builtin_assume_aligned(ptr, ...) ((void *) (ptr))
+#endif
+
#ifdef DARWIN_OS
#ifdef emacs
#define malloc unexec_malloc
@@ -110,12 +115,9 @@ typedef bool bool_bf;
#ifdef emacs
#define malloc hybrid_malloc
#define realloc hybrid_realloc
+#define aligned_alloc hybrid_aligned_alloc
#define calloc hybrid_calloc
#define free hybrid_free
-#if defined HAVE_GET_CURRENT_DIR_NAME && !defined BROKEN_GET_CURRENT_DIR_NAME
-#define HYBRID_GET_CURRENT_DIR_NAME 1
-#define get_current_dir_name hybrid_get_current_dir_name
-#endif
#endif
#endif /* HYBRID_MALLOC */
@@ -131,14 +133,6 @@ typedef bool bool_bf;
#undef HAVE_RINT
#endif /* HPUX */
-#ifdef IRIX6_5
-#ifdef emacs
-char *_getpty();
-#endif
-#define INET6 /* Needed for struct sockaddr_in6. */
-#undef HAVE_GETADDRINFO /* IRIX has getaddrinfo but not struct addrinfo. */
-#endif /* IRIX6_5 */
-
#ifdef MSDOS
#ifndef __DJGPP__
You lose; /* Emacs for DOS must be compiled with DJGPP */
@@ -203,7 +197,7 @@ You lose; /* Emacs for DOS must be compiled with DJGPP */
#endif
#ifdef CYGWIN
-#define SYSTEM_PURESIZE_EXTRA 10000
+#define SYSTEM_PURESIZE_EXTRA 50000
#endif
#if defined HAVE_NTGUI && !defined DebPrint
@@ -211,7 +205,7 @@ You lose; /* Emacs for DOS must be compiled with DJGPP */
extern void _DebPrint (const char *fmt, ...);
# define DebPrint(stuff) _DebPrint stuff
# else
-# define DebPrint(stuff)
+# define DebPrint(stuff) ((void) 0)
# endif
#endif
@@ -238,9 +232,6 @@ extern void _DebPrint (const char *fmt, ...);
extern char *emacs_getenv_TZ (void);
extern int emacs_setenv_TZ (char const *);
-#include <string.h>
-#include <stdlib.h>
-
#if __GNUC__ >= 3 /* On GCC 3.0 we might get a warning. */
#define NO_INLINE __attribute__((noinline))
#else
@@ -253,19 +244,21 @@ extern int emacs_setenv_TZ (char const *);
#define EXTERNALLY_VISIBLE
#endif
-#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7)
+#if GNUC_PREREQ (2, 7, 0)
# define ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec))
#else
# define ATTRIBUTE_FORMAT(spec) /* empty */
#endif
-#if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4)
-# define ATTRIBUTE_FORMAT_PRINTF(formatstring_parameter, first_argument) \
- ATTRIBUTE_FORMAT ((__gnu_printf__, formatstring_parameter, first_argument))
+#if GNUC_PREREQ (4, 4, 0) && defined __GLIBC_MINOR__
+# define PRINTF_ARCHETYPE __gnu_printf__
+#elif GNUC_PREREQ (4, 4, 0) && defined __MINGW32__
+# define PRINTF_ARCHETYPE __ms_printf__
#else
-# define ATTRIBUTE_FORMAT_PRINTF(formatstring_parameter, first_argument) \
- ATTRIBUTE_FORMAT ((__printf__, formatstring_parameter, first_argument))
+# define PRINTF_ARCHETYPE __printf__
#endif
+#define ATTRIBUTE_FORMAT_PRINTF(string_index, first_to_check) \
+ ATTRIBUTE_FORMAT ((PRINTF_ARCHETYPE, string_index, first_to_check))
#define ATTRIBUTE_CONST _GL_ATTRIBUTE_CONST
#define ATTRIBUTE_UNUSED _GL_UNUSED
@@ -289,7 +282,7 @@ extern int emacs_setenv_TZ (char const *);
no_sanitize_address attribute. This bug is fixed in GCC 4.9.0 and
clang 3.4. */
#if (! ADDRESS_SANITIZER \
- || ((4 < __GNUC__ + (9 <= __GNUC_MINOR__)) \
+ || (GNUC_PREREQ (4, 9, 0) \
|| 3 < __clang_major__ + (4 <= __clang_minor__)))
# define ADDRESS_SANITIZER_WORKAROUND /* No workaround needed. */
#else
@@ -355,22 +348,10 @@ extern int emacs_setenv_TZ (char const *);
#define INLINE_HEADER_BEGIN _GL_INLINE_HEADER_BEGIN
#define INLINE_HEADER_END _GL_INLINE_HEADER_END
-/* To use the struct hack with N elements, declare the struct like this:
- struct s { ...; t name[FLEXIBLE_ARRAY_MEMBER]; };
- and allocate (offsetof (struct s, name) + N * sizeof (t)) bytes.
- IBM xlc 12.1 claims to do C99 but mishandles flexible array members. */
-#ifdef __IBMC__
-# define FLEXIBLE_ARRAY_MEMBER 1
+/* 'int x UNINIT;' is equivalent to 'int x;', except it cajoles GCC
+ into not warning incorrectly about use of an uninitialized variable. */
+#if defined GCC_LINT || defined lint
+# define UNINIT = {0,}
#else
-# define FLEXIBLE_ARRAY_MEMBER
+# define UNINIT /* empty */
#endif
-
-/* Use this to suppress gcc's `...may be used before initialized' warnings. */
-#ifdef lint
-/* Use CODE only if lint checking is in effect. */
-# define IF_LINT(Code) Code
-#else
-# define IF_LINT(Code) /* empty */
-#endif
-
-/* conf_post.h ends here */
diff --git a/src/cygw32.c b/src/cygw32.c
index 682232035f6..ca9069a120b 100644
--- a/src/cygw32.c
+++ b/src/cygw32.c
@@ -31,7 +31,7 @@ fchdir_unwind (int dir_fd)
}
static void
-chdir_to_default_directory ()
+chdir_to_default_directory (void)
{
Lisp_Object new_cwd;
int old_cwd_fd = emacs_open (".", O_RDONLY | O_DIRECTORY, 0);
@@ -46,7 +46,7 @@ chdir_to_default_directory ()
if (!STRINGP (new_cwd))
new_cwd = build_string ("/");
- if (chdir (SDATA (ENCODE_FILE (new_cwd))))
+ if (chdir (SSDATA (ENCODE_FILE (new_cwd))))
error ("could not chdir: %s", strerror (errno));
}
diff --git a/src/data.c b/src/data.c
index 3a51129d182..d221db429d1 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1619,8 +1619,8 @@ The function `default-value' gets the default value and `set-default' sets it.
{
struct Lisp_Symbol *sym;
struct Lisp_Buffer_Local_Value *blv = NULL;
- union Lisp_Val_Fwd valcontents IF_LINT (= {LISP_INITIALLY_ZERO});
- bool forwarded IF_LINT (= 0);
+ union Lisp_Val_Fwd valcontents;
+ bool forwarded;
CHECK_SYMBOL (variable);
sym = XSYMBOL (variable);
@@ -1697,8 +1697,8 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
(Lisp_Object variable)
{
Lisp_Object tem;
- bool forwarded IF_LINT (= 0);
- union Lisp_Val_Fwd valcontents IF_LINT (= {LISP_INITIALLY_ZERO});
+ bool forwarded;
+ union Lisp_Val_Fwd valcontents;
struct Lisp_Symbol *sym;
struct Lisp_Buffer_Local_Value *blv = NULL;
@@ -2463,7 +2463,7 @@ uintmax_t
cons_to_unsigned (Lisp_Object c, uintmax_t max)
{
bool valid = 0;
- uintmax_t val IF_LINT (= 0);
+ uintmax_t val;
if (INTEGERP (c))
{
valid = 0 <= XINT (c);
@@ -2516,7 +2516,7 @@ intmax_t
cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max)
{
bool valid = 0;
- intmax_t val IF_LINT (= 0);
+ intmax_t val;
if (INTEGERP (c))
{
val = XINT (c);
@@ -2935,11 +2935,11 @@ In this case, the sign bit is duplicated. */)
CHECK_NUMBER (value);
CHECK_NUMBER (count);
- if (XINT (count) >= BITS_PER_EMACS_INT)
+ if (XINT (count) >= EMACS_INT_WIDTH)
XSETINT (val, 0);
else if (XINT (count) > 0)
XSETINT (val, XUINT (value) << XFASTINT (count));
- else if (XINT (count) <= -BITS_PER_EMACS_INT)
+ else if (XINT (count) <= -EMACS_INT_WIDTH)
XSETINT (val, XINT (value) < 0 ? -1 : 0);
else
XSETINT (val, XINT (value) >> -XINT (count));
@@ -2957,11 +2957,11 @@ In this case, zeros are shifted in on the left. */)
CHECK_NUMBER (value);
CHECK_NUMBER (count);
- if (XINT (count) >= BITS_PER_EMACS_INT)
+ if (XINT (count) >= EMACS_INT_WIDTH)
XSETINT (val, 0);
else if (XINT (count) > 0)
XSETINT (val, XUINT (value) << XFASTINT (count));
- else if (XINT (count) <= -BITS_PER_EMACS_INT)
+ else if (XINT (count) <= -EMACS_INT_WIDTH)
XSETINT (val, 0);
else
XSETINT (val, XUINT (value) >> -XINT (count));
@@ -3031,24 +3031,24 @@ bool_vector_spare_mask (EMACS_INT nr_bits)
/* Info about unsigned long long, falling back on unsigned long
if unsigned long long is not available. */
-#if HAVE_UNSIGNED_LONG_LONG_INT && defined ULLONG_MAX
-enum { BITS_PER_ULL = CHAR_BIT * sizeof (unsigned long long) };
+#if HAVE_UNSIGNED_LONG_LONG_INT && defined ULLONG_WIDTH
+enum { ULL_WIDTH = ULLONG_WIDTH };
# define ULL_MAX ULLONG_MAX
#else
-enum { BITS_PER_ULL = CHAR_BIT * sizeof (unsigned long) };
+enum { ULL_WIDTH = ULONG_WIDTH };
# define ULL_MAX ULONG_MAX
# define count_one_bits_ll count_one_bits_l
# define count_trailing_zeros_ll count_trailing_zeros_l
#endif
/* Shift VAL right by the width of an unsigned long long.
- BITS_PER_ULL must be less than BITS_PER_BITS_WORD. */
+ ULL_WIDTH must be less than BITS_PER_BITS_WORD. */
static bits_word
shift_right_ull (bits_word w)
{
/* Pacify bogus GCC warning about shift count exceeding type width. */
- int shift = BITS_PER_ULL - BITS_PER_BITS_WORD < 0 ? BITS_PER_ULL : 0;
+ int shift = ULL_WIDTH - BITS_PER_BITS_WORD < 0 ? ULL_WIDTH : 0;
return w >> shift;
}
@@ -3065,7 +3065,7 @@ count_one_bits_word (bits_word w)
{
int i = 0, count = 0;
while (count += count_one_bits_ll (w),
- (i += BITS_PER_ULL) < BITS_PER_BITS_WORD)
+ (i += ULL_WIDTH) < BITS_PER_BITS_WORD)
w = shift_right_ull (w);
return count;
}
@@ -3210,18 +3210,18 @@ count_trailing_zero_bits (bits_word val)
{
int count;
for (count = 0;
- count < BITS_PER_BITS_WORD - BITS_PER_ULL;
- count += BITS_PER_ULL)
+ count < BITS_PER_BITS_WORD - ULL_WIDTH;
+ count += ULL_WIDTH)
{
if (val & ULL_MAX)
return count + count_trailing_zeros_ll (val);
val = shift_right_ull (val);
}
- if (BITS_PER_BITS_WORD % BITS_PER_ULL != 0
+ if (BITS_PER_BITS_WORD % ULL_WIDTH != 0
&& BITS_WORD_MAX == (bits_word) -1)
val |= (bits_word) 1 << pre_value (ULONG_MAX < BITS_WORD_MAX,
- BITS_PER_BITS_WORD % BITS_PER_ULL);
+ BITS_PER_BITS_WORD % ULL_WIDTH);
return count + count_trailing_zeros_ll (val);
}
}
diff --git a/src/dbusbind.c b/src/dbusbind.c
index 56bfd7164a4..a0146a3bf53 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -20,6 +20,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifdef HAVE_DBUS
#include <stdio.h>
+#include <stdlib.h>
#include <dbus/dbus.h>
#include "lisp.h"
@@ -168,25 +169,25 @@ static int
xd_symbol_to_dbus_type (Lisp_Object object)
{
return
- ((EQ (object, QCdbus_type_byte)) ? DBUS_TYPE_BYTE
- : (EQ (object, QCdbus_type_boolean)) ? DBUS_TYPE_BOOLEAN
- : (EQ (object, QCdbus_type_int16)) ? DBUS_TYPE_INT16
- : (EQ (object, QCdbus_type_uint16)) ? DBUS_TYPE_UINT16
- : (EQ (object, QCdbus_type_int32)) ? DBUS_TYPE_INT32
- : (EQ (object, QCdbus_type_uint32)) ? DBUS_TYPE_UINT32
- : (EQ (object, QCdbus_type_int64)) ? DBUS_TYPE_INT64
- : (EQ (object, QCdbus_type_uint64)) ? DBUS_TYPE_UINT64
- : (EQ (object, QCdbus_type_double)) ? DBUS_TYPE_DOUBLE
- : (EQ (object, QCdbus_type_string)) ? DBUS_TYPE_STRING
- : (EQ (object, QCdbus_type_object_path)) ? DBUS_TYPE_OBJECT_PATH
- : (EQ (object, QCdbus_type_signature)) ? DBUS_TYPE_SIGNATURE
+ (EQ (object, QCbyte) ? DBUS_TYPE_BYTE
+ : EQ (object, QCboolean) ? DBUS_TYPE_BOOLEAN
+ : EQ (object, QCint16) ? DBUS_TYPE_INT16
+ : EQ (object, QCuint16) ? DBUS_TYPE_UINT16
+ : EQ (object, QCint32) ? DBUS_TYPE_INT32
+ : EQ (object, QCuint32) ? DBUS_TYPE_UINT32
+ : EQ (object, QCint64) ? DBUS_TYPE_INT64
+ : EQ (object, QCuint64) ? DBUS_TYPE_UINT64
+ : EQ (object, QCdouble) ? DBUS_TYPE_DOUBLE
+ : EQ (object, QCstring) ? DBUS_TYPE_STRING
+ : EQ (object, QCobject_path) ? DBUS_TYPE_OBJECT_PATH
+ : EQ (object, QCsignature) ? DBUS_TYPE_SIGNATURE
#ifdef DBUS_TYPE_UNIX_FD
- : (EQ (object, QCdbus_type_unix_fd)) ? DBUS_TYPE_UNIX_FD
+ : EQ (object, QCunix_fd) ? DBUS_TYPE_UNIX_FD
#endif
- : (EQ (object, QCdbus_type_array)) ? DBUS_TYPE_ARRAY
- : (EQ (object, QCdbus_type_variant)) ? DBUS_TYPE_VARIANT
- : (EQ (object, QCdbus_type_struct)) ? DBUS_TYPE_STRUCT
- : (EQ (object, QCdbus_type_dict_entry)) ? DBUS_TYPE_DICT_ENTRY
+ : EQ (object, QCarray) ? DBUS_TYPE_ARRAY
+ : EQ (object, QCvariant) ? DBUS_TYPE_VARIANT
+ : EQ (object, QCstruct) ? DBUS_TYPE_STRUCT
+ : EQ (object, QCdict_entry) ? DBUS_TYPE_DICT_ENTRY
: DBUS_TYPE_INVALID);
}
@@ -257,16 +258,16 @@ XD_OBJECT_TO_STRING (Lisp_Object object)
if ((session_bus_address != NULL) \
&& (!NILP (Fstring_equal \
(bus, build_string (session_bus_address))))) \
- bus = QCdbus_session_bus; \
+ bus = QCsession; \
} \
\
else \
{ \
CHECK_SYMBOL (bus); \
- if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus))) \
+ if (!(EQ (bus, QCsystem) || EQ (bus, QCsession))) \
XD_SIGNAL2 (build_string ("Wrong bus name"), bus); \
/* We do not want to have an autolaunch for the session bus. */ \
- if (EQ (bus, QCdbus_session_bus) && session_bus_address == NULL) \
+ if (EQ (bus, QCsession) && session_bus_address == NULL) \
XD_SIGNAL2 (build_string ("No connection to bus"), bus); \
} \
} while (0)
@@ -395,7 +396,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object)
CHECK_CONS (object);
/* Type symbol is optional. */
- if (EQ (QCdbus_type_array, CAR_SAFE (elt)))
+ if (EQ (QCarray, CAR_SAFE (elt)))
elt = XD_NEXT_VALUE (elt);
/* If the array is empty, DBUS_TYPE_STRING is the default
@@ -1009,8 +1010,7 @@ xd_add_watch (DBusWatch *watch, void *data)
}
/* Stop monitoring WATCH for possible I/O.
- DATA is the used bus, either a string or QCdbus_system_bus or
- QCdbus_session_bus. */
+ DATA is the used bus, either a string or QCsystem or QCsession. */
static void
xd_remove_watch (DBusWatch *watch, void *data)
{
@@ -1025,7 +1025,7 @@ xd_remove_watch (DBusWatch *watch, void *data)
/* Unset session environment. */
#if 0
/* This is buggy, since unsetenv is not thread-safe. */
- if (XSYMBOL (QCdbus_session_bus) == data)
+ if (XSYMBOL (QCsession) == data)
{
XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
unsetenv ("DBUS_SESSION_BUS_ADDRESS");
@@ -1147,14 +1147,14 @@ this connection to those buses. */)
connection = dbus_connection_open_private (SSDATA (bus), &derror);
else
- if (NILP (private))
- connection = dbus_bus_get (EQ (bus, QCdbus_system_bus)
- ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION,
- &derror);
- else
- connection = dbus_bus_get_private (EQ (bus, QCdbus_system_bus)
- ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION,
- &derror);
+ {
+ DBusBusType bustype = (EQ (bus, QCsystem)
+ ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION);
+ if (NILP (private))
+ connection = dbus_bus_get (bustype, &derror);
+ else
+ connection = dbus_bus_get_private (bustype, &derror);
+ }
if (dbus_error_is_set (&derror))
XD_ERROR (derror);
@@ -1405,7 +1405,7 @@ usage: (dbus-message-internal &rest REST) */)
}
/* Check for timeout parameter. */
- if ((count+2 <= nargs) && (EQ ((args[count]), QCdbus_timeout)))
+ if ((count + 2 <= nargs) && EQ (args[count], QCtimeout))
{
CHECK_NATNUM (args[count+1]);
timeout = min (XFASTINT (args[count+1]), INT_MAX);
@@ -1452,8 +1452,7 @@ usage: (dbus-message-internal &rest REST) */)
/* The result is the key in Vdbus_registered_objects_table. */
serial = dbus_message_get_serial (dmessage);
- result = list3 (QCdbus_registered_serial,
- bus, make_fixnum_or_float (serial));
+ result = list3 (QCserial, bus, make_fixnum_or_float (serial));
/* Create a hash table entry. */
Fputhash (result, handler, Vdbus_registered_objects_table);
@@ -1540,8 +1539,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
|| (mtype == DBUS_MESSAGE_TYPE_ERROR))
{
/* Search for a registered function of the message. */
- key = list3 (QCdbus_registered_serial, bus,
- make_fixnum_or_float (serial));
+ key = list3 (QCserial, bus, make_fixnum_or_float (serial));
value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
/* There shall be exactly one entry. Construct an event. */
@@ -1566,9 +1564,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
goto cleanup;
/* Search for a registered function of the message. */
- key = list4 ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
- ? QCdbus_registered_method
- : QCdbus_registered_signal,
+ key = list4 (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL ? QCmethod : QCsignal,
bus, build_string (interface), build_string (member));
value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
@@ -1697,37 +1693,37 @@ syms_of_dbusbind (void)
build_pure_c_string ("D-Bus error"));
/* Lisp symbols of the system and session buses. */
- DEFSYM (QCdbus_system_bus, ":system");
- DEFSYM (QCdbus_session_bus, ":session");
+ DEFSYM (QCsystem, ":system");
+ DEFSYM (QCsession, ":session");
/* Lisp symbol for method call timeout. */
- DEFSYM (QCdbus_timeout, ":timeout");
+ DEFSYM (QCtimeout, ":timeout");
/* Lisp symbols of D-Bus types. */
- DEFSYM (QCdbus_type_byte, ":byte");
- DEFSYM (QCdbus_type_boolean, ":boolean");
- DEFSYM (QCdbus_type_int16, ":int16");
- DEFSYM (QCdbus_type_uint16, ":uint16");
- DEFSYM (QCdbus_type_int32, ":int32");
- DEFSYM (QCdbus_type_uint32, ":uint32");
- DEFSYM (QCdbus_type_int64, ":int64");
- DEFSYM (QCdbus_type_uint64, ":uint64");
- DEFSYM (QCdbus_type_double, ":double");
- DEFSYM (QCdbus_type_string, ":string");
- DEFSYM (QCdbus_type_object_path, ":object-path");
- DEFSYM (QCdbus_type_signature, ":signature");
+ DEFSYM (QCbyte, ":byte");
+ DEFSYM (QCboolean, ":boolean");
+ DEFSYM (QCint16, ":int16");
+ DEFSYM (QCuint16, ":uint16");
+ DEFSYM (QCint32, ":int32");
+ DEFSYM (QCuint32, ":uint32");
+ DEFSYM (QCint64, ":int64");
+ DEFSYM (QCuint64, ":uint64");
+ DEFSYM (QCdouble, ":double");
+ DEFSYM (QCstring, ":string");
+ DEFSYM (QCobject_path, ":object-path");
+ DEFSYM (QCsignature, ":signature");
#ifdef DBUS_TYPE_UNIX_FD
- DEFSYM (QCdbus_type_unix_fd, ":unix-fd");
+ DEFSYM (QCunix_fd, ":unix-fd");
#endif
- DEFSYM (QCdbus_type_array, ":array");
- DEFSYM (QCdbus_type_variant, ":variant");
- DEFSYM (QCdbus_type_struct, ":struct");
- DEFSYM (QCdbus_type_dict_entry, ":dict-entry");
+ DEFSYM (QCarray, ":array");
+ DEFSYM (QCvariant, ":variant");
+ DEFSYM (QCstruct, ":struct");
+ DEFSYM (QCdict_entry, ":dict-entry");
/* Lisp symbols of objects in `dbus-registered-objects-table'. */
- DEFSYM (QCdbus_registered_serial, ":serial");
- DEFSYM (QCdbus_registered_method, ":method");
- DEFSYM (QCdbus_registered_signal, ":signal");
+ DEFSYM (QCserial, ":serial");
+ DEFSYM (QCmethod, ":method");
+ DEFSYM (QCsignal, ":signal");
DEFVAR_LISP ("dbus-compiled-version",
Vdbus_compiled_version,
diff --git a/src/decompress.c b/src/decompress.c
index 1213f482f77..6ebf74aaf5e 100644
--- a/src/decompress.c
+++ b/src/decompress.c
@@ -42,7 +42,7 @@ static bool zlib_initialized;
static bool
init_zlib_functions (void)
{
- HMODULE library = w32_delayed_load (Qzlib_dll);
+ HMODULE library = w32_delayed_load (Qzlib);
if (!library)
return false;
@@ -91,7 +91,7 @@ DEFUN ("zlib-available-p", Fzlib_available_p, Szlib_available_p, 0, 0, 0,
(void)
{
#ifdef WINDOWSNT
- Lisp_Object found = Fassq (Qzlib_dll, Vlibrary_cache);
+ Lisp_Object found = Fassq (Qzlib, Vlibrary_cache);
if (CONSP (found))
return XCDR (found);
else
@@ -99,7 +99,7 @@ DEFUN ("zlib-available-p", Fzlib_available_p, Szlib_available_p, 0, 0, 0,
Lisp_Object status;
zlib_initialized = init_zlib_functions ();
status = zlib_initialized ? Qt : Qnil;
- Vlibrary_cache = Fcons (Fcons (Qzlib_dll, status), Vlibrary_cache);
+ Vlibrary_cache = Fcons (Fcons (Qzlib, status), Vlibrary_cache);
return status;
}
#else
diff --git a/src/dired.c b/src/dired.c
index dba575ce4c2..e468147e8b2 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -42,12 +42,15 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "buffer.h"
#include "coding.h"
#include "regex.h"
-#include "blockinput.h"
#ifdef MSDOS
#include "msdos.h" /* for fstatat */
#endif
+#ifdef WINDOWSNT
+extern int is_slow_fs (const char *);
+#endif
+
static ptrdiff_t scmp (const char *, const char *, ptrdiff_t);
static Lisp_Object file_attributes (int, char const *, Lisp_Object);
@@ -69,8 +72,6 @@ open_directory (Lisp_Object dirname, int *fdp)
DIR *d;
int fd, opendir_errno;
- block_input ();
-
#ifdef DOS_NT
/* Directories cannot be opened. The emulation assumes that any
file descriptor other than AT_FDCWD corresponds to the most
@@ -94,8 +95,6 @@ open_directory (Lisp_Object dirname, int *fdp)
}
#endif
- unblock_input ();
-
if (!d)
report_file_errno ("Opening directory", dirname, opendir_errno);
*fdp = fd;
@@ -103,7 +102,7 @@ open_directory (Lisp_Object dirname, int *fdp)
}
#ifdef WINDOWSNT
-void
+static void
directory_files_internal_w32_unwind (Lisp_Object arg)
{
Vw32_get_true_file_attributes = arg;
@@ -111,12 +110,9 @@ directory_files_internal_w32_unwind (Lisp_Object arg)
#endif
static void
-directory_files_internal_unwind (void *dh)
+directory_files_internal_unwind (void *d)
{
- DIR *d = dh;
- block_input ();
closedir (d);
- unblock_input ();
}
/* Return the next directory entry from DIR; DIR's name is DIRNAME.
@@ -214,8 +210,6 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
#ifdef WINDOWSNT
if (attrs)
{
- extern int is_slow_fs (const char *);
-
/* Do this only once to avoid doing it (in w32.c:stat) for each
file in the directory, when we call Ffile_attributes below. */
record_unwind_protect (directory_files_internal_w32_unwind,
@@ -225,7 +219,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
{
/* w32.c:stat will notice these bindings and avoid calling
GetDriveType for each file. */
- if (is_slow_fs (SDATA (dirfilename)))
+ if (is_slow_fs (SSDATA (dirfilename)))
Vw32_get_true_file_attributes = Qnil;
else
Vw32_get_true_file_attributes = Qt;
@@ -307,9 +301,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
}
}
- block_input ();
closedir (d);
- unblock_input ();
#ifdef WINDOWSNT
if (attrs)
Vw32_get_true_file_attributes = w32_save;
@@ -860,6 +852,14 @@ below) - valid values are `string' and `integer'. The latter is the
default, but we plan to change that, so you should specify a non-nil value
for ID-FORMAT if you use the returned uid or gid.
+To access the elements returned, the following access functions are
+provided: `file-attribute-type', `file-attribute-link-number',
+`file-attribute-user-id', `file-attribute-group-id',
+`file-attribute-access-time', `file-attribute-modification-time',
+`file-attribute-status-change-time', `file-attribute-size',
+`file-attribute-modes', `file-attribute-inode-number', and
+`file-attribute-device-number'.
+
Elements of the attribute list are:
0. t for directory, string (name linked to) for symbolic link, or nil.
1. Number of links to file.
@@ -950,10 +950,8 @@ file_attributes (int fd, char const *name, Lisp_Object id_format)
if (!(NILP (id_format) || EQ (id_format, Qinteger)))
{
- block_input ();
uname = stat_uname (&s);
gname = stat_gname (&s);
- unblock_input ();
}
filemodestring (&s, modes);
diff --git a/src/dispextern.h b/src/dispextern.h
index 7b9ae78dcd3..f27279975ac 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -82,6 +82,7 @@ typedef XImagePtr XImagePtr_or_DC;
#ifdef HAVE_WINDOW_SYSTEM
# include <time.h>
+# include "fontset.h"
#endif
#ifndef HAVE_WINDOW_SYSTEM
@@ -1275,7 +1276,6 @@ struct glyph_string
/* X display and window for convenience. */
Display *display;
- Window window;
/* The glyph row for which this string was built. It determines the
y-origin and height of the string. */
@@ -1812,36 +1812,46 @@ struct face_cache
bool_bf menu_face_changed_p : 1;
};
+/* Return a non-null pointer to the cached face with ID on frame F. */
+
+#define FACE_FROM_ID(F, ID) \
+ (eassert (UNSIGNED_CMP (ID, <, FRAME_FACE_CACHE (F)->used)), \
+ FRAME_FACE_CACHE (F)->faces_by_id[ID])
+
/* Return a pointer to the face with ID on frame F, or null if such a
face doesn't exist. */
-#define FACE_FROM_ID(F, ID) \
- (UNSIGNED_CMP (ID, <, FRAME_FACE_CACHE (F)->used) \
- ? FRAME_FACE_CACHE (F)->faces_by_id[ID] \
- : NULL)
+#define FACE_FROM_ID_OR_NULL(F, ID) \
+ (UNSIGNED_CMP (ID, <, FRAME_FACE_CACHE (F)->used) \
+ ? FRAME_FACE_CACHE (F)->faces_by_id[ID] \
+ : NULL)
+/* True if FACE is suitable for displaying ASCII characters. */
+INLINE bool
+FACE_SUITABLE_FOR_ASCII_CHAR_P (struct face *face)
+{
#ifdef HAVE_WINDOW_SYSTEM
-
-/* Non-zero if FACE is suitable for displaying character CHAR. */
-
-#define FACE_SUITABLE_FOR_ASCII_CHAR_P(FACE, CHAR) \
- ((FACE) == (FACE)->ascii_face)
+ return face == face->ascii_face;
+#else
+ return true;
+#endif
+}
/* Return the id of the realized face on frame F that is like the face
- FACE, but is suitable for displaying character CHAR at buffer or
+ FACE, but is suitable for displaying character CHARACTER at buffer or
string position POS. OBJECT is the string object, or nil for
buffer. This macro is only meaningful for multibyte character
CHAR. */
-
-#define FACE_FOR_CHAR(F, FACE, CHAR, POS, OBJECT) \
- face_for_char ((F), (FACE), (CHAR), (POS), (OBJECT))
-
-#else /* not HAVE_WINDOW_SYSTEM */
-
-#define FACE_SUITABLE_FOR_ASCII_CHAR_P(FACE, CHAR) true
-#define FACE_FOR_CHAR(F, FACE, CHAR, POS, OBJECT) ((FACE)->id)
-
-#endif /* not HAVE_WINDOW_SYSTEM */
+INLINE int
+FACE_FOR_CHAR (struct frame *f, struct face *face, int character,
+ ptrdiff_t pos, Lisp_Object object)
+{
+#ifdef HAVE_WINDOW_SYSTEM
+ return face_for_char (f, face, character, pos, object);
+#else
+ return face->id;
+#endif
+}
/* Return true if G contains a valid character code. */
INLINE bool
@@ -2226,7 +2236,7 @@ struct composition_it
/* Indices of the glyphs for the current grapheme cluster. */
int from, to;
/* Width of the current grapheme cluster in units of columns it will
- occupy on display; see CHAR_WIDTH. */
+ occupy on display; see CHARACTER_WIDTH. */
int width;
};
@@ -3083,13 +3093,19 @@ struct image_cache
};
+/* A non-null pointer to the image with id ID on frame F. */
+
+#define IMAGE_FROM_ID(F, ID) \
+ (eassert (UNSIGNED_CMP (ID, <, FRAME_IMAGE_CACHE (F)->used)), \
+ FRAME_IMAGE_CACHE (F)->images[ID])
+
/* Value is a pointer to the image with id ID on frame F, or null if
no image with that id exists. */
-#define IMAGE_FROM_ID(F, ID) \
- (((ID) >= 0 && (ID) < (FRAME_IMAGE_CACHE (F)->used)) \
- ? FRAME_IMAGE_CACHE (F)->images[ID] \
- : NULL)
+#define IMAGE_OPT_FROM_ID(F, ID) \
+ (UNSIGNED_CMP (ID, <, FRAME_IMAGE_CACHE (F)->used) \
+ ? FRAME_IMAGE_CACHE (F)->images[ID] \
+ : NULL)
/* Size of bucket vector of image caches. Should be prime. */
@@ -3340,6 +3356,10 @@ void x_cr_init_fringe (struct redisplay_interface *);
extern unsigned row_hash (struct glyph_row *);
+extern void block_buffer_flips(void);
+extern void unblock_buffer_flips(void);
+extern bool buffer_flipping_blocked_p(void);
+
/* Defined in image.c */
#ifdef HAVE_WINDOW_SYSTEM
diff --git a/src/dispnew.c b/src/dispnew.c
index 3a0532a693b..70d4de07aac 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -21,6 +21,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include "sysstdio.h"
+#include <stdlib.h>
#include <unistd.h>
#include "lisp.h"
@@ -5177,8 +5178,8 @@ buffer_posn_from_coords (struct window *w, int *x, int *y, struct display_pos *p
#ifdef HAVE_WINDOW_SYSTEM
if (it.what == IT_IMAGE)
{
- if ((img = IMAGE_FROM_ID (it.f, it.image_id)) != NULL
- && !NILP (img->spec))
+ img = IMAGE_OPT_FROM_ID (it.f, it.image_id);
+ if (img && !NILP (img->spec))
*object = img->spec;
}
#endif
@@ -5275,7 +5276,7 @@ mode_line_string (struct window *w, enum window_part part,
if (glyph->type == IMAGE_GLYPH)
{
struct image *img;
- img = IMAGE_FROM_ID (WINDOW_XFRAME (w), glyph->u.img_id);
+ img = IMAGE_OPT_FROM_ID (WINDOW_XFRAME (w), glyph->u.img_id);
if (img != NULL)
*object = img->spec;
y0 -= row->ascent - glyph->ascent;
@@ -5362,7 +5363,7 @@ marginal_area_string (struct window *w, enum window_part part,
if (glyph->type == IMAGE_GLYPH)
{
struct image *img;
- img = IMAGE_FROM_ID (WINDOW_XFRAME (w), glyph->u.img_id);
+ img = IMAGE_OPT_FROM_ID (WINDOW_XFRAME (w), glyph->u.img_id);
if (img != NULL)
*object = img->spec;
y0 -= row->ascent - glyph->ascent;
@@ -6038,11 +6039,11 @@ init_display (void)
#endif
/* If no window system has been specified, try to use the terminal. */
- if (! isatty (0))
+ if (! isatty (STDIN_FILENO))
fatal ("standard input is not a tty");
#ifdef WINDOWSNT
- terminal_type = "w32console";
+ terminal_type = (char *)"w32console";
#else
terminal_type = getenv ("TERM");
#endif
diff --git a/src/doc.c b/src/doc.c
index 36d18b99b05..ce4f89b94dd 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -339,16 +339,7 @@ string is passed through `substitute-command-keys'. */)
if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
fun = XCDR (fun);
if (SUBRP (fun))
- {
- if (XSUBR (fun)->doc == 0)
- return Qnil;
- /* FIXME: This is not portable, as it assumes that string
- pointers have the top bit clear. */
- else if ((intptr_t) XSUBR (fun)->doc >= 0)
- doc = build_string (XSUBR (fun)->doc);
- else
- doc = make_number ((intptr_t) XSUBR (fun)->doc);
- }
+ doc = make_number (XSUBR (fun)->doc);
else if (COMPILEDP (fun))
{
if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
@@ -473,7 +464,7 @@ aren't strings. */)
/* Scanning the DOC files and placing docstring offsets into functions. */
static void
-store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
+store_function_docstring (Lisp_Object obj, EMACS_INT offset)
{
/* Don't use indirect_function here, or defaliases will apply their
docstrings to the base functions (Bug#2603). */
@@ -481,15 +472,10 @@ store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
/* The type determines where the docstring is stored. */
- /* Lisp_Subrs have a slot for it. */
- if (SUBRP (fun))
- {
- intptr_t negative_offset = - offset;
- XSUBR (fun)->doc = (char *) negative_offset;
- }
-
/* If it's a lisp form, stick it in the form. */
- else if (CONSP (fun))
+ if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
+ fun = XCDR (fun);
+ if (CONSP (fun))
{
Lisp_Object tem;
@@ -503,10 +489,12 @@ store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
correctness is quite delicate. */
XSETCAR (tem, make_number (offset));
}
- else if (EQ (tem, Qmacro))
- store_function_docstring (XCDR (fun), offset);
}
+ /* Lisp_Subrs have a slot for it. */
+ else if (SUBRP (fun))
+ XSUBR (fun)->doc = offset;
+
/* Bytecode objects sometimes have slots for it. */
else if (COMPILEDP (fun))
{
@@ -726,13 +714,13 @@ summary).
Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
as the keymap for future \\=\\[COMMAND] substrings.
-Each \\=‘ and \\=` is replaced by left quote, and each \\=’ and \\='
+Each grave accent \\=` is replaced by left quote, and each apostrophe \\='
is replaced by right quote. Left and right quote characters are
specified by `text-quoting-style'.
-\\=\\= quotes the following character and is discarded; thus,
-\\=\\=\\=\\= puts \\=\\= into the output, \\=\\=\\=\\[ puts \\=\\[ into the output, and
-\\=\\=\\=` puts \\=` into the output.
+\\=\\= quotes the following character and is discarded; thus, \\=\\=\\=\\= puts \\=\\=
+into the output, \\=\\=\\=\\[ puts \\=\\[ into the output, and \\=\\=\\=` puts \\=` into the
+output.
Return the original STRING if no substitutions are made.
Otherwise, return a new string. */)
@@ -750,25 +738,20 @@ Otherwise, return a new string. */)
unsigned char const *start;
ptrdiff_t length, length_byte;
Lisp_Object name;
- bool multibyte, pure_ascii;
ptrdiff_t nchars;
if (NILP (string))
return Qnil;
- CHECK_STRING (string);
- tem = Qnil;
- keymap = Qnil;
- name = Qnil;
+ /* If STRING contains non-ASCII unibyte data, process its
+ properly-encoded multibyte equivalent instead. This simplifies
+ the implementation and is OK since substitute-command-keys is
+ intended for use only on text strings. Keep STRING around, since
+ it will be returned if no changes occur. */
+ Lisp_Object str = Fstring_make_multibyte (string);
enum text_quoting_style quoting_style = text_quoting_style ();
- multibyte = STRING_MULTIBYTE (string);
- /* Pure-ASCII unibyte input strings should produce unibyte strings
- if substitution doesn't yield non-ASCII bytes, otherwise they
- should produce multibyte strings. */
- pure_ascii = SBYTES (string) == count_size_as_multibyte (SDATA (string),
- SCHARS (string));
nchars = 0;
/* KEYMAP is either nil (which means search all the active keymaps)
@@ -777,59 +760,53 @@ Otherwise, return a new string. */)
or from a \\<mapname> construct in STRING itself.. */
keymap = Voverriding_local_map;
- bsize = SBYTES (string);
+ ptrdiff_t strbytes = SBYTES (str);
+ bsize = strbytes;
+
+ /* Fixed-size stack buffer. */
+ char sbuf[MAX_ALLOCA];
- /* Add some room for expansion due to quote replacement. */
- enum { EXTRA_ROOM = 20 };
- if (bsize <= STRING_BYTES_BOUND - EXTRA_ROOM)
- bsize += EXTRA_ROOM;
+ /* Heap-allocated buffer, if any. */
+ char *abuf;
- bufp = buf = xmalloc (bsize);
+ /* Extra room for expansion due to replacing ‘\[]’ with ‘M-x ’. */
+ enum { EXTRA_ROOM = sizeof "M-x " - sizeof "\\[]" };
+
+ if (bsize <= sizeof sbuf - EXTRA_ROOM)
+ {
+ abuf = NULL;
+ buf = sbuf;
+ bsize = sizeof sbuf;
+ }
+ else
+ buf = abuf = xpalloc (NULL, &bsize, EXTRA_ROOM, STRING_BYTES_BOUND, 1);
+ bufp = buf;
- strp = SDATA (string);
- while (strp < SDATA (string) + SBYTES (string))
+ strp = SDATA (str);
+ while (strp < SDATA (str) + strbytes)
{
- if (strp[0] == '\\' && strp[1] == '=')
+ unsigned char *close_bracket;
+
+ if (strp[0] == '\\' && strp[1] == '='
+ && strp + 2 < SDATA (str) + strbytes)
{
/* \= quotes the next character;
thus, to put in \[ without its special meaning, use \=\[. */
changed = nonquotes_changed = true;
strp += 2;
- if (multibyte)
- {
- int len;
-
- STRING_CHAR_AND_LENGTH (strp, len);
- if (len == 1)
- *bufp = *strp;
- else
- memcpy (bufp, strp, len);
- strp += len;
- bufp += len;
- nchars++;
- }
- else
- *bufp++ = *strp++, nchars++;
+ /* Fall through to copy one char. */
}
- else if (strp[0] == '\\' && strp[1] == '[')
+ else if (strp[0] == '\\' && strp[1] == '['
+ && (close_bracket
+ = memchr (strp + 2, ']',
+ SDATA (str) + strbytes - (strp + 2))))
{
- ptrdiff_t start_idx;
bool follow_remap = 1;
- strp += 2; /* skip \[ */
- start = strp;
- start_idx = start - SDATA (string);
-
- while ((strp - SDATA (string)
- < SBYTES (string))
- && *strp != ']')
- strp++;
- length_byte = strp - start;
-
- strp++; /* skip ] */
+ start = strp + 2;
+ length_byte = close_bracket - start;
+ idx = close_bracket + 1 - SDATA (str);
- /* Save STRP in IDX. */
- idx = strp - SDATA (string);
name = Fintern (make_string ((char *) start, length_byte), Qnil);
do_remap:
@@ -844,25 +821,17 @@ Otherwise, return a new string. */)
goto do_remap;
}
- /* Note the Fwhere_is_internal can GC, so we have to take
- relocation of string contents into account. */
- strp = SDATA (string) + idx;
- start = SDATA (string) + start_idx;
+ /* Fwhere_is_internal can GC, so take relocation of string
+ contents into account. */
+ strp = SDATA (str) + idx;
+ start = strp - length_byte - 1;
if (NILP (tem)) /* but not on any keys */
{
- ptrdiff_t offset = bufp - buf;
- if (STRING_BYTES_BOUND - 4 < bsize)
- string_overflow ();
- buf = xrealloc (buf, bsize += 4);
- bufp = buf + offset;
memcpy (bufp, "M-x ", 4);
bufp += 4;
nchars += 4;
- if (multibyte)
- length = multibyte_chars_in_text (start, length_byte);
- else
- length = length_byte;
+ length = multibyte_chars_in_text (start, length_byte);
goto subst;
}
else
@@ -873,28 +842,20 @@ Otherwise, return a new string. */)
}
/* \{foo} is replaced with a summary of the keymap (symbol-value foo).
\<foo> just sets the keymap used for \[cmd]. */
- else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
+ else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<')
+ && (close_bracket
+ = memchr (strp + 2, strp[1] == '{' ? '}' : '>',
+ SDATA (str) + strbytes - (strp + 2))))
{
- struct buffer *oldbuf;
- ptrdiff_t start_idx;
+ {
+ bool generate_summary = strp[1] == '{';
/* This is for computing the SHADOWS arg for describe_map_tree. */
Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
- Lisp_Object earlier_maps;
ptrdiff_t count = SPECPDL_INDEX ();
- strp += 2; /* skip \{ or \< */
- start = strp;
- start_idx = start - SDATA (string);
-
- while ((strp - SDATA (string) < SBYTES (string))
- && *strp != '}' && *strp != '>')
- strp++;
-
- length_byte = strp - start;
- strp++; /* skip } or > */
-
- /* Save STRP in IDX. */
- idx = strp - SDATA (string);
+ start = strp + 2;
+ length_byte = close_bracket - start;
+ idx = close_bracket + 1 - SDATA (str);
/* Get the value of the keymap in TEM, or nil if undefined.
Do this while still in the user's current buffer
@@ -905,16 +866,11 @@ Otherwise, return a new string. */)
{
tem = Fsymbol_value (name);
if (! NILP (tem))
- {
- tem = get_keymap (tem, 0, 1);
- /* Note that get_keymap can GC. */
- strp = SDATA (string) + idx;
- start = SDATA (string) + start_idx;
- }
+ tem = get_keymap (tem, 0, 1);
}
/* Now switch to a temp buffer. */
- oldbuf = current_buffer;
+ struct buffer *oldbuf = current_buffer;
set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
/* This is for an unusual case where some after-change
function uses 'format' or 'prin1' or something else that
@@ -931,15 +887,17 @@ Otherwise, return a new string. */)
SBYTES (name), 1);
AUTO_STRING (msg_suffix, "', which is not currently defined.\n");
insert1 (Fsubstitute_command_keys (msg_suffix));
- if (start[-1] == '<') keymap = Qnil;
+ if (!generate_summary)
+ keymap = Qnil;
}
- else if (start[-1] == '<')
+ else if (!generate_summary)
keymap = tem;
else
{
/* Get the list of active keymaps that precede this one.
If this one's not active, get nil. */
- earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
+ Lisp_Object earlier_maps
+ = Fcdr (Fmemq (tem, Freverse (active_maps)));
describe_map_tree (tem, 1, Fnreverse (earlier_maps),
Qnil, 0, 1, 0, 0, 1);
}
@@ -947,42 +905,52 @@ Otherwise, return a new string. */)
Ferase_buffer ();
set_buffer_internal (oldbuf);
unbind_to (count, Qnil);
+ }
subst_string:
+ /* Convert non-ASCII unibyte data to properly-encoded multibyte,
+ for the same reason STRING was converted to STR. */
+ tem = Fstring_make_multibyte (tem);
start = SDATA (tem);
+ length = SCHARS (tem);
length_byte = SBYTES (tem);
- if (multibyte || pure_ascii)
- length = SCHARS (tem);
- else
- length = length_byte;
subst:
nonquotes_changed = true;
subst_quote:
changed = true;
{
ptrdiff_t offset = bufp - buf;
- if (STRING_BYTES_BOUND - length_byte < bsize)
+ ptrdiff_t avail = bsize - offset;
+ ptrdiff_t need = strbytes - idx;
+ if (INT_ADD_WRAPV (need, length_byte + EXTRA_ROOM, &need))
string_overflow ();
- buf = xrealloc (buf, bsize += length_byte);
- bufp = buf + offset;
+ if (avail < need)
+ {
+ abuf = xpalloc (abuf, &bsize, need - avail,
+ STRING_BYTES_BOUND, 1);
+ if (buf == sbuf)
+ memcpy (abuf, sbuf, offset);
+ buf = abuf;
+ bufp = buf + offset;
+ }
memcpy (bufp, start, length_byte);
bufp += length_byte;
nchars += length;
- /* Check STRING again in case gc relocated it. */
- strp = SDATA (string) + idx;
+
+ /* Some of the previous code can GC, so take relocation of
+ string contents into account. */
+ strp = SDATA (str) + idx;
+
+ continue;
}
}
else if ((strp[0] == '`' || strp[0] == '\'')
- && quoting_style == CURVE_QUOTING_STYLE
- && (multibyte || pure_ascii))
+ && quoting_style == CURVE_QUOTING_STYLE)
{
start = (unsigned char const *) (strp[0] == '`' ? uLSQM : uRSQM);
+ length = 1;
length_byte = sizeof uLSQM - 1;
- if (multibyte || pure_ascii)
- length = 1;
- else
- length = length_byte;
- idx = strp - SDATA (string) + 1;
+ idx = strp - SDATA (str) + 1;
goto subst_quote;
}
else if (strp[0] == '`' && quoting_style == STRAIGHT_QUOTING_STYLE)
@@ -991,31 +959,14 @@ Otherwise, return a new string. */)
strp++;
nchars++;
changed = true;
+ continue;
}
- else if (! multibyte)
- *bufp++ = *strp++, nchars++;
- else
- {
- int len;
- int ch = STRING_CHAR_AND_LENGTH (strp, len);
- if ((ch == LEFT_SINGLE_QUOTATION_MARK
- || ch == RIGHT_SINGLE_QUOTATION_MARK)
- && quoting_style != CURVE_QUOTING_STYLE)
- {
- *bufp++ = ((ch == LEFT_SINGLE_QUOTATION_MARK
- && quoting_style == GRAVE_QUOTING_STYLE)
- ? '`' : '\'');
- strp += len;
- changed = true;
- }
- else
- {
- do
- *bufp++ = *strp++;
- while (--len != 0);
- }
- nchars++;
- }
+
+ /* Copy one char. */
+ do
+ *bufp++ = *strp++;
+ while (! CHAR_HEAD_P (*strp));
+ nchars++;
}
if (changed) /* don't bother if nothing substituted */
@@ -1037,7 +988,7 @@ Otherwise, return a new string. */)
}
else
tem = string;
- xfree (buf);
+ xfree (abuf);
return tem;
}
@@ -1058,12 +1009,17 @@ syms_of_doc (void)
DEFVAR_LISP ("text-quoting-style", Vtext_quoting_style,
doc: /* Style to use for single quotes in help and messages.
-Its value should be a symbol.
-`curve' means quote with curved single quotes \\=‘like this\\=’.
+Its value should be a symbol. It works by substituting certain single
+quotes for grave accent and apostrophe. This is done in help output
+and in functions like `message' and `format-message'. It is not done
+in `format'.
+
+`curve' means quote with curved single quotes ‘like this’.
`straight' means quote with straight apostrophes \\='like this\\='.
-`grave' means quote with grave accent and apostrophe \\=`like this\\='.
-The default value nil acts like `curve' if curved single quotes are
-displayable, and like `grave' otherwise. */);
+`grave' means quote with grave accent and apostrophe \\=`like this\\=';
+i.e., do not alter quote marks. The default value nil acts like
+`curve' if curved single quotes are displayable, and like `grave'
+otherwise. */);
Vtext_quoting_style = Qnil;
DEFVAR_BOOL ("internal--text-quoting-flag", text_quoting_flag,
diff --git a/src/doprnt.c b/src/doprnt.c
index 9d8b783565f..73380050059 100644
--- a/src/doprnt.c
+++ b/src/doprnt.c
@@ -103,6 +103,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
+#include <stdlib.h>
#include <float.h>
#include <unistd.h>
#include <limits.h>
@@ -133,8 +134,11 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format,
const char *fmt = format; /* Pointer into format string. */
char *bufptr = buffer; /* Pointer into output buffer. */
+ /* Enough to handle floating point formats with large numbers. */
+ enum { SIZE_BOUND_EXTRA = DBL_MAX_10_EXP + 50 };
+
/* Use this for sprintf unless we need something really big. */
- char tembuf[DBL_MAX_10_EXP + 100];
+ char tembuf[SIZE_BOUND_EXTRA + 50];
/* Size of sprintf_buffer. */
ptrdiff_t size_allocated = sizeof (tembuf);
@@ -196,21 +200,19 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format,
This might be a field width or a precision; e.g.
%1.1000f and %1000.1f both might need 1000+ bytes.
Parse the width or precision, checking for overflow. */
- ptrdiff_t n = *fmt - '0';
+ int n = *fmt - '0';
+ bool overflow = false;
while (fmt + 1 < format_end
&& '0' <= fmt[1] && fmt[1] <= '9')
{
- /* Avoid ptrdiff_t, size_t, and int overflow, as
- many sprintfs mishandle widths greater than INT_MAX.
- This test is simple but slightly conservative: e.g.,
- (INT_MAX - INT_MAX % 10) is reported as an overflow
- even when it's not. */
- if (n >= min (INT_MAX, min (PTRDIFF_MAX, SIZE_MAX)) / 10)
- error ("Format width or precision too large");
- n = n * 10 + fmt[1] - '0';
+ overflow |= INT_MULTIPLY_WRAPV (n, 10, &n);
+ overflow |= INT_ADD_WRAPV (n, fmt[1] - '0', &n);
*string++ = *++fmt;
}
+ if (overflow
+ || min (PTRDIFF_MAX, SIZE_MAX) - SIZE_BOUND_EXTRA < n)
+ error ("Format width or precision too large");
if (size_bound < n)
size_bound = n;
}
@@ -244,9 +246,7 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format,
/* Make the size bound large enough to handle floating point formats
with large numbers. */
- if (size_bound > min (PTRDIFF_MAX, SIZE_MAX) - DBL_MAX_10_EXP - 50)
- error ("Format width or precision too large");
- size_bound += DBL_MAX_10_EXP + 50;
+ size_bound += SIZE_BOUND_EXTRA;
/* Make sure we have that much. */
if (size_bound > size_allocated)
diff --git a/src/dynlib.c b/src/dynlib.c
index 64f688ca800..ada58373801 100644
--- a/src/dynlib.c
+++ b/src/dynlib.c
@@ -52,6 +52,7 @@ typedef BOOL (WINAPI *GetModuleHandleExA_Proc) (DWORD,LPCSTR,HMODULE*);
/* This needs to be called at startup to countermand any non-zero
values recorded by temacs. */
+void dynlib_reset_last_error (void);
void
dynlib_reset_last_error (void)
{
diff --git a/src/editfns.c b/src/editfns.c
index 403569f1fcd..4f6108102db 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -49,6 +49,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <limits.h>
#include <intprops.h>
+#include <stdlib.h>
#include <strftime.h>
#include <verify.h>
@@ -146,8 +147,9 @@ xtzfree (timezone_t tz)
static timezone_t
tzlookup (Lisp_Object zone, bool settz)
{
- static char const tzbuf_format[] = "XXX%s%"pI"d:%02d:%02d";
- char tzbuf[sizeof tzbuf_format + INT_STRLEN_BOUND (EMACS_INT)];
+ static char const tzbuf_format[] = "<%+.*"pI"d>%s%"pI"d:%02d:%02d";
+ char const *trailing_tzbuf_format = tzbuf_format + sizeof "<%+.*"pI"d" - 1;
+ char tzbuf[sizeof tzbuf_format + 2 * INT_STRLEN_BOUND (EMACS_INT)];
char const *zone_string;
timezone_t new_tz;
@@ -160,16 +162,50 @@ tzlookup (Lisp_Object zone, bool settz)
}
else
{
+ bool plain_integer = INTEGERP (zone);
+
if (EQ (zone, Qwall))
zone_string = 0;
else if (STRINGP (zone))
- zone_string = SSDATA (zone);
- else if (INTEGERP (zone))
+ zone_string = SSDATA (ENCODE_SYSTEM (zone));
+ else if (plain_integer || (CONSP (zone) && INTEGERP (XCAR (zone))
+ && CONSP (XCDR (zone))))
{
+ Lisp_Object abbr;
+ if (!plain_integer)
+ {
+ abbr = XCAR (XCDR (zone));
+ zone = XCAR (zone);
+ }
+
EMACS_INT abszone = eabs (XINT (zone)), hour = abszone / (60 * 60);
- int min = (abszone / 60) % 60, sec = abszone % 60;
- sprintf (tzbuf, tzbuf_format, &"-"[XINT (zone) < 0], hour, min, sec);
- zone_string = tzbuf;
+ int hour_remainder = abszone % (60 * 60);
+ int min = hour_remainder / 60, sec = hour_remainder % 60;
+
+ if (plain_integer)
+ {
+ int prec = 2;
+ EMACS_INT numzone = hour;
+ if (hour_remainder != 0)
+ {
+ prec += 2, numzone = 100 * numzone + min;
+ if (sec != 0)
+ prec += 2, numzone = 100 * numzone + sec;
+ }
+ sprintf (tzbuf, tzbuf_format, prec, numzone,
+ &"-"[XINT (zone) < 0], hour, min, sec);
+ zone_string = tzbuf;
+ }
+ else
+ {
+ AUTO_STRING (leading, "<");
+ AUTO_STRING_WITH_LEN (trailing, tzbuf,
+ sprintf (tzbuf, trailing_tzbuf_format,
+ &"-"[XINT (zone) < 0],
+ hour, min, sec));
+ zone_string = SSDATA (concat3 (leading, ENCODE_SYSTEM (abbr),
+ trailing));
+ }
}
else
xsignal2 (Qerror, build_string ("Invalid time zone specification"),
@@ -181,6 +217,7 @@ tzlookup (Lisp_Object zone, bool settz)
{
block_input ();
emacs_setenv_TZ (zone_string);
+ tzset ();
timezone_t old_tz = local_tz;
local_tz = new_tz;
tzfree (old_tz);
@@ -1487,17 +1524,8 @@ static EMACS_INT
hi_time (time_t t)
{
time_t hi = t >> LO_TIME_BITS;
-
- /* Check for overflow, helping the compiler for common cases where
- no runtime check is needed, and taking care not to convert
- negative numbers to unsigned before comparing them. */
- if (! ((! TYPE_SIGNED (time_t)
- || MOST_NEGATIVE_FIXNUM <= TIME_T_MIN >> LO_TIME_BITS
- || MOST_NEGATIVE_FIXNUM <= hi)
- && (TIME_T_MAX >> LO_TIME_BITS <= MOST_POSITIVE_FIXNUM
- || hi <= MOST_POSITIVE_FIXNUM)))
+ if (FIXNUM_OVERFLOW_P (hi))
time_overflow ();
-
return hi;
}
@@ -1559,7 +1587,7 @@ time_arith (Lisp_Object a, Lisp_Object b,
struct lisp_time ta = lisp_time_struct (a, &alen);
struct lisp_time tb = lisp_time_struct (b, &blen);
struct lisp_time t = op (ta, tb);
- if (! (MOST_NEGATIVE_FIXNUM <= t.hi && t.hi <= MOST_POSITIVE_FIXNUM))
+ if (FIXNUM_OVERFLOW_P (t.hi))
time_overflow ();
Lisp_Object val = Qnil;
@@ -1817,7 +1845,7 @@ decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec,
if (result)
{
- if (! (MOST_NEGATIVE_FIXNUM <= hi && hi <= MOST_POSITIVE_FIXNUM))
+ if (FIXNUM_OVERFLOW_P (hi))
return -1;
result->hi = hi;
result->lo = lo;
@@ -1976,9 +2004,13 @@ DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0,
doc: /* Use FORMAT-STRING to format the time TIME, or now if omitted.
TIME is specified as (HIGH LOW USEC PSEC), as returned by
`current-time' or `file-attributes'. The obsolete form (HIGH . LOW)
-is also still accepted. The optional ZONE is omitted or nil for Emacs
-local time, t for Universal Time, `wall' for system wall clock time,
-or a string as in the TZ environment variable.
+is also still accepted.
+
+The optional ZONE is omitted or 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
+`current-time-zone') or an integer (as from `decode-time') applied
+without consideration for daylight saving time.
The value is a copy of FORMAT-STRING, but with certain constructs replaced
by text that describes the specified date and time in TIME:
@@ -2049,7 +2081,6 @@ format_time_string (char const *format, ptrdiff_t formatlen,
char *buf = buffer;
ptrdiff_t size = sizeof buffer;
size_t len;
- Lisp_Object bufstring;
int ns = t.tv_nsec;
USE_SAFE_ALLOCA;
@@ -2085,9 +2116,11 @@ format_time_string (char const *format, ptrdiff_t formatlen,
}
xtzfree (tz);
- bufstring = make_unibyte_string (buf, len);
+ AUTO_STRING_WITH_LEN (bufstring, buf, len);
+ Lisp_Object result = code_convert_string_norecord (bufstring,
+ Vlocale_coding_system, 0);
SAFE_FREE ();
- return code_convert_string_norecord (bufstring, Vlocale_coding_system, 0);
+ return result;
}
DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 2, 0,
@@ -2095,9 +2128,12 @@ DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 2, 0,
The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED),
as from `current-time' and `file-attributes', or nil to use the
current time. The obsolete form (HIGH . LOW) is also still accepted.
+
The optional ZONE is omitted or nil for Emacs local time, t for
Universal Time, `wall' for system wall clock time, or a string as in
-the TZ environment variable.
+the TZ environment variable. It can also be a list (as from
+`current-time-zone') or an integer (as from `decode-time') applied
+without consideration for daylight saving time.
The list has the following nine members: SEC is an integer between 0
and 60; SEC is 60 for a leap second, which only some operating systems
@@ -2144,22 +2180,22 @@ usage: (decode-time &optional TIME ZONE) */)
}
/* Return OBJ - OFFSET, checking that OBJ is a valid fixnum and that
- the result is representable as an int. Assume OFFSET is small and
- nonnegative. */
+ the result is representable as an int. */
static int
check_tm_member (Lisp_Object obj, int offset)
{
- EMACS_INT n;
CHECK_NUMBER (obj);
- n = XINT (obj);
- if (! (INT_MIN + offset <= n && n - offset <= INT_MAX))
+ EMACS_INT n = XINT (obj);
+ int result;
+ if (INT_SUBTRACT_WRAPV (n, offset, &result))
time_overflow ();
- return n - offset;
+ return result;
}
DEFUN ("encode-time", Fencode_time, Sencode_time, 6, MANY, 0,
doc: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
This is the reverse operation of `decode-time', which see.
+
The optional ZONE is omitted or 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
@@ -2194,8 +2230,6 @@ usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
tm.tm_year = check_tm_member (args[5], TM_YEAR_BASE);
tm.tm_isdst = -1;
- if (CONSP (zone))
- zone = XCAR (zone);
timezone_t tz = tzlookup (zone, false);
value = emacs_mktime_z (tz, &tm);
xtzfree (tz);
@@ -2224,7 +2258,9 @@ but this is considered obsolete.
The optional ZONE is omitted or nil for Emacs local time, t for
Universal Time, `wall' for system wall clock time, or a string as in
-the TZ environment variable. */)
+the TZ environment variable. It can also be a list (as from
+`current-time-zone') or an integer (as from `decode-time') applied
+without consideration for daylight saving time. */)
(Lisp_Object specified_time, Lisp_Object zone)
{
time_t value = lisp_seconds_argument (specified_time);
@@ -2300,8 +2336,12 @@ instead of using the current time. The argument should have the form
\(HIGH LOW . IGNORED). Thus, you can use times obtained from
`current-time' and from `file-attributes'. SPECIFIED-TIME can also
have the form (HIGH . LOW), but this is considered obsolete.
-Optional second arg ZONE is omitted or nil for the local time zone, or
-a string as in the TZ environment variable.
+
+The optional ZONE is omitted or 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
+`current-time-zone') or an integer (as from `decode-time') applied
+without consideration for daylight saving time.
Some operating systems cannot provide all this information to Emacs;
in this case, `current-time-zone' returns a list containing nil for
@@ -2328,15 +2368,18 @@ the data it can't find. */)
zone_offset = make_number (offset);
if (SCHARS (zone_name) == 0)
{
- /* No local time zone name is available; use "+-NNNN" instead. */
- long int m = offset / 60;
- long int am = offset < 0 ? - m : m;
- long int hour = am / 60;
- int min = am % 60;
- char buf[sizeof "+00" + INT_STRLEN_BOUND (long int)];
- zone_name = make_formatted_string (buf, "%c%02ld%02d",
+ /* No local time zone name is available; use numeric zone instead. */
+ long int hour = offset / 3600;
+ int min_sec = offset % 3600;
+ int amin_sec = min_sec < 0 ? - min_sec : min_sec;
+ int min = amin_sec / 60;
+ int sec = amin_sec % 60;
+ int min_prec = min_sec ? 2 : 0;
+ int sec_prec = sec ? 2 : 0;
+ char buf[sizeof "+0000" + INT_STRLEN_BOUND (long int)];
+ zone_name = make_formatted_string (buf, "%c%.2ld%.*d%.*d",
(offset < 0 ? '-' : '+'),
- hour, min);
+ hour, min_prec, min, sec_prec, sec);
}
}
@@ -2345,11 +2388,11 @@ the data it can't find. */)
DEFUN ("set-time-zone-rule", Fset_time_zone_rule, Sset_time_zone_rule, 1, 1, 0,
doc: /* Set the Emacs local time zone using TZ, a string specifying a time zone rule.
-
If TZ is nil or `wall', use system wall clock time; this differs from
the usual Emacs convention where nil means current local time. If TZ
-is t, use Universal Time. If TZ is an integer, treat it as in
-`encode-time'.
+is t, use Universal Time. If TZ is a list (as from
+`current-time-zone') or an integer (as from `decode-time'), use the
+specified time zone without consideration for daylight saving time.
Instead of calling this function, you typically want something else.
To temporarily use a different time zone rule for just one invocation
@@ -2422,23 +2465,24 @@ emacs_setenv_TZ (const char *tzstring)
tzval[tzeqlen] = 0;
}
- if (new_tzvalbuf
-#ifdef WINDOWSNT
- /* MS-Windows implementation of 'putenv' copies the argument
- string into a block it allocates, so modifying tzval string
- does not change the environment. OTOH, the other threads run
- by Emacs on MS-Windows never call 'xputenv' or 'putenv' or
- 'unsetenv', so the original cause for the dicey in-place
- modification technique doesn't exist there in the first
- place. */
- || 1
+
+#ifndef WINDOWSNT
+ /* Modifying *TZVAL merely requires calling tzset (which is the
+ caller's responsibility). However, modifying TZVAL requires
+ calling putenv; although this is not thread-safe, in practice this
+ runs only on startup when there is only one thread. */
+ bool need_putenv = new_tzvalbuf;
+#else
+ /* MS-Windows 'putenv' copies the argument string into a block it
+ allocates, so modifying *TZVAL will not change the environment.
+ However, the other threads run by Emacs on MS-Windows never call
+ 'xputenv' or 'putenv' or 'unsetenv', so the original cause for the
+ dicey in-place modification technique doesn't exist there in the
+ first place. */
+ bool need_putenv = true;
#endif
- )
- {
- /* Although this is not thread-safe, in practice this runs only
- on startup when there is only one thread. */
- xputenv (tzval);
- }
+ if (need_putenv)
+ xputenv (tzval);
return 0;
}
@@ -3330,7 +3374,7 @@ It returns the number of characters changed. */)
ptrdiff_t size; /* Size of translate table. */
ptrdiff_t pos, pos_byte, end_pos;
bool multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
- bool string_multibyte IF_LINT (= 0);
+ bool string_multibyte UNINIT;
validate_region (&start, &end);
if (CHAR_TABLE_P (table))
@@ -3852,6 +3896,9 @@ precision specifier says how many decimal places to show; if zero, the
decimal point itself is omitted. For %s and %S, the precision
specifier truncates the string to the given width.
+Text properties, if any, are copied from the format-string to the
+produced text.
+
usage: (format STRING &rest OBJECTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
@@ -3863,10 +3910,9 @@ DEFUN ("format-message", Fformat_message, Sformat_message, 1, MANY, 0,
The first argument is a format control string.
The other arguments are substituted into it to make the result, a string.
-This acts like `format', except it also replaces each left single
-quotation mark (\\=‘) and grave accent (\\=`) by a left quote, and each
-right single quotation mark (\\=’) and apostrophe (\\=') by a right quote.
-The left and right quote replacement characters are specified by
+This acts like `format', except it also replaces each grave accent (\\=`)
+by a left quote, and each apostrophe (\\=') by a right quote. The left
+and right quote replacement characters are specified by
`text-quoting-style'.
usage: (format-message STRING &rest OBJECTS) */)
@@ -3886,7 +3932,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 IF_LINT (= 0);
+ ptrdiff_t buf_save_value_index UNINIT;
char *format, *end;
ptrdiff_t nchars;
/* When we make a multibyte string, we must pay attention to the
@@ -4145,6 +4191,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
p += padding;
nchars += padding;
}
+ info[n].start = nchars;
if (p > buf
&& multibyte
@@ -4157,9 +4204,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
nbytes,
STRING_MULTIBYTE (args[n]), multibyte);
- info[n].start = nchars;
nchars += nchars_string;
- info[n].end = nchars;
if (minus_flag)
{
@@ -4167,6 +4212,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
p += padding;
nchars += padding;
}
+ info[n].end = nchars;
/* If this argument has text properties, record where
in the result string it appears. */
@@ -4384,6 +4430,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
exponent_bytes = src + sprintf_bytes - e;
}
+ info[n].start = nchars;
if (! minus_flag)
{
memset (p, ' ', padding);
@@ -4406,9 +4453,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
memcpy (p, src, exponent_bytes);
p += exponent_bytes;
- info[n].start = nchars;
nchars += leading_zeros + sprintf_bytes + trailing_zeros;
- info[n].end = nchars;
if (minus_flag)
{
@@ -4416,6 +4461,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
p += padding;
nchars += padding;
}
+ info[n].end = nchars;
continue;
}
@@ -4423,14 +4469,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
}
else
{
- /* Named constants for the UTF-8 encodings of U+2018 LEFT SINGLE
- QUOTATION MARK and U+2019 RIGHT SINGLE QUOTATION MARK. */
- enum
- {
- uLSQM0 = 0xE2, uLSQM1 = 0x80, uLSQM2 = 0x98,
- /* uRSQM0 = 0xE2, uRSQM1 = 0x80, */ uRSQM2 = 0x99
- };
-
unsigned char str[MAX_MULTIBYTE_LENGTH];
if ((format_char == '`' || format_char == '\'')
@@ -4446,18 +4484,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
}
else if (format_char == '`' && quoting_style == STRAIGHT_QUOTING_STYLE)
convsrc = "'";
- else if (format_char == uLSQM0 && CURVE_QUOTING_STYLE < quoting_style
- && multibyte_format
- && (unsigned char) format[0] == uLSQM1
- && ((unsigned char) format[1] == uLSQM2
- || (unsigned char) format[1] == uRSQM2))
- {
- convsrc = (((unsigned char) format[1] == uLSQM2
- && quoting_style == GRAVE_QUOTING_STYLE)
- ? "`" : "'");
- format += 2;
- memset (&discarded[format0 + 1 - format_start], 2, 2);
- }
else
{
/* Copy a single character from format to buf. */
@@ -4615,7 +4641,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
len = make_number (SCHARS (args[i]));
Lisp_Object new_len = make_number (info[i].end - info[i].start);
props = text_property_list (args[i], make_number (0), len, Qnil);
- props = extend_property_ranges (props, new_len);
+ props = extend_property_ranges (props, len, new_len);
/* If successive arguments have properties, be sure that
the value of `composition' property be the copy. */
if (1 < i && info[i - 1].end)
@@ -5042,6 +5068,14 @@ Transposing beyond buffer boundaries is an error. */)
start2_byte, start2_byte + len2_byte);
fix_start_end_in_overlays (start1, end2);
}
+ else
+ {
+ /* The character positions of the markers remain intact, but we
+ still need to update their byte positions, because the
+ transposed regions might include multibyte sequences which
+ make some original byte positions of the markers invalid. */
+ adjust_markers_bytepos (start1, start1_byte, end2, end2_byte, 0);
+ }
signal_after_change (start1, end2 - start1, end2 - start1);
return Qnil;
diff --git a/src/emacs-module.c b/src/emacs-module.c
index a28fe57b12d..68aeb0ce704 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -21,16 +21,16 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "emacs-module.h"
-#include <stdbool.h>
#include <stddef.h>
#include <stdint.h>
#include <stdio.h>
-#include <string.h>
#include "lisp.h"
#include "dynlib.h"
#include "coding.h"
-#include "verify.h"
+
+#include <intprops.h>
+#include <verify.h>
/* Feature tests. */
@@ -64,6 +64,13 @@ enum
&& INTPTR_MAX == EMACS_INT_MAX)
};
+/* Function prototype for the module init function. */
+typedef int (*emacs_init_function) (struct emacs_runtime *);
+
+/* Function prototype for the module Lisp functions. */
+typedef emacs_value (*emacs_subr) (emacs_env *, ptrdiff_t,
+ emacs_value [], void *);
+
/* Function prototype for module user-pointer finalizers. These
should not throw C++ exceptions, so emacs-module.h declares the
corresponding interfaces with EMACS_NOEXCEPT. There is only C code
@@ -107,14 +114,12 @@ static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *);
static void check_main_thread (void);
static void finalize_environment (struct emacs_env_private *);
static void initialize_environment (emacs_env *, struct emacs_env_private *priv);
-static void module_args_out_of_range (emacs_env *, Lisp_Object, Lisp_Object);
static void module_handle_signal (emacs_env *, Lisp_Object);
static void module_handle_throw (emacs_env *, Lisp_Object);
static void module_non_local_exit_signal_1 (emacs_env *, Lisp_Object, Lisp_Object);
static void module_non_local_exit_throw_1 (emacs_env *, Lisp_Object, Lisp_Object);
static void module_out_of_memory (emacs_env *);
static void module_reset_handlerlist (const int *);
-static void module_wrong_type (emacs_env *, Lisp_Object, Lisp_Object);
/* We used to return NULL when emacs_value was a different type from
Lisp_Object, but nowadays we just use Qnil instead. Although they
@@ -243,6 +248,12 @@ struct module_fun_env
return error_retval; \
MODULE_HANDLE_NONLOCAL_EXIT (error_retval)
+static void
+CHECK_USER_PTR (Lisp_Object obj)
+{
+ CHECK_TYPE (USER_PTRP (obj), Quser_ptrp, obj);
+}
+
/* Catch signals and throws only if the code can actually signal or
throw. If checking is enabled, abort if the current thread is not
the Emacs main thread. */
@@ -270,11 +281,8 @@ module_make_global_ref (emacs_env *env, emacs_value ref)
{
Lisp_Object value = HASH_VALUE (h, i);
EMACS_INT refcount = XFASTINT (value) + 1;
- if (refcount > MOST_POSITIVE_FIXNUM)
- {
- module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
- return module_nil;
- }
+ if (MOST_POSITIVE_FIXNUM < refcount)
+ xsignal0 (Qoverflow_error);
value = make_natnum (refcount);
set_hash_value_slot (h, i, value);
}
@@ -387,17 +395,19 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
envptr->data = data;
Lisp_Object envobj = make_save_ptr (envptr);
- Lisp_Object doc
- = (documentation
- ? code_convert_string_norecord (build_unibyte_string (documentation),
- Qutf_8, false)
- : Qnil);
+ Lisp_Object doc = Qnil;
+ if (documentation)
+ {
+ AUTO_STRING (unibyte_doc, documentation);
+ doc = code_convert_string_norecord (unibyte_doc, Qutf_8, false);
+ }
+
/* FIXME: Use a bytecompiled object, or even better a subr. */
Lisp_Object ret = list4 (Qlambda,
list2 (Qand_rest, Qargs),
doc,
list4 (Qapply,
- list2 (Qfunction, Qinternal_module_call),
+ list2 (Qfunction, Qinternal__module_call),
envobj,
Qargs));
@@ -414,11 +424,14 @@ module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs,
first arg, because that's what Ffuncall takes. */
Lisp_Object *newargs;
USE_SAFE_ALLOCA;
- SAFE_ALLOCA_LISP (newargs, nargs + 1);
+ ptrdiff_t nargs1;
+ if (INT_ADD_WRAPV (nargs, 1, &nargs1))
+ xsignal0 (Qoverflow_error);
+ SAFE_ALLOCA_LISP (newargs, nargs1);
newargs[0] = value_to_lisp (fun);
for (ptrdiff_t i = 0; i < nargs; i++)
newargs[1 + i] = value_to_lisp (args[i]);
- emacs_value result = lisp_to_value (Ffuncall (nargs + 1, newargs));
+ emacs_value result = lisp_to_value (Ffuncall (nargs1, newargs));
SAFE_FREE ();
return result;
}
@@ -460,11 +473,7 @@ module_extract_integer (emacs_env *env, emacs_value n)
{
MODULE_FUNCTION_BEGIN (0);
Lisp_Object l = value_to_lisp (n);
- if (! INTEGERP (l))
- {
- module_wrong_type (env, Qintegerp, l);
- return 0;
- }
+ CHECK_NUMBER (l);
return XINT (l);
}
@@ -472,11 +481,8 @@ static emacs_value
module_make_integer (emacs_env *env, intmax_t n)
{
MODULE_FUNCTION_BEGIN (module_nil);
- if (! (MOST_NEGATIVE_FIXNUM <= n && n <= MOST_POSITIVE_FIXNUM))
- {
- module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
- return module_nil;
- }
+ if (FIXNUM_OVERFLOW_P (n))
+ xsignal0 (Qoverflow_error);
return lisp_to_value (make_number (n));
}
@@ -485,11 +491,7 @@ module_extract_float (emacs_env *env, emacs_value f)
{
MODULE_FUNCTION_BEGIN (0);
Lisp_Object lisp = value_to_lisp (f);
- if (! FLOATP (lisp))
- {
- module_wrong_type (env, Qfloatp, lisp);
- return 0;
- }
+ CHECK_TYPE (FLOATP (lisp), Qfloatp, lisp);
return XFLOAT_DATA (lisp);
}
@@ -506,19 +508,10 @@ module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer,
{
MODULE_FUNCTION_BEGIN (false);
Lisp_Object lisp_str = value_to_lisp (value);
- if (! STRINGP (lisp_str))
- {
- module_wrong_type (env, Qstringp, lisp_str);
- return false;
- }
+ CHECK_STRING (lisp_str);
Lisp_Object lisp_str_utf8 = ENCODE_UTF_8 (lisp_str);
ptrdiff_t raw_size = SBYTES (lisp_str_utf8);
- if (raw_size == PTRDIFF_MAX)
- {
- module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
- return false;
- }
ptrdiff_t required_buf_size = raw_size + 1;
eassert (length != NULL);
@@ -534,8 +527,7 @@ module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer,
if (*length < required_buf_size)
{
*length = required_buf_size;
- module_non_local_exit_signal_1 (env, Qargs_out_of_range, Qnil);
- return false;
+ xsignal0 (Qargs_out_of_range);
}
*length = required_buf_size;
@@ -548,12 +540,7 @@ static emacs_value
module_make_string (emacs_env *env, const char *str, ptrdiff_t length)
{
MODULE_FUNCTION_BEGIN (module_nil);
- if (length > STRING_BYTES_BOUND)
- {
- module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
- return module_nil;
- }
- Lisp_Object lstr = make_unibyte_string (str, length);
+ AUTO_STRING_WITH_LEN (lstr, str, length);
return lisp_to_value (code_convert_string_norecord (lstr, Qutf_8, false));
}
@@ -569,11 +556,7 @@ module_get_user_ptr (emacs_env *env, emacs_value uptr)
{
MODULE_FUNCTION_BEGIN (NULL);
Lisp_Object lisp = value_to_lisp (uptr);
- if (! USER_PTRP (lisp))
- {
- module_wrong_type (env, Quser_ptr, lisp);
- return NULL;
- }
+ CHECK_USER_PTR (lisp);
return XUSER_PTR (lisp)->p;
}
@@ -582,12 +565,8 @@ module_set_user_ptr (emacs_env *env, emacs_value uptr, void *ptr)
{
/* FIXME: This function should return bool because it can fail. */
MODULE_FUNCTION_BEGIN ();
- check_main_thread ();
- if (module_non_local_exit_check (env) != emacs_funcall_exit_return)
- return;
Lisp_Object lisp = value_to_lisp (uptr);
- if (! USER_PTRP (lisp))
- module_wrong_type (env, Quser_ptr, lisp);
+ CHECK_USER_PTR (lisp);
XUSER_PTR (lisp)->p = ptr;
}
@@ -596,11 +575,7 @@ module_get_user_finalizer (emacs_env *env, emacs_value uptr)
{
MODULE_FUNCTION_BEGIN (NULL);
Lisp_Object lisp = value_to_lisp (uptr);
- if (! USER_PTRP (lisp))
- {
- module_wrong_type (env, Quser_ptr, lisp);
- return NULL;
- }
+ CHECK_USER_PTR (lisp);
return XUSER_PTR (lisp)->finalizer;
}
@@ -611,30 +586,26 @@ module_set_user_finalizer (emacs_env *env, emacs_value uptr,
/* FIXME: This function should return bool because it can fail. */
MODULE_FUNCTION_BEGIN ();
Lisp_Object lisp = value_to_lisp (uptr);
- if (! USER_PTRP (lisp))
- module_wrong_type (env, Quser_ptr, lisp);
+ CHECK_USER_PTR (lisp);
XUSER_PTR (lisp)->finalizer = fin;
}
static void
+check_vec_index (Lisp_Object lvec, ptrdiff_t i)
+{
+ CHECK_VECTOR (lvec);
+ if (! (0 <= i && i < ASIZE (lvec)))
+ args_out_of_range_3 (make_fixnum_or_float (i),
+ make_number (0), make_number (ASIZE (lvec) - 1));
+}
+
+static void
module_vec_set (emacs_env *env, emacs_value vec, ptrdiff_t i, emacs_value val)
{
/* FIXME: This function should return bool because it can fail. */
MODULE_FUNCTION_BEGIN ();
Lisp_Object lvec = value_to_lisp (vec);
- if (! VECTORP (lvec))
- {
- module_wrong_type (env, Qvectorp, lvec);
- return;
- }
- if (! (0 <= i && i < ASIZE (lvec)))
- {
- if (MOST_NEGATIVE_FIXNUM <= i && i <= MOST_POSITIVE_FIXNUM)
- module_args_out_of_range (env, lvec, make_number (i));
- else
- module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
- return;
- }
+ check_vec_index (lvec, i);
ASET (lvec, i, value_to_lisp (val));
}
@@ -643,19 +614,7 @@ module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i)
{
MODULE_FUNCTION_BEGIN (module_nil);
Lisp_Object lvec = value_to_lisp (vec);
- if (! VECTORP (lvec))
- {
- module_wrong_type (env, Qvectorp, lvec);
- return module_nil;
- }
- if (! (0 <= i && i < ASIZE (lvec)))
- {
- if (MOST_NEGATIVE_FIXNUM <= i && i <= MOST_POSITIVE_FIXNUM)
- module_args_out_of_range (env, lvec, make_number (i));
- else
- module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
- return module_nil;
- }
+ check_vec_index (lvec, i);
return lisp_to_value (AREF (lvec, i));
}
@@ -665,11 +624,7 @@ module_vec_size (emacs_env *env, emacs_value vec)
/* FIXME: Return a sentinel value (e.g., -1) on error. */
MODULE_FUNCTION_BEGIN (0);
Lisp_Object lvec = value_to_lisp (vec);
- if (! VECTORP (lvec))
- {
- module_wrong_type (env, Qvectorp, lvec);
- return 0;
- }
+ CHECK_VECTOR (lvec);
return ASIZE (lvec);
}
@@ -711,7 +666,7 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
if (r != 0)
{
- if (! (MOST_NEGATIVE_FIXNUM <= r && r <= MOST_POSITIVE_FIXNUM))
+ if (FIXNUM_OVERFLOW_P (r))
xsignal0 (Qoverflow_error);
xsignal2 (Qmodule_load_failed, file, make_number (r));
}
@@ -828,14 +783,6 @@ module_non_local_exit_throw_1 (emacs_env *env, Lisp_Object tag,
}
}
-/* Module version of `wrong_type_argument'. */
-static void
-module_wrong_type (emacs_env *env, Lisp_Object predicate, Lisp_Object value)
-{
- module_non_local_exit_signal_1 (env, Qwrong_type_argument,
- list2 (predicate, value));
-}
-
/* Signal an out-of-memory condition to the caller. */
static void
module_out_of_memory (emacs_env *env)
@@ -846,13 +793,6 @@ module_out_of_memory (emacs_env *env)
XCDR (Vmemory_signal_data));
}
-/* Signal arguments are out of range. */
-static void
-module_args_out_of_range (emacs_env *env, Lisp_Object a1, Lisp_Object a2)
-{
- module_non_local_exit_signal_1 (env, Qargs_out_of_range, list2 (a1, a2));
-}
-
/* Value conversion. */
@@ -1055,10 +995,12 @@ module_format_fun_env (const struct module_fun_env *env)
? exprintf (&buf, &bufsize, buffer, -1,
"#<module function %s from %s>", sym, path)
: sprintf (buffer, noaddr_format, env->subr));
- Lisp_Object unibyte_result = make_unibyte_string (buffer, size);
+ AUTO_STRING_WITH_LEN (unibyte_result, buffer, size);
+ Lisp_Object result = code_convert_string_norecord (unibyte_result,
+ Qutf_8, false);
if (buf != buffer)
xfree (buf);
- return code_convert_string_norecord (unibyte_result, Qutf_8, false);
+ return result;
}
@@ -1117,7 +1059,7 @@ syms_of_module (void)
defsubr (&Smodule_load);
- DEFSYM (Qinternal_module_call, "internal--module-call");
+ DEFSYM (Qinternal__module_call, "internal--module-call");
defsubr (&Sinternal_module_call);
}
diff --git a/src/emacs-module.h b/src/emacs-module.h
index b4ae5ea7433..ae7311b05a7 100644
--- a/src/emacs-module.h
+++ b/src/emacs-module.h
@@ -41,7 +41,7 @@ typedef struct emacs_env_25 emacs_env;
BEWARE: Do not assume NULL is a valid value! */
typedef struct emacs_value_tag *emacs_value;
-enum emacs_arity { emacs_variadic_function = -2 };
+enum { emacs_variadic_function = -2 };
/* Struct passed to a module init function (emacs_module_init). */
struct emacs_runtime
@@ -57,13 +57,6 @@ struct emacs_runtime
};
-/* Function prototype for the module init function. */
-typedef int (*emacs_init_function) (struct emacs_runtime *ert);
-
-/* Function prototype for the module Lisp functions. */
-typedef emacs_value (*emacs_subr) (emacs_env *env, ptrdiff_t nargs,
- emacs_value args[], void *data);
-
/* Possible Emacs function call outcomes. */
enum emacs_funcall_exit
{
diff --git a/src/emacs.c b/src/emacs.c
index ce30ae741b2..efd4fa329df 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -24,6 +24,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <errno.h>
#include <fcntl.h>
#include <stdio.h>
+#include <stdlib.h>
#include <sys/types.h>
#include <sys/file.h>
@@ -57,11 +58,15 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "dosfns.h"
#endif
+#ifdef HAVE_LIBSYSTEMD
+# include <systemd/sd-daemon.h>
+# include <sys/socket.h>
+#endif
+
#ifdef HAVE_WINDOW_SYSTEM
#include TERM_HEADER
#endif /* HAVE_WINDOW_SYSTEM */
-#include "coding.h"
#include "intervals.h"
#include "character.h"
#include "buffer.h"
@@ -80,11 +85,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "composite.h"
#include "dispextern.h"
#include "regex.h"
+#include "sheap.h"
#include "syntax.h"
#include "sysselect.h"
#include "systime.h"
#include "puresize.h"
+#include "getpagesize.h"
#include "gnutls.h"
#if (defined PROFILING \
@@ -106,10 +113,6 @@ extern void moncontrol (int mode);
#include <sys/resource.h>
#endif
-#ifdef HAVE_PERSONALITY_LINUX32
-#include <sys/personality.h>
-#endif
-
static const char emacs_version[] = PACKAGE_VERSION;
static const char emacs_copyright[] = COPYRIGHT;
static const char emacs_bugreport[] = PACKAGE_BUGREPORT;
@@ -128,14 +131,15 @@ Lisp_Object Vlibrary_cache;
bool initialized;
/* Set to true if this instance of Emacs might dump. */
+#ifndef DOUG_LEA_MALLOC
+static
+#endif
bool might_dump;
#ifdef DARWIN_OS
extern void unexec_init_emacs_zone (void);
#endif
-extern void malloc_enable_thread (void);
-
/* If true, Emacs should not attempt to use a window-specific code,
but instead should use the virtual terminal under which it was started. */
bool inhibit_window_system;
@@ -158,8 +162,8 @@ char *stack_bottom;
static uprintmax_t heap_bss_diff;
#endif
-/* To run as a daemon under Cocoa or Windows, we must do a fork+exec,
- not a simple fork.
+/* To run as a background daemon under Cocoa or Windows,
+ we must do a fork+exec, not a simple fork.
On Cocoa, CoreFoundation lib fails in forked process:
http://developer.apple.com/ReleaseNotes/
@@ -180,12 +184,18 @@ bool noninteractive;
/* True means remove site-lisp directories from load-path. */
bool no_site_lisp;
+/* True means put details like time stamps into builds. */
+bool build_details;
+
/* Name for the server started by the daemon.*/
static char *daemon_name;
+/* 0 not a daemon, 1 new-style (foreground), 2 old-style (background). */
+int daemon_type;
+
#ifndef WINDOWSNT
-/* Pipe used to send exit notification to the daemon parent at
- startup. */
+/* Pipe used to send exit notification to the background daemon parent at
+ startup. On Windows, we use a kernel event instead. */
int daemon_pipe[2];
#else
HANDLE w32_daemon_event;
@@ -216,11 +226,13 @@ Initialization options:\n\
"\
--batch do not do interactive display; implies -q\n\
--chdir DIR change to directory DIR\n\
---daemon start a server in the background\n\
+--daemon, --old-daemon[=NAME] start a (named) server in the background\n\
+--new-daemon[=NAME] start a (named) server in the foreground\n\
--debug-init enable Emacs Lisp debugger for init file\n\
--display, -d DISPLAY use X server DISPLAY\n\
",
"\
+--no-build-details do not add build details such as time stamps\n\
--no-desktop do not load a saved desktop\n\
--no-init-file, -q load neither ~/.emacs nor default.el\n\
--no-loadup, -nl do not load loadup.el into bare Emacs\n\
@@ -353,17 +365,20 @@ terminate_due_to_signal (int sig, int backtrace_limit)
{
signal (sig, SIG_DFL);
- /* If fatal error occurs in code below, avoid infinite recursion. */
- if (! fatal_error_in_progress)
+ if (attempt_orderly_shutdown_on_fatal_signal)
{
- fatal_error_in_progress = 1;
+ /* If fatal error occurs in code below, avoid infinite recursion. */
+ if (! fatal_error_in_progress)
+ {
+ fatal_error_in_progress = 1;
- totally_unblock_input ();
- if (sig == SIGTERM || sig == SIGHUP || sig == SIGINT)
- Fkill_emacs (make_number (sig));
+ totally_unblock_input ();
+ if (sig == SIGTERM || sig == SIGHUP || sig == SIGINT)
+ Fkill_emacs (make_number (sig));
- shut_down_emacs (sig, Qnil);
- emacs_backtrace (backtrace_limit);
+ shut_down_emacs (sig, Qnil);
+ emacs_backtrace (backtrace_limit);
+ }
}
/* Signal the same code; this time it will really be fatal.
@@ -658,10 +673,7 @@ main (int argc, char **argv)
bool do_initial_setlocale;
bool dumping;
int skip_args = 0;
-#ifdef HAVE_SETRLIMIT
- struct rlimit rlim;
-#endif
- bool no_loadup = 0;
+ bool no_loadup = false;
char *junk = 0;
char *dname_arg = 0;
#ifdef DAEMON_MUST_EXEC
@@ -674,25 +686,29 @@ main (int argc, char **argv)
stack_base = &dummy;
-#if defined HAVE_PERSONALITY_LINUX32 && defined __PPC64__
- /* This code partly duplicates the HAVE_PERSONALITY_LINUX32 code
- below. This duplication is planned to be fixed in a later
- Emacs release. */
-# define ADD_NO_RANDOMIZE 0x0040000
- int pers = personality (0xffffffff);
- if (! (pers & ADD_NO_RANDOMIZE)
- && 0 <= personality (pers | ADD_NO_RANDOMIZE))
+ dumping = !initialized && (strcmp (argv[argc - 1], "dump") == 0
+ || strcmp (argv[argc - 1], "bootstrap") == 0);
+
+ /* True if address randomization interferes with memory allocation. */
+# ifdef __PPC64__
+ bool disable_aslr = true;
+# else
+ bool disable_aslr = dumping;
+# endif
+
+ if (disable_aslr && disable_address_randomization ())
{
+ /* Set this so the personality will be reverted before execs
+ after this one. */
+ xputenv ("EMACS_HEAP_EXEC=true");
+
/* Address randomization was enabled, but is now disabled.
Re-execute Emacs to get a clean slate. */
execvp (argv[0], argv);
- /* If the exec fails, warn the user and then try without a
- clean slate. */
+ /* If the exec fails, warn and then try anyway. */
perror (argv[0]);
}
-# undef ADD_NO_RANDOMIZE
-#endif
#ifndef CANNOT_DUMP
might_dump = !initialized;
@@ -733,6 +749,7 @@ main (int argc, char **argv)
unexec_init_emacs_zone ();
#endif
+ init_standard_fds ();
atexit (close_output_streams);
#ifdef HAVE_MODULES
@@ -792,7 +809,7 @@ main (int argc, char **argv)
filename_from_ansi (ch_to_dir, newdir);
ch_to_dir = newdir;
#endif
- original_pwd = get_current_dir_name ();
+ original_pwd = emacs_get_current_dir_name ();
if (chdir (ch_to_dir) != 0)
{
fprintf (stderr, "%s: Can't chdir to %s: %s\n",
@@ -801,28 +818,6 @@ main (int argc, char **argv)
}
}
- dumping = !initialized && (strcmp (argv[argc - 1], "dump") == 0
- || strcmp (argv[argc - 1], "bootstrap") == 0);
-
-#if defined HAVE_PERSONALITY_LINUX32 && !defined __PPC64__
- if (dumping && ! getenv ("EMACS_HEAP_EXEC"))
- {
- /* Set this so we only do this once. */
- xputenv ("EMACS_HEAP_EXEC=true");
-
- /* A flag to turn off address randomization which is introduced
- in linux kernel shipped with fedora core 4 */
-#define ADD_NO_RANDOMIZE 0x0040000
- personality (PER_LINUX32 | ADD_NO_RANDOMIZE);
-#undef ADD_NO_RANDOMIZE
-
- execvp (argv[0], argv);
-
- /* If the exec fails, try to dump anyway. */
- emacs_perror (argv[0]);
- }
-#endif
-
#if defined (HAVE_SETRLIMIT) && defined (RLIMIT_STACK) && !defined (CYGWIN)
/* Extend the stack space available. Don't do that if dumping,
since some systems (e.g. DJGPP) might define a smaller stack
@@ -830,38 +825,54 @@ main (int argc, char **argv)
is built with an 8MB stack. Moreover, the setrlimit call can
cause problems on Cygwin
(https://www.cygwin.com/ml/cygwin/2015-07/msg00096.html). */
- if (1
-#ifndef CANNOT_DUMP
- && (!noninteractive || initialized)
-#endif
- && !getrlimit (RLIMIT_STACK, &rlim))
+ struct rlimit rlim;
+ if (getrlimit (RLIMIT_STACK, &rlim) == 0
+ && 0 <= rlim.rlim_cur && rlim.rlim_cur <= LONG_MAX)
{
- long newlim;
- /* Approximate the amount regex.c needs per unit of re_max_failures. */
+ rlim_t lim = rlim.rlim_cur;
+
+ /* Approximate the amount regex.c needs per unit of
+ re_max_failures, then add 33% to cover the size of the
+ smaller stacks that regex.c successively allocates and
+ discards on its way to the maximum. */
int ratio = 20 * sizeof (char *);
- /* Then add 33% to cover the size of the smaller stacks that regex.c
- successively allocates and discards, on its way to the maximum. */
ratio += ratio / 3;
- /* Add in some extra to cover
- what we're likely to use for other reasons. */
- newlim = re_max_failures * ratio + 200000;
-#ifdef __NetBSD__
- /* NetBSD (at least NetBSD 1.2G and former) has a bug in its
- stack allocation routine for new process that the allocation
- fails if stack limit is not on page boundary. So, round up the
- new limit to page boundary. */
- newlim = (newlim + getpagesize () - 1) / getpagesize () * getpagesize ();
-#endif
- if (newlim > rlim.rlim_max)
+
+ /* Extra space to cover what we're likely to use for other reasons. */
+ int extra = 200000;
+
+ bool try_to_grow_stack = true;
+#ifndef CANNOT_DUMP
+ try_to_grow_stack = !noninteractive || initialized;
+#endif
+
+ if (try_to_grow_stack)
{
- newlim = rlim.rlim_max;
- /* Don't let regex.c overflow the stack we have. */
- re_max_failures = (newlim - 200000) / ratio;
+ rlim_t newlim = re_max_failures * ratio + extra;
+
+ /* Round the new limit to a page boundary; this is needed
+ for Darwin kernel 15.4.0 (see Bug#23622) and perhaps
+ other systems. Do not shrink the stack and do not exceed
+ rlim_max. Don't worry about exact values of
+ RLIM_INFINITY etc. since in practice when they are
+ nonnegative they are so large that the code does the
+ right thing anyway. */
+ long pagesize = getpagesize ();
+ newlim += pagesize - 1;
+ if (0 <= rlim.rlim_max && rlim.rlim_max < newlim)
+ newlim = rlim.rlim_max;
+ newlim -= newlim % pagesize;
+
+ if (pagesize <= newlim - lim)
+ {
+ rlim.rlim_cur = newlim;
+ if (setrlimit (RLIMIT_STACK, &rlim) == 0)
+ lim = newlim;
+ }
}
- if (rlim.rlim_cur < newlim)
- rlim.rlim_cur = newlim;
- setrlimit (RLIMIT_STACK, &rlim);
+ /* Don't let regex.c overflow the stack. */
+ re_max_failures = lim < extra ? 0 : min (lim - extra, SIZE_MAX) / ratio;
}
#endif /* HAVE_SETRLIMIT and RLIMIT_STACK and not CYGWIN */
@@ -911,24 +922,25 @@ main (int argc, char **argv)
char *term;
if (argmatch (argv, argc, "-t", "--terminal", 4, &term, &skip_args))
{
- int result;
- emacs_close (0);
- emacs_close (1);
- result = emacs_open (term, O_RDWR, 0);
- if (result < 0 || fcntl (0, F_DUPFD_CLOEXEC, 1) < 0)
+ emacs_close (STDIN_FILENO);
+ emacs_close (STDOUT_FILENO);
+ int result = emacs_open (term, O_RDWR, 0);
+ if (result != STDIN_FILENO
+ || (fcntl (STDIN_FILENO, F_DUPFD_CLOEXEC, STDOUT_FILENO)
+ != STDOUT_FILENO))
{
char *errstring = strerror (errno);
fprintf (stderr, "%s: %s: %s\n", argv[0], term, errstring);
- exit (1);
+ exit (EXIT_FAILURE);
}
- if (! isatty (0))
+ if (! isatty (STDIN_FILENO))
{
fprintf (stderr, "%s: %s: not a tty\n", argv[0], term);
- exit (1);
+ exit (EXIT_FAILURE);
}
fprintf (stderr, "Using %s\n", term);
#ifdef HAVE_WINDOW_SYSTEM
- inhibit_window_system = 1; /* -t => -nw */
+ inhibit_window_system = true; /* -t => -nw */
#endif
}
else
@@ -969,6 +981,8 @@ main (int argc, char **argv)
exit (0);
}
+ daemon_type = 0;
+
#ifndef WINDOWSNT
/* Make sure IS_DAEMON starts up as false. */
daemon_pipe[1] = 0;
@@ -976,132 +990,170 @@ main (int argc, char **argv)
w32_daemon_event = NULL;
#endif
- if (argmatch (argv, argc, "-daemon", "--daemon", 5, NULL, &skip_args)
- || argmatch (argv, argc, "-daemon", "--daemon", 5, &dname_arg, &skip_args))
+
+ int sockfd = -1;
+
+ if (argmatch (argv, argc, "-new-daemon", "--new-daemon", 10, NULL, &skip_args)
+ || argmatch (argv, argc, "-new-daemon", "--new-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, "-old-daemon", "--old-daemon", 10, NULL, &skip_args)
+ || argmatch (argv, argc, "-old-daemon", "--old-daemon", 10, &dname_arg, &skip_args))
+ {
+ daemon_type = 2; /* background */
+ }
+
+
+ if (daemon_type > 0)
{
#ifndef DOS_NT
- pid_t f;
-
- /* Start as a daemon: fork a new child process which will run the
- rest of the initialization code, then exit.
-
- Detaching a daemon requires the following steps:
- - fork
- - setsid
- - exit the parent
- - close the tty file-descriptors
-
- We only want to do the last 2 steps once the daemon is ready to
- serve requests, i.e. after loading .emacs (initialization).
- OTOH initialization may start subprocesses (e.g. ispell) and these
- should be run from the proper process (the one that will end up
- running as daemon) and with the proper "session id" in order for
- them to keep working after detaching, so fork and setsid need to be
- performed before initialization.
-
- We want to avoid exiting before the server socket is ready, so
- use a pipe for synchronization. The parent waits for the child
- to close its end of the pipe (using `daemon-initialized')
- before exiting. */
- if (emacs_pipe (daemon_pipe) != 0)
- {
- fprintf (stderr, "Cannot pipe!\n");
- exit (1);
- }
+ if (daemon_type == 2)
+ {
+ /* Start as a background daemon: fork a new child process which
+ will run the rest of the initialization code, then exit.
+
+ Detaching a daemon requires the following steps:
+ - fork
+ - setsid
+ - exit the parent
+ - close the tty file-descriptors
+
+ We only want to do the last 2 steps once the daemon is ready to
+ serve requests, i.e. after loading .emacs (initialization).
+ OTOH initialization may start subprocesses (e.g. ispell) and these
+ should be run from the proper process (the one that will end up
+ running as daemon) and with the proper "session id" in order for
+ them to keep working after detaching, so fork and setsid need to be
+ performed before initialization.
+
+ We want to avoid exiting before the server socket is ready, so
+ use a pipe for synchronization. The parent waits for the child
+ to close its end of the pipe (using `daemon-initialized')
+ before exiting. */
+ if (emacs_pipe (daemon_pipe) != 0)
+ {
+ fprintf (stderr, "Cannot pipe!\n");
+ exit (1);
+ }
+ } /* daemon_type == 2 */
+
+#ifdef HAVE_LIBSYSTEMD
+ /* Read the number of sockets passed through by systemd. */
+ int systemd_socket = sd_listen_fds (1);
+
+ if (systemd_socket > 1)
+ fprintf (stderr,
+ ("\n"
+ "Warning: systemd passed more than one socket to Emacs.\n"
+ "Try 'Accept=false' in the Emacs socket unit file.\n"));
+ else if (systemd_socket == 1
+ && (0 < sd_is_socket (SD_LISTEN_FDS_START,
+ AF_UNSPEC, SOCK_STREAM, 1)))
+ sockfd = SD_LISTEN_FDS_START;
+#endif /* HAVE_LIBSYSTEMD */
-#ifndef DAEMON_MUST_EXEC
#ifdef USE_GTK
fprintf (stderr, "\nWarning: due to a long standing Gtk+ bug\nhttp://bugzilla.gnome.org/show_bug.cgi?id=85715\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");
#endif /* USE_GTK */
- f = fork ();
-#else /* DAEMON_MUST_EXEC */
- if (!dname_arg || !strchr (dname_arg, '\n'))
- f = fork (); /* in orig */
- else
- f = 0; /* in exec'd */
-#endif /* !DAEMON_MUST_EXEC */
- if (f > 0)
- {
- int retval;
- char buf[1];
-
- /* Close unused writing end of the pipe. */
- emacs_close (daemon_pipe[1]);
-
- /* Just wait for the child to close its end of the pipe. */
- do
- {
- retval = read (daemon_pipe[0], &buf, 1);
- }
- while (retval == -1 && errno == EINTR);
- if (retval < 0)
- {
- fprintf (stderr, "Error reading status from child\n");
- exit (1);
- }
- else if (retval == 0)
- {
- fprintf (stderr, "Error: server did not start correctly\n");
- exit (1);
- }
+ if (daemon_type == 2)
+ {
+ pid_t f;
+#ifndef DAEMON_MUST_EXEC
- emacs_close (daemon_pipe[0]);
- exit (0);
- }
- if (f < 0)
- {
- emacs_perror ("fork");
- exit (EXIT_CANCELED);
- }
+ f = fork ();
+#else /* DAEMON_MUST_EXEC */
+ if (!dname_arg || !strchr (dname_arg, '\n'))
+ f = fork (); /* in orig */
+ else
+ f = 0; /* in exec'd */
+#endif /* !DAEMON_MUST_EXEC */
+ if (f > 0)
+ {
+ int retval;
+ char buf[1];
+
+ /* Close unused writing end of the pipe. */
+ emacs_close (daemon_pipe[1]);
+
+ /* Just wait for the child to close its end of the pipe. */
+ do
+ {
+ retval = read (daemon_pipe[0], &buf, 1);
+ }
+ while (retval == -1 && errno == EINTR);
+
+ if (retval < 0)
+ {
+ fprintf (stderr, "Error reading status from child\n");
+ exit (1);
+ }
+ else if (retval == 0)
+ {
+ fprintf (stderr, "Error: server did not start correctly\n");
+ exit (1);
+ }
+
+ emacs_close (daemon_pipe[0]);
+ exit (0);
+ }
+ if (f < 0)
+ {
+ emacs_perror ("fork");
+ exit (EXIT_CANCELED);
+ }
#ifdef DAEMON_MUST_EXEC
- {
- /* In orig process, forked as child, OR in exec'd. */
- if (!dname_arg || !strchr (dname_arg, '\n'))
- { /* In orig, child: now exec w/special daemon name. */
- char fdStr[80];
- int fdStrlen =
- snprintf (fdStr, sizeof fdStr,
- "--daemon=\n%d,%d\n%s", daemon_pipe[0],
- daemon_pipe[1], dname_arg ? dname_arg : "");
-
- if (! (0 <= fdStrlen && fdStrlen < sizeof fdStr))
- {
- fprintf (stderr, "daemon: child name too long\n");
- exit (EXIT_CANNOT_INVOKE);
+ {
+ /* In orig process, forked as child, OR in exec'd. */
+ if (!dname_arg || !strchr (dname_arg, '\n'))
+ { /* In orig, child: now exec w/special daemon name. */
+ char fdStr[80];
+ int fdStrlen =
+ snprintf (fdStr, sizeof fdStr,
+ "--old-daemon=\n%d,%d\n%s", daemon_pipe[0],
+ daemon_pipe[1], dname_arg ? dname_arg : "");
+
+ if (! (0 <= fdStrlen && fdStrlen < sizeof fdStr))
+ {
+ fprintf (stderr, "daemon: child name too long\n");
+ exit (EXIT_CANNOT_INVOKE);
+ }
+
+ argv[skip_args] = fdStr;
+
+ fcntl (daemon_pipe[0], F_SETFD, 0);
+ fcntl (daemon_pipe[1], F_SETFD, 0);
+ execvp (argv[0], argv);
+ emacs_perror (argv[0]);
+ exit (errno == ENOENT ? EXIT_ENOENT : EXIT_CANNOT_INVOKE);
}
- argv[skip_args] = fdStr;
-
- fcntl (daemon_pipe[0], F_SETFD, 0);
- fcntl (daemon_pipe[1], F_SETFD, 0);
- execvp (argv[0], argv);
- emacs_perror (argv[0]);
- exit (errno == ENOENT ? EXIT_ENOENT : EXIT_CANNOT_INVOKE);
- }
-
- /* In exec'd: parse special dname into pipe and name info. */
- if (!dname_arg || !strchr (dname_arg, '\n')
- || strlen (dname_arg) < 1 || strlen (dname_arg) > 70)
+ /* In exec'd: parse special dname into pipe and name info. */
+ if (!dname_arg || !strchr (dname_arg, '\n')
+ || strlen (dname_arg) < 1 || strlen (dname_arg) > 70)
{
fprintf (stderr, "emacs daemon: daemon name absent or too long\n");
exit (EXIT_CANNOT_INVOKE);
}
- dname_arg2[0] = '\0';
- sscanf (dname_arg, "\n%d,%d\n%s", &(daemon_pipe[0]), &(daemon_pipe[1]),
- dname_arg2);
- dname_arg = *dname_arg2 ? dname_arg2 : NULL;
- fcntl (daemon_pipe[1], F_SETFD, FD_CLOEXEC);
- }
+ dname_arg2[0] = '\0';
+ sscanf (dname_arg, "\n%d,%d\n%s", &(daemon_pipe[0]), &(daemon_pipe[1]),
+ dname_arg2);
+ dname_arg = *dname_arg2 ? dname_arg2 : NULL;
+ fcntl (daemon_pipe[1], F_SETFD, FD_CLOEXEC);
+ }
#endif /* DAEMON_MUST_EXEC */
- /* Close unused reading end of the pipe. */
- emacs_close (daemon_pipe[0]);
+ /* Close unused reading end of the pipe. */
+ emacs_close (daemon_pipe[0]);
- setsid ();
+ setsid ();
+ } /* daemon_type == 2 */
#elif defined(WINDOWSNT)
/* Indicate that we want daemon mode. */
w32_daemon_event = CreateEvent (NULL, TRUE, FALSE, W32_DAEMON_EVENT);
@@ -1112,7 +1164,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
exit (1);
}
#else /* MSDOS */
- fprintf (stderr, "This platform does not support the -daemon flag.\n");
+ fprintf (stderr, "This platform does not support daemon mode.\n");
exit (1);
#endif /* MSDOS */
if (dname_arg)
@@ -1205,6 +1257,9 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
no_site_lisp
= argmatch (argv, argc, "-nsl", "--no-site-lisp", 11, NULL, &skip_args);
+ build_details = ! argmatch (argv, argc, "-no-build-details",
+ "--no-build-details", 7, NULL, &skip_args);
+
#ifdef HAVE_NS
ns_pool = ns_alloc_autorelease_pool ();
#ifdef NS_IMPL_GNUSTEP
@@ -1218,7 +1273,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
/* Started from GUI? */
/* FIXME: Do the right thing if getenv returns NULL, or if
chdir fails. */
- if (! inhibit_window_system && ! isatty (0) && ! ch_to_dir)
+ if (! inhibit_window_system && ! isatty (STDIN_FILENO) && ! ch_to_dir)
chdir (getenv ("HOME"));
if (skip_args < argc)
{
@@ -1321,16 +1376,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
globals_of_gfilenotify ();
#endif
-#ifdef WINDOWSNT
- globals_of_w32 ();
-#ifdef HAVE_W32NOTIFY
- globals_of_w32notify ();
-#endif
- /* Initialize environment from registry settings. */
- init_environment (argv);
- init_ntproc (dumping); /* must precede init_editfns. */
-#endif
-
#ifdef HAVE_NS
/* Initialize the locale from user defaults. */
ns_init_locale ();
@@ -1347,6 +1392,20 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
if (! dumping)
set_initial_environment ();
+#ifdef WINDOWSNT
+ globals_of_w32 ();
+#ifdef HAVE_W32NOTIFY
+ globals_of_w32notify ();
+#endif
+ /* Initialize environment from registry settings. Make sure to do
+ this only after calling set_initial_environment so that
+ Vinitial_environment and Vprocess_environment will contain only
+ variables from the parent process without modifications from
+ Emacs. */
+ init_environment (argv);
+ init_ntproc (dumping); /* must precede init_editfns. */
+#endif
+
/* AIX crashes are reported in system versions 3.2.3 and 3.2.4
if this is not done. Do it after set_global_environment so that we
don't pollute Vglobal_environment. */
@@ -1562,7 +1621,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
/* This can create a thread that may call getenv, so it must follow
all calls to putenv and setenv. Also, this sets up
add_keyboard_wait_descriptor, which init_display uses. */
- init_process_emacs ();
+ init_process_emacs (sockfd);
init_keyboard (); /* This too must precede init_sys_modes. */
if (!noninteractive)
@@ -1651,9 +1710,12 @@ static const struct standard_args standard_args[] =
{ "-batch", "--batch", 100, 0 },
{ "-script", "--script", 100, 1 },
{ "-daemon", "--daemon", 99, 0 },
+ { "-old-daemon", "--old-daemon", 99, 0 },
+ { "-new-daemon", "--new-daemon", 99, 0 },
{ "-help", "--help", 90, 0 },
{ "-nl", "--no-loadup", 70, 0 },
{ "-nsl", "--no-site-lisp", 65, 0 },
+ { "-no-build-details", "--no-build-details", 63, 0 },
/* -d must come last before the options handled in startup.el. */
{ "-d", "--display", 60, 1 },
{ "-display", 0, 60, 1 },
@@ -1836,9 +1898,13 @@ sort_args (int argc, char **argv)
fatal ("Option '%s' requires an argument\n", argv[from]);
from += options[from];
}
- /* FIXME When match < 0, shouldn't there be some error,
- or at least indication to the user that there was a
- problem? */
+ else if (match == -2)
+ {
+ /* This is an internal error.
+ Eg if one long option is a prefix of another. */
+ fprintf (stderr, "Option '%s' matched multiple standard arguments\n", argv[from]);
+ }
+ /* Should we not also warn if there was no match? */
}
done: ;
}
@@ -2096,6 +2162,17 @@ You must run Emacs in batch mode in order to dump it. */)
tem = Vpurify_flag;
Vpurify_flag = Qnil;
+#ifdef HYBRID_MALLOC
+ {
+ static char const fmt[] = "%d of %d static heap bytes used";
+ char buf[sizeof fmt + 2 * (INT_STRLEN_BOUND (int) - 2)];
+ int max_usage = max_bss_sbrk_ptr - bss_sbrk_buffer;
+ sprintf (buf, fmt, max_usage, STATIC_HEAP_SIZE);
+ /* Don't log messages, because at this point buffers cannot be created. */
+ message1_nolog (buf);
+ }
+#endif
+
fflush (stdout);
/* Tell malloc where start of impure now is. */
/* Also arrange for warnings when nearly out of space. */
@@ -2183,6 +2260,15 @@ synchronize_system_messages_locale (void)
#endif
}
#endif /* HAVE_SETLOCALE */
+
+/* Return a diagnostic string for ERROR_NUMBER, in the wording
+ and encoding appropriate for the current locale. */
+char *
+emacs_strerror (int error_number)
+{
+ synchronize_system_messages_locale ();
+ return strerror (error_number);
+}
Lisp_Object
@@ -2349,27 +2435,33 @@ from the parent process and its tty file descriptors. */)
if (NILP (Vafter_init_time))
error ("This function can only be called after loading the init files");
#ifndef WINDOWSNT
- int nfd;
-
- /* Get rid of stdin, stdout and stderr. */
- nfd = emacs_open ("/dev/null", O_RDWR, 0);
- err |= nfd < 0;
- err |= dup2 (nfd, 0) < 0;
- err |= dup2 (nfd, 1) < 0;
- err |= dup2 (nfd, 2) < 0;
- err |= emacs_close (nfd) != 0;
-
- /* Closing the pipe will notify the parent that it can exit.
- FIXME: In case some other process inherited the pipe, closing it here
- won't notify the parent because it's still open elsewhere, so we
- additionally send a byte, just to make sure the parent really exits.
- Instead, we should probably close the pipe in start-process and
- call-process to make sure the pipe is never inherited by
- subprocesses. */
- err |= write (daemon_pipe[1], "\n", 1) < 0;
- err |= emacs_close (daemon_pipe[1]) != 0;
+
+ if (daemon_type == 2)
+ {
+ int nfd;
+
+ /* Get rid of stdin, stdout and stderr. */
+ nfd = emacs_open ("/dev/null", O_RDWR, 0);
+ err |= nfd < 0;
+ err |= dup2 (nfd, STDIN_FILENO) < 0;
+ err |= dup2 (nfd, STDOUT_FILENO) < 0;
+ err |= dup2 (nfd, STDERR_FILENO) < 0;
+ err |= emacs_close (nfd) != 0;
+
+ /* Closing the pipe will notify the parent that it can exit.
+ FIXME: In case some other process inherited the pipe, closing it here
+ won't notify the parent because it's still open elsewhere, so we
+ additionally send a byte, just to make sure the parent really exits.
+ Instead, we should probably close the pipe in start-process and
+ call-process to make sure the pipe is never inherited by
+ subprocesses. */
+ err |= write (daemon_pipe[1], "\n", 1) < 0;
+ err |= emacs_close (daemon_pipe[1]) != 0;
+ }
+
/* Set it to an invalid value so we know we've already run this function. */
- daemon_pipe[1] = -1;
+ daemon_type = -1;
+
#else /* WINDOWSNT */
/* Signal the waiting emacsclient process. */
err |= SetEvent (w32_daemon_event) == 0;
@@ -2416,8 +2508,8 @@ Special values:
`ms-dos' compiled as an MS-DOS application.
`windows-nt' compiled as a native W32 application.
`cygwin' compiled using the Cygwin library.
-Anything else (in Emacs 24.1, the possibilities are: aix, berkeley-unix,
-hpux, irix, usg-unix-v) indicates some sort of Unix system. */);
+Anything else (in Emacs 26, the possibilities are: aix, berkeley-unix,
+hpux, usg-unix-v) indicates some sort of Unix system. */);
Vsystem_type = intern_c_string (SYSTEM_TYPE);
/* See configure.ac for the possible SYSTEM_TYPEs. */
diff --git a/src/emacsgtkfixed.c b/src/emacsgtkfixed.c
index ca0bbfbb866..c04adf28b36 100644
--- a/src/emacsgtkfixed.c
+++ b/src/emacsgtkfixed.c
@@ -27,7 +27,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "emacsgtkfixed.h"
/* Silence a bogus diagnostic; see GNOME bug 683906. */
-#if 4 < __GNUC__ + (7 <= __GNUC_MINOR__) && ! GLIB_CHECK_VERSION (2, 35, 7)
+#if GNUC_PREREQ (4, 7, 0) && ! GLIB_CHECK_VERSION (2, 35, 7)
# pragma GCC diagnostic push
# pragma GCC diagnostic ignored "-Wunused-local-typedefs"
#endif
diff --git a/src/eval.c b/src/eval.c
index b94712d4579..884e1ebfb89 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -22,6 +22,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <limits.h>
#include <stdio.h>
+#include <stdlib.h>
#include "lisp.h"
#include "blockinput.h"
#include "commands.h"
@@ -90,6 +91,7 @@ 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 lambda_arity (Lisp_Object);
static Lisp_Object
specpdl_symbol (union specbinding *pdl)
@@ -221,7 +223,6 @@ static struct handler handlerlist_sentinel;
void
init_eval (void)
{
- byte_stack_list = 0;
specpdl_ptr = specpdl;
{ /* Put a dummy catcher at top-level so that handlerlist is never NULL.
This is important since handlerlist->nextfree holds the freelist
@@ -1134,7 +1135,6 @@ unwind_to_catch (struct handler *catch, Lisp_Object value)
eassert (handlerlist == catch);
- byte_stack_list = catch->byte_stack;
lisp_eval_depth = catch->lisp_eval_depth;
sys_longjmp (catch->jmp, 1);
@@ -1429,12 +1429,12 @@ push_handler_nosignal (Lisp_Object tag_ch_val, enum handlertype handlertype)
c->pdlcount = SPECPDL_INDEX ();
c->poll_suppress_count = poll_suppress_count;
c->interrupt_input_blocked = interrupt_input_blocked;
- c->byte_stack = byte_stack_list;
handlerlist = c;
return c;
}
+static Lisp_Object signal_or_quit (Lisp_Object, Lisp_Object, bool);
static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object);
static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
Lisp_Object data);
@@ -1448,7 +1448,7 @@ process_quit_flag (void)
Fkill_emacs (Qnil);
if (EQ (Vthrow_on_input, flag))
Fthrow (Vthrow_on_input, Qt);
- Fsignal (Qquit, Qnil);
+ quit ();
}
DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
@@ -1464,9 +1464,29 @@ DATA should be a list. Its elements are printed as part of the error message.
See Info anchor `(elisp)Definition of signal' for some details on how this
error message is constructed.
If the signal is handled, DATA is made available to the handler.
-See also the function `condition-case'. */)
+See also the function `condition-case'. */
+ attributes: noreturn)
(Lisp_Object error_symbol, Lisp_Object data)
{
+ signal_or_quit (error_symbol, data, false);
+ eassume (false);
+}
+
+/* Quit, in response to a keyboard quit request. */
+Lisp_Object
+quit (void)
+{
+ return signal_or_quit (Qquit, Qnil, true);
+}
+
+/* Signal an error, or quit. ERROR_SYMBOL and DATA are as with Fsignal.
+ If KEYBOARD_QUIT, this is a quit; ERROR_SYMBOL should be
+ Qquit and DATA should be Qnil, and this function may return.
+ Otherwise this function is like Fsignal and does not return. */
+
+static Lisp_Object
+signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
+{
/* When memory is full, ERROR-SYMBOL is nil,
and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
That is a special case--don't do this in other situations. */
@@ -1478,7 +1498,6 @@ See also the function `condition-case'. */)
struct handler *h;
immediate_quit = 0;
- abort_on_gc = 0;
if (gc_in_progress || waiting_for_input)
emacs_abort ();
@@ -1546,7 +1565,7 @@ See also the function `condition-case'. */)
= maybe_call_debugger (conditions, error_symbol, data);
/* We can't return values to code which signaled an error, but we
can continue code which has signaled a quit. */
- if (debugger_called && EQ (real_error_symbol, Qquit))
+ if (keyboard_quit && debugger_called && EQ (real_error_symbol, Qquit))
return Qnil;
}
@@ -1573,16 +1592,6 @@ See also the function `condition-case'. */)
fatal ("%s", SDATA (string));
}
-/* Internal version of Fsignal that never returns.
- Used for anything but Qquit (which can return from Fsignal). */
-
-void
-xsignal (Lisp_Object error_symbol, Lisp_Object data)
-{
- Fsignal (error_symbol, data);
- emacs_abort ();
-}
-
/* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */
void
@@ -1756,9 +1765,9 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object conditions)
}
-/* Dump an error message; called like vprintf. */
-void
-verror (const char *m, va_list ap)
+/* Format and return a string; called like vprintf. */
+Lisp_Object
+vformat_string (const char *m, va_list ap)
{
char buf[4000];
ptrdiff_t size = sizeof buf;
@@ -1772,7 +1781,14 @@ verror (const char *m, va_list ap)
if (buffer != buf)
xfree (buffer);
- xsignal1 (Qerror, string);
+ return string;
+}
+
+/* Dump an error message; called like vprintf. */
+void
+verror (const char *m, va_list ap)
+{
+ xsignal1 (Qerror, vformat_string (m, ap));
}
@@ -1972,7 +1988,8 @@ it defines a macro. */)
Lisp_Object fun = Findirect_function (funname, Qnil);
if (!NILP (Fequal (fun, fundef)))
- error ("Autoloading failed to define function %s",
+ error ("Autoloading file %s failed to define function %s",
+ SDATA (Fcar (Fcar (Vload_history))),
SDATA (SYMBOL_NAME (funname)));
else
return fun;
@@ -2846,14 +2863,14 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
xsignal1 (Qinvalid_function, fun);
syms_left = AREF (fun, COMPILED_ARGLIST);
if (INTEGERP (syms_left))
- /* A byte-code object with a non-nil `push args' slot means we
+ /* 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 either a non-existent, or a nil value for
- the `push args' slot (the default), have dynamically-bound
- arguments, and use the argument-binding code below instead (as do
- all interpreted functions, even lexically bound ones). */
+ 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). */
{
/* If we have not actually read the bytecode string
and constants vector yet, fetch them from the file. */
@@ -2871,6 +2888,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
emacs_abort ();
i = optional = rest = 0;
+ bool previous_optional_or_rest = false;
for (; CONSP (syms_left); syms_left = XCDR (syms_left))
{
QUIT;
@@ -2880,9 +2898,19 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
xsignal1 (Qinvalid_function, fun);
if (EQ (next, Qand_rest))
- rest = 1;
+ {
+ if (rest || previous_optional_or_rest)
+ xsignal1 (Qinvalid_function, fun);
+ rest = 1;
+ previous_optional_or_rest = true;
+ }
else if (EQ (next, Qand_optional))
- optional = 1;
+ {
+ if (optional || rest || previous_optional_or_rest)
+ xsignal1 (Qinvalid_function, fun);
+ optional = 1;
+ previous_optional_or_rest = true;
+ }
else
{
Lisp_Object arg;
@@ -2905,10 +2933,11 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
else
/* Dynamically bind NEXT. */
specbind (next, arg);
+ previous_optional_or_rest = false;
}
}
- if (!NILP (syms_left))
+ if (!NILP (syms_left) || previous_optional_or_rest)
xsignal1 (Qinvalid_function, fun);
else if (i < nargs)
xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
@@ -2934,6 +2963,118 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
return unbind_to (count, val);
}
+DEFUN ("func-arity", Ffunc_arity, Sfunc_arity, 1, 1, 0,
+ doc: /* Return minimum and maximum number of args allowed for FUNCTION.
+FUNCTION must be a function of some kind.
+The returned value is a cons cell (MIN . MAX). MIN is the minimum number
+of args. MAX is the maximum number, or the symbol `many', for a
+function with `&rest' args, or `unevalled' for a special form. */)
+ (Lisp_Object function)
+{
+ Lisp_Object original;
+ Lisp_Object funcar;
+ Lisp_Object result;
+
+ original = function;
+
+ retry:
+
+ /* Optimize for no indirection. */
+ function = original;
+ if (SYMBOLP (function) && !NILP (function))
+ {
+ function = XSYMBOL (function)->function;
+ if (SYMBOLP (function))
+ function = indirect_function (function);
+ }
+
+ if (CONSP (function) && EQ (XCAR (function), Qmacro))
+ function = XCDR (function);
+
+ if (SUBRP (function))
+ result = Fsubr_arity (function);
+ else if (COMPILEDP (function))
+ result = lambda_arity (function);
+ else
+ {
+ if (NILP (function))
+ xsignal1 (Qvoid_function, original);
+ if (!CONSP (function))
+ xsignal1 (Qinvalid_function, original);
+ funcar = XCAR (function);
+ if (!SYMBOLP (funcar))
+ xsignal1 (Qinvalid_function, original);
+ if (EQ (funcar, Qlambda)
+ || EQ (funcar, Qclosure))
+ result = lambda_arity (function);
+ else if (EQ (funcar, Qautoload))
+ {
+ Fautoload_do_load (function, original, Qnil);
+ goto retry;
+ }
+ else
+ xsignal1 (Qinvalid_function, original);
+ }
+ return result;
+}
+
+/* FUN must be either a lambda-expression or a compiled-code object. */
+static Lisp_Object
+lambda_arity (Lisp_Object fun)
+{
+ Lisp_Object syms_left;
+
+ if (CONSP (fun))
+ {
+ if (EQ (XCAR (fun), Qclosure))
+ {
+ fun = XCDR (fun); /* Drop `closure'. */
+ CHECK_LIST_CONS (fun, fun);
+ }
+ syms_left = XCDR (fun);
+ if (CONSP (syms_left))
+ syms_left = XCAR (syms_left);
+ else
+ xsignal1 (Qinvalid_function, fun);
+ }
+ else if (COMPILEDP (fun))
+ {
+ ptrdiff_t size = ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK;
+ if (size <= COMPILED_STACK_DEPTH)
+ xsignal1 (Qinvalid_function, fun);
+ syms_left = AREF (fun, COMPILED_ARGLIST);
+ if (INTEGERP (syms_left))
+ return get_byte_code_arity (syms_left);
+ }
+ else
+ emacs_abort ();
+
+ EMACS_INT minargs = 0, maxargs = 0;
+ bool optional = false;
+ for (; CONSP (syms_left); syms_left = XCDR (syms_left))
+ {
+ Lisp_Object next = XCAR (syms_left);
+ if (!SYMBOLP (next))
+ xsignal1 (Qinvalid_function, fun);
+
+ if (EQ (next, Qand_rest))
+ return Fcons (make_number (minargs), Qmany);
+ else if (EQ (next, Qand_optional))
+ optional = true;
+ else
+ {
+ if (!optional)
+ minargs++;
+ maxargs++;
+ }
+ }
+
+ if (!NILP (syms_left))
+ xsignal1 (Qinvalid_function, fun);
+
+ return Fcons (make_number (minargs), make_number (maxargs));
+}
+
DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
1, 1, 0,
doc: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */)
@@ -3296,13 +3437,17 @@ Output stream used is value of `standard-output'. */)
else
{
tem = backtrace_function (pdl);
+ if (debugger_stack_frame_as_list)
+ write_string ("(");
Fprin1 (tem, Qnil); /* This can QUIT. */
- write_string ("(");
+ if (!debugger_stack_frame_as_list)
+ write_string ("(");
{
ptrdiff_t i;
for (i = 0; i < backtrace_nargs (pdl); i++)
{
- if (i) write_string (" ");
+ if (i || debugger_stack_frame_as_list)
+ write_string(" ");
Fprin1 (backtrace_args (pdl)[i], Qnil);
}
}
@@ -3725,6 +3870,10 @@ This is nil when the debugger is called under circumstances where it
might not be safe to continue. */);
debugger_may_continue = 1;
+ DEFVAR_BOOL ("debugger-stack-frame-as-list", debugger_stack_frame_as_list,
+ doc: /* Non-nil means display call stack frames as lists. */);
+ debugger_stack_frame_as_list = 0;
+
DEFVAR_LISP ("debugger", Vdebugger,
doc: /* Function to call to invoke debugger.
If due to frame exit, args are `exit' and the value being returned;
@@ -3808,6 +3957,7 @@ alist of active lexical bindings. */);
defsubr (&Seval);
defsubr (&Sapply);
defsubr (&Sfuncall);
+ defsubr (&Sfunc_arity);
defsubr (&Srun_hooks);
defsubr (&Srun_hook_with_args);
defsubr (&Srun_hook_with_args_until_success);
diff --git a/src/fileio.c b/src/fileio.c
index c3b2be7c5f7..66a48733a6d 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -25,6 +25,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <sys/stat.h>
#include <unistd.h>
+#ifdef DARWIN_OS
+#include <sys/attr.h>
+#endif
+
#ifdef HAVE_PWD_H
#include <pwd.h>
#endif
@@ -52,9 +56,18 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "region-cache.h"
#include "frame.h"
+#ifdef HAVE_LINUX_FS_H
+# include <sys/ioctl.h>
+# include <linux/fs.h>
+#endif
+
#ifdef WINDOWSNT
#define NOMINMAX 1
#include <windows.h>
+/* The redundant #ifdef is to avoid compiler warning about unused macro. */
+#ifdef NOMINMAX
+#undef NOMINMAX
+#endif
#include <sys/file.h>
#include "w32.h"
#endif /* not WINDOWSNT */
@@ -185,17 +198,17 @@ void
report_file_errno (char const *string, Lisp_Object name, int errorno)
{
Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
- synchronize_system_messages_locale ();
- char *str = strerror (errorno);
+ char *str = emacs_strerror (errorno);
+ AUTO_STRING (unibyte_str, str);
Lisp_Object errstring
- = code_convert_string_norecord (build_unibyte_string (str),
- Vlocale_coding_system, 0);
+ = code_convert_string_norecord (unibyte_str, Vlocale_coding_system, 0);
Lisp_Object errdata = Fcons (errstring, data);
if (errorno == EEXIST)
xsignal (Qfile_already_exists, errdata);
else
- xsignal (Qfile_error, Fcons (build_string (string), errdata));
+ xsignal (errorno == ENOENT ? Qfile_missing : Qfile_error,
+ Fcons (build_string (string), errdata));
}
/* Signal a file-access failure that set errno. STRING describes the
@@ -214,12 +227,11 @@ report_file_error (char const *string, Lisp_Object name)
void
report_file_notify_error (const char *string, Lisp_Object name)
{
- Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
- synchronize_system_messages_locale ();
- char *str = strerror (errno);
+ char *str = emacs_strerror (errno);
+ AUTO_STRING (unibyte_str, str);
Lisp_Object errstring
- = code_convert_string_norecord (build_unibyte_string (str),
- Vlocale_coding_system, 0);
+ = code_convert_string_norecord (unibyte_str, Vlocale_coding_system, 0);
+ Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
Lisp_Object errdata = Fcons (errstring, data);
xsignal (Qfile_notify_error, Fcons (build_string (string), errdata));
@@ -510,7 +522,8 @@ This operation exists because a directory is also a file, but its name as
a directory is different from its name as a file.
The result can be used as the value of `default-directory'
or passed as second argument to `expand-file-name'.
-For a Unix-syntax file name, just appends a slash. */)
+For a Unix-syntax file name, just appends a slash unless a trailing slash
+is already present. */)
(Lisp_Object file)
{
char *buf;
@@ -1015,11 +1028,9 @@ filesystem tree, not (expand-file-name ".." dirname). */)
/* Drive must be set, so this is okay. */
if (strcmp (nm - 2, SSDATA (name)) != 0)
{
- char temp[] = " :";
-
name = make_specified_string (nm, -1, p - nm, multibyte);
- temp[0] = DRIVE_LETTER (drive);
- AUTO_STRING (drive_prefix, temp);
+ char temp[] = { DRIVE_LETTER (drive), ':', 0 };
+ AUTO_STRING_WITH_LEN (drive_prefix, temp, 2);
name = concat2 (drive_prefix, name);
}
#ifdef WINDOWSNT
@@ -1832,6 +1843,18 @@ barf_or_query_if_file_exists (Lisp_Object absname, bool known_to_exist,
}
}
+#ifndef WINDOWSNT
+/* Copy data to DEST from SOURCE if possible. Return true if OK. */
+static bool
+clone_file (int dest, int source)
+{
+#ifdef FICLONE
+ return ioctl (dest, FICLONE, source) == 0;
+#endif
+ return false;
+}
+#endif
+
DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 6,
"fCopy file: \nGCopy %s to file: \np\nP",
doc: /* Copy FILE to NEWNAME. Both args must be strings.
@@ -1978,7 +2001,7 @@ permissions. */)
record_unwind_protect_int (close_file_unwind, ofd);
- off_t oldsize = 0, newsize = 0;
+ off_t oldsize = 0, newsize;
if (already_exists)
{
@@ -1994,17 +2017,19 @@ permissions. */)
immediate_quit = 1;
QUIT;
- while (true)
+
+ if (clone_file (ofd, ifd))
+ newsize = st.st_size;
+ else
{
char buf[MAX_ALLOCA];
- ptrdiff_t n = emacs_read (ifd, buf, sizeof buf);
+ ptrdiff_t n;
+ for (newsize = 0; 0 < (n = emacs_read (ifd, buf, sizeof buf));
+ newsize += n)
+ if (emacs_write_sig (ofd, buf, n) != n)
+ report_file_error ("Write error", newname);
if (n < 0)
report_file_error ("Read error", file);
- if (n == 0)
- break;
- if (emacs_write_sig (ofd, buf, n) != n)
- report_file_error ("Write error", newname);
- newsize += n;
}
/* Truncate any existing output file after writing the data. This
@@ -2211,6 +2236,105 @@ internal_delete_file (Lisp_Object filename)
return NILP (tem);
}
+/* Filesystems are case-sensitive on all supported systems except
+ MS-Windows, MS-DOS, Cygwin, and Mac OS X. They are always
+ case-insensitive on the first two, but they may or may not be
+ case-insensitive on Cygwin and OS X. The following function
+ attempts to provide a runtime test on those two systems. If the
+ test is not conclusive, we assume case-insensitivity on Cygwin and
+ case-sensitivity on Mac OS X.
+
+ FIXME: Mounted filesystems on Posix hosts, like Samba shares or
+ NFS-mounted Windows volumes, might be case-insensitive. Can we
+ detect this? */
+
+static bool
+file_name_case_insensitive_p (const char *filename)
+{
+ /* Use pathconf with _PC_CASE_INSENSITIVE or _PC_CASE_SENSITIVE if
+ those flags are available. As of this writing (2016-11-14),
+ Cygwin is the only platform known to support the former (starting
+ with Cygwin-2.6.1), and Mac OS X is the only platform known to
+ support the latter.
+
+ There have been reports that pathconf with _PC_CASE_SENSITIVE
+ does not work reliably on Mac OS X. If you have a problem,
+ please recompile Emacs with -DDARWIN_OS_CASE_SENSITIVE_FIXME=1 or
+ -DDARWIN_OS_CASE_SENSITIVE_FIXME=2, and file a bug report saying
+ whether this fixed your problem. */
+
+#ifdef _PC_CASE_INSENSITIVE
+ int res = pathconf (filename, _PC_CASE_INSENSITIVE);
+ if (res >= 0)
+ return res > 0;
+#elif defined _PC_CASE_SENSITIVE && !defined DARWIN_OS_CASE_SENSITIVE_FIXME
+ int res = pathconf (filename, _PC_CASE_SENSITIVE);
+ if (res >= 0)
+ return res == 0;
+#endif
+
+#ifdef DARWIN_OS
+# ifndef DARWIN_OS_CASE_SENSITIVE_FIXME
+ int DARWIN_OS_CASE_SENSITIVE_FIXME = 0;
+# endif
+
+ if (DARWIN_OS_CASE_SENSITIVE_FIXME == 1)
+ {
+ /* This is based on developer.apple.com's getattrlist man page. */
+ struct attrlist alist = {.volattr = ATTR_VOL_CAPABILITIES};
+ vol_capabilities_attr_t vcaps;
+ if (getattrlist (filename, &alist, &vcaps, sizeof vcaps, 0) == 0)
+ {
+ if (vcaps.valid[VOL_CAPABILITIES_FORMAT] & VOL_CAP_FMT_CASE_SENSITIVE)
+ return ! (vcaps.capabilities[VOL_CAPABILITIES_FORMAT]
+ & VOL_CAP_FMT_CASE_SENSITIVE);
+ }
+ }
+ else if (DARWIN_OS_CASE_SENSITIVE_FIXME == 2)
+ {
+ /* The following is based on
+ http://lists.apple.com/archives/darwin-dev/2007/Apr/msg00010.html. */
+ struct attrlist alist;
+ unsigned char buffer[sizeof (vol_capabilities_attr_t) + sizeof (size_t)];
+
+ memset (&alist, 0, sizeof (alist));
+ alist.volattr = ATTR_VOL_CAPABILITIES;
+ if (getattrlist (filename, &alist, buffer, sizeof (buffer), 0)
+ || !(alist.volattr & ATTR_VOL_CAPABILITIES))
+ return 0;
+ vol_capabilities_attr_t *vcaps = buffer;
+ return !(vcaps->capabilities[0] & VOL_CAP_FMT_CASE_SENSITIVE);
+ }
+#endif /* DARWIN_OS */
+
+#if defined CYGWIN || defined DOS_NT
+ return true;
+#else
+ return false;
+#endif
+}
+
+DEFUN ("file-name-case-insensitive-p", Ffile_name_case_insensitive_p,
+ Sfile_name_case_insensitive_p, 1, 1, 0,
+ doc: /* Return t if file FILENAME is on a case-insensitive filesystem.
+The arg must be a string. */)
+ (Lisp_Object filename)
+{
+ Lisp_Object handler;
+
+ CHECK_STRING (filename);
+ filename = Fexpand_file_name (filename, Qnil);
+
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = Ffind_file_name_handler (filename, Qfile_name_case_insensitive_p);
+ if (!NILP (handler))
+ return call2 (handler, Qfile_name_case_insensitive_p, filename);
+
+ filename = ENCODE_FILE (filename);
+ return file_name_case_insensitive_p (SSDATA (filename)) ? Qt : Qnil;
+}
+
DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
"fRename file: \nGRename %s to file: \np",
doc: /* Rename FILE as NEWNAME. Both args must be strings.
@@ -2230,12 +2354,11 @@ This is what happens in interactive use with M-x. */)
file = Fexpand_file_name (file, Qnil);
if ((!NILP (Ffile_directory_p (newname)))
-#ifdef DOS_NT
- /* If the file names are identical but for the case,
- don't attempt to move directory to itself. */
- && (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
-#endif
- )
+ /* If the filesystem is case-insensitive and the file names are
+ identical but for the case, don't attempt to move directory
+ to itself. */
+ && (NILP (Ffile_name_case_insensitive_p (file))
+ || NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname)))))
{
Lisp_Object fname = (NILP (Ffile_directory_p (file))
? file : Fdirectory_file_name (file));
@@ -2256,14 +2379,12 @@ This is what happens in interactive use with M-x. */)
encoded_file = ENCODE_FILE (file);
encoded_newname = ENCODE_FILE (newname);
-#ifdef DOS_NT
- /* If the file names are identical but for the case, don't ask for
- confirmation: they simply want to change the letter-case of the
- file name. */
- if (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
-#endif
- if (NILP (ok_if_already_exists)
- || INTEGERP (ok_if_already_exists))
+ /* If the filesystem is case-insensitive and the file names are
+ identical but for the case, don't ask for confirmation: they
+ simply want to change the letter-case of the file name. */
+ if ((!(file_name_case_insensitive_p (SSDATA (encoded_file)))
+ || NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
+ && ((NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists))))
barf_or_query_if_file_exists (newname, false, "rename to it",
INTEGERP (ok_if_already_exists), false);
if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0)
@@ -2544,7 +2665,7 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
/* The read-only attribute of the parent directory doesn't affect
whether a file or directory can be created within it. Some day we
should check ACLs though, which do affect this. */
- return file_directory_p (SDATA (dir)) ? Qt : Qnil;
+ return file_directory_p (SSDATA (dir)) ? Qt : Qnil;
#else
return check_writable (SSDATA (dir), W_OK | X_OK) ? Qt : Qnil;
#endif
@@ -2775,7 +2896,7 @@ See `file-symlink-p' to distinguish symlinks. */)
/* Tell stat to use expensive method to get accurate info. */
Vw32_get_true_file_attributes = Qt;
- result = stat (SDATA (absname), &st);
+ result = stat (SSDATA (absname), &st);
Vw32_get_true_file_attributes = tem;
if (result < 0)
@@ -3363,6 +3484,21 @@ restore_window_points (Lisp_Object window_markers, ptrdiff_t inserted,
}
}
+/* Make sure the gap is at Z_BYTE. This is required to treat buffer
+ text as a linear C char array. */
+static void
+maybe_move_gap (struct buffer *b)
+{
+ if (BUF_GPT_BYTE (b) != BUF_Z_BYTE (b))
+ {
+ struct buffer *cb = current_buffer;
+
+ set_buffer_internal (b);
+ move_gap_both (Z, Z_BYTE);
+ set_buffer_internal (cb);
+ }
+}
+
/* FIXME: insert-file-contents should be split with the top-level moved to
Elisp and only the core kept in C. */
@@ -3436,9 +3572,6 @@ by calling `format-decode', which see. */)
if (!NILP (BVAR (current_buffer, read_only)))
Fbarf_if_buffer_read_only (Qnil);
- if (!NILP (Ffboundp (Qundo_auto__undoable_change_no_timer)))
- call0 (Qundo_auto__undoable_change_no_timer);
-
val = Qnil;
p = Qnil;
orig_filename = Qnil;
@@ -3830,6 +3963,7 @@ by calling `format-decode', which see. */)
if (! giveup_match_end)
{
ptrdiff_t temp;
+ ptrdiff_t this_count = SPECPDL_INDEX ();
/* We win! We can handle REPLACE the optimized way. */
@@ -3859,13 +3993,19 @@ by calling `format-decode', which see. */)
beg_offset += same_at_start - BEGV_BYTE;
end_offset -= ZV_BYTE - same_at_end;
- invalidate_buffer_caches (current_buffer,
- BYTE_TO_CHAR (same_at_start),
- same_at_end_charpos);
- del_range_byte (same_at_start, same_at_end, 0);
+ /* This binding is to avoid ask-user-about-supersession-threat
+ being called in insert_from_buffer or del_range_bytes (via
+ prepare_to_modify_buffer).
+ AFAICT we could avoid ask-user-about-supersession-threat by setting
+ current_buffer->modtime earlier, but we could still end up calling
+ ask-user-about-supersession-threat if the file is modified while
+ we read it, so we bind buffer-file-name instead. */
+ specbind (intern ("buffer-file-name"), Qnil);
+ del_range_byte (same_at_start, same_at_end);
/* Insert from the file at the proper position. */
temp = BYTE_TO_CHAR (same_at_start);
SET_PT_BOTH (temp, same_at_start);
+ unbind_to (this_count, Qnil);
/* If display currently starts at beginning of line,
keep it that way. */
@@ -3949,6 +4089,7 @@ by calling `format-decode', which see. */)
coding_system = CODING_ID_NAME (coding.id);
set_coding_system = true;
+ maybe_move_gap (XBUFFER (conversion_buffer));
decoded = BUF_BEG_ADDR (XBUFFER (conversion_buffer));
inserted = (BUF_Z_BYTE (XBUFFER (conversion_buffer))
- BUF_BEG_BYTE (XBUFFER (conversion_buffer)));
@@ -3969,10 +4110,9 @@ by calling `format-decode', which see. */)
/* Truncate the buffer to the size of the file. */
if (same_at_start != same_at_end)
{
- invalidate_buffer_caches (current_buffer,
- BYTE_TO_CHAR (same_at_start),
- BYTE_TO_CHAR (same_at_end));
- del_range_byte (same_at_start, same_at_end, 0);
+ /* See previous specbind for the reason behind this. */
+ specbind (intern ("buffer-file-name"), Qnil);
+ del_range_byte (same_at_start, same_at_end);
}
inserted = 0;
@@ -4020,12 +4160,11 @@ by calling `format-decode', which see. */)
we are taking from the decoded string. */
inserted -= (ZV_BYTE - same_at_end) + (same_at_start - BEGV_BYTE);
+ /* See previous specbind for the reason behind this. */
+ specbind (intern ("buffer-file-name"), Qnil);
if (same_at_end != same_at_start)
{
- invalidate_buffer_caches (current_buffer,
- BYTE_TO_CHAR (same_at_start),
- same_at_end_charpos);
- del_range_byte (same_at_start, same_at_end, 0);
+ del_range_byte (same_at_start, same_at_end);
temp = GPT;
eassert (same_at_start == GPT_BYTE);
same_at_start = GPT_BYTE;
@@ -4046,10 +4185,6 @@ by calling `format-decode', which see. */)
same_at_start + inserted - BEGV_BYTE
+ BUF_BEG_BYTE (XBUFFER (conversion_buffer)))
- same_at_start_charpos);
- /* This binding is to avoid ask-user-about-supersession-threat
- being called in insert_from_buffer (via in
- prepare_to_modify_buffer). */
- specbind (intern ("buffer-file-name"), Qnil);
insert_from_buffer (XBUFFER (conversion_buffer),
same_at_start_charpos, inserted_chars, 0);
/* Set `inserted' to the number of inserted characters. */
@@ -4504,7 +4639,7 @@ by calling `format-decode', which see. */)
PT - BEG, Z - PT - inserted);
if (read_quit)
- Fsignal (Qquit, Qnil);
+ quit ();
/* Retval needs to be dealt with in all cases consistently. */
if (NILP (val))
@@ -4614,8 +4749,7 @@ choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object file
}
/* If the decided coding-system doesn't specify end-of-line
- format, we use that of
- `default-buffer-file-coding-system'. */
+ format, we use that of `buffer-file-coding-system'. */
if (! using_default_coding)
{
Lisp_Object dflt = BVAR (&buffer_defaults, buffer_file_coding_system);
@@ -4693,7 +4827,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
{
int open_flags;
int mode;
- off_t offset IF_LINT (= 0);
+ off_t offset UNINIT;
bool open_and_close_file = desc < 0;
bool ok;
int save_errno = 0;
@@ -4701,7 +4835,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
struct stat st;
struct timespec modtime;
ptrdiff_t count = SPECPDL_INDEX ();
- ptrdiff_t count1 IF_LINT (= 0);
+ ptrdiff_t count1 UNINIT;
Lisp_Object handler;
Lisp_Object visit_file;
Lisp_Object annotations;
@@ -4810,7 +4944,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
encoded_filename = ENCODE_FILE (filename);
fn = SSDATA (encoded_filename);
- open_flags = O_WRONLY | O_BINARY | O_CREAT;
+ open_flags = O_WRONLY | O_CREAT;
open_flags |= EQ (mustbenew, Qexcl) ? O_EXCL : !NILP (append) ? 0 : O_TRUNC;
if (NUMBERP (append))
offset = file_offset (append);
@@ -4929,7 +5063,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
if (timespec_valid_p (modtime)
&& ! (valid_timestamp_file_system && st.st_dev == timestamp_file_system))
{
- int desc1 = emacs_open (fn, O_WRONLY | O_BINARY, 0);
+ int desc1 = emacs_open (fn, O_WRONLY, 0);
if (desc1 >= 0)
{
struct stat st1;
@@ -5382,25 +5516,15 @@ An argument specifies the modification time value to use
static Lisp_Object
auto_save_error (Lisp_Object error_val)
{
- Lisp_Object msg;
- int i;
-
auto_save_error_occurred = 1;
ring_bell (XFRAME (selected_frame));
AUTO_STRING (format, "Auto-saving %s: %s");
- msg = CALLN (Fformat, format, BVAR (current_buffer, name),
- Ferror_message_string (error_val));
-
- for (i = 0; i < 3; ++i)
- {
- if (i == 0)
- message3 (msg);
- else
- message3_nolog (msg);
- Fsleep_for (make_number (1), Qnil);
- }
+ Lisp_Object msg = CALLN (Fformat, format, BVAR (current_buffer, name),
+ Ferror_message_string (error_val));
+ call3 (intern ("display-warning"),
+ intern ("auto-save"), msg, intern ("error"));
return Qnil;
}
@@ -5801,8 +5925,6 @@ syms_of_fileio (void)
which gives a list of operations it handles. */
DEFSYM (Qoperations, "operations");
- DEFSYM (Qundo_auto__undoable_change_no_timer, "undo-auto--undoable-change-no-timer");
-
DEFSYM (Qexpand_file_name, "expand-file-name");
DEFSYM (Qsubstitute_in_file_name, "substitute-in-file-name");
DEFSYM (Qdirectory_file_name, "directory-file-name");
@@ -5814,6 +5936,7 @@ syms_of_fileio (void)
DEFSYM (Qmake_directory_internal, "make-directory-internal");
DEFSYM (Qmake_directory, "make-directory");
DEFSYM (Qdelete_file, "delete-file");
+ DEFSYM (Qfile_name_case_insensitive_p, "file-name-case-insensitive-p");
DEFSYM (Qrename_file, "rename-file");
DEFSYM (Qadd_name_to_file, "add-name-to-file");
DEFSYM (Qmake_symbolic_link, "make-symbolic-link");
@@ -5852,6 +5975,7 @@ syms_of_fileio (void)
DEFSYM (Qfile_error, "file-error");
DEFSYM (Qfile_already_exists, "file-already-exists");
DEFSYM (Qfile_date_error, "file-date-error");
+ DEFSYM (Qfile_missing, "file-missing");
DEFSYM (Qfile_notify_error, "file-notify-error");
DEFSYM (Qexcl, "excl");
@@ -5904,6 +6028,11 @@ behaves as if file names were encoded in `utf-8'. */);
Fput (Qfile_date_error, Qerror_message,
build_pure_c_string ("Cannot set file date"));
+ Fput (Qfile_missing, Qerror_conditions,
+ Fpurecopy (list3 (Qfile_missing, Qfile_error, Qerror)));
+ Fput (Qfile_missing, Qerror_message,
+ build_pure_c_string ("File is missing"));
+
Fput (Qfile_notify_error, Qerror_conditions,
Fpurecopy (list3 (Qfile_notify_error, Qfile_error, Qerror)));
Fput (Qfile_notify_error, Qerror_message,
@@ -6071,6 +6200,7 @@ This includes interactive calls to `delete-file' and
defsubr (&Smake_directory_internal);
defsubr (&Sdelete_directory_internal);
defsubr (&Sdelete_file);
+ defsubr (&Sfile_name_case_insensitive_p);
defsubr (&Srename_file);
defsubr (&Sadd_name_to_file);
defsubr (&Smake_symbolic_link);
diff --git a/src/filelock.c b/src/filelock.c
index 6c60c3e8e1c..a4b742abb5d 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -27,6 +27,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <sys/stat.h>
#include <signal.h>
#include <stdio.h>
+#include <stdlib.h>
#ifdef HAVE_PWD_H
#include <pwd.h>
@@ -65,7 +66,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define BOOT_TIME_FILE "/var/run/random-seed"
#endif
-#ifndef WTMP_FILE
+#if !defined WTMP_FILE && !defined WINDOWSNT
#define WTMP_FILE "/var/log/wtmp"
#endif
@@ -192,14 +193,11 @@ get_boot_time (void)
/* If we did not find a boot time in wtmp, look at wtmp, and so on. */
for (counter = 0; counter < 20 && ! boot_time; counter++)
{
+ Lisp_Object filename = Qnil;
+ bool delete_flag = false;
char cmd_string[sizeof WTMP_FILE ".19.gz"];
- Lisp_Object tempname, filename;
- bool delete_flag = 0;
-
- filename = Qnil;
-
- tempname = make_formatted_string
- (cmd_string, "%s.%d", WTMP_FILE, counter);
+ AUTO_STRING_WITH_LEN (tempname, cmd_string,
+ sprintf (cmd_string, "%s.%d", WTMP_FILE, counter));
if (! NILP (Ffile_exists_p (tempname)))
filename = tempname;
else
@@ -219,7 +217,7 @@ get_boot_time (void)
CALLN (Fcall_process, build_string ("gzip"), Qnil,
list2 (QCfile, filename), Qnil,
build_string ("-cd"), tempname);
- delete_flag = 1;
+ delete_flag = true;
}
}
@@ -254,14 +252,7 @@ get_boot_time_1 (const char *filename, bool newest)
struct utmp ut, *utp;
if (filename)
- {
- /* On some versions of IRIX, opening a nonexistent file name
- is likely to crash in the utmp routines. */
- if (faccessat (AT_FDCWD, filename, R_OK, AT_EACCESS) != 0)
- return;
-
- utmpname (filename);
- }
+ utmpname (filename);
setutent ();
@@ -496,7 +487,7 @@ read_lock_data (char *lfname, char lfinfo[MAX_LFINFO + 1])
while ((nbytes = readlinkat (AT_FDCWD, lfname, lfinfo, MAX_LFINFO + 1)) < 0
&& errno == EINVAL)
{
- int fd = emacs_open (lfname, O_RDONLY | O_BINARY | O_NOFOLLOW, 0);
+ int fd = emacs_open (lfname, O_RDONLY | O_NOFOLLOW, 0);
if (0 <= fd)
{
/* Use read, not emacs_read, since FD isn't unwind-protected. */
@@ -703,7 +694,7 @@ lock_file (Lisp_Object fn)
if (!NILP (subject_buf)
&& NILP (Fverify_visited_file_modtime (subject_buf))
&& !NILP (Ffile_exists_p (fn)))
- call1 (intern ("ask-user-about-supersession-threat"), fn);
+ call1 (intern ("userlock--ask-user-about-supersession-threat"), fn);
}
diff --git a/src/firstfile.c b/src/firstfile.c
index 188d4f81b5c..962d6f6c7f6 100644
--- a/src/firstfile.c
+++ b/src/firstfile.c
@@ -26,7 +26,7 @@ char my_begbss[1]; /* Do not initialize this variable. */
static char _my_begbss[1];
char * my_begbss_static = _my_begbss;
-/* Add a dummy reference to ensure emacs.obj is linked in. */
+/* Add a dummy reference to ensure emacs.o is linked in. */
extern int main (int, char **);
-static int (*dummy) (int, char **) = main;
+int (*dummy_main_reference) (int, char **) = main;
#endif
diff --git a/src/fns.c b/src/fns.c
index d5a1f74d0d8..dfc78424dda 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -20,9 +20,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
+#include <stdlib.h>
#include <unistd.h>
+#include <filevercmp.h>
#include <intprops.h>
#include <vla.h>
+#include <errno.h>
#include "lisp.h"
#include "character.h"
@@ -331,6 +334,50 @@ Symbols are also allowed; their print names are used instead. */)
return i1 < SCHARS (string2) ? Qt : Qnil;
}
+DEFUN ("string-version-lessp", Fstring_version_lessp,
+ Sstring_version_lessp, 2, 2, 0,
+ doc: /* Return non-nil if S1 is less than S2, as version strings.
+
+This function compares version strings S1 and S2:
+ 1) By prefix lexicographically.
+ 2) Then by version (similarly to version comparison of Debian's dpkg).
+ Leading zeros in version numbers are ignored.
+ 3) If both prefix and version are equal, compare as ordinary strings.
+
+For example, \"foo2.png\" compares less than \"foo12.png\".
+Case is significant.
+Symbols are also allowed; their print names are used instead. */)
+ (Lisp_Object string1, Lisp_Object string2)
+{
+ if (SYMBOLP (string1))
+ string1 = SYMBOL_NAME (string1);
+ if (SYMBOLP (string2))
+ string2 = SYMBOL_NAME (string2);
+ CHECK_STRING (string1);
+ CHECK_STRING (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;
+ p1 += size;
+ p2 += size;
+ if (lim1 < p1)
+ return lim2 < p2 ? Qnil : Qt;
+ if (lim2 < p2)
+ return Qnil;
+ }
+
+ return cmp < 0 ? Qt : Qnil;
+}
+
DEFUN ("string-collate-lessp", Fstring_collate_lessp, Sstring_collate_lessp, 2, 4, 0,
doc: /* Return t if first arg string is less than second in collation order.
Symbols are also allowed; their print names are used instead.
@@ -1348,7 +1395,7 @@ The value is actually the tail of LIST whose car is ELT. */)
(register Lisp_Object elt, Lisp_Object list)
{
register Lisp_Object tail;
- for (tail = list; CONSP (tail); tail = XCDR (tail))
+ for (tail = list; !NILP (tail); tail = XCDR (tail))
{
register Lisp_Object tem;
CHECK_LIST_CONS (tail, list);
@@ -1396,7 +1443,7 @@ The value is actually the tail of LIST whose car is ELT. */)
if (!FLOATP (elt))
return Fmemq (elt, list);
- for (tail = list; CONSP (tail); tail = XCDR (tail))
+ for (tail = list; !NILP (tail); tail = XCDR (tail))
{
register Lisp_Object tem;
CHECK_LIST_CONS (tail, list);
@@ -1709,7 +1756,7 @@ changing the value of a sequence `foo'. */)
{
Lisp_Object tail, prev;
- for (tail = seq, prev = Qnil; CONSP (tail); tail = XCDR (tail))
+ for (tail = seq, prev = Qnil; !NILP (tail); tail = XCDR (tail))
{
CHECK_LIST_CONS (tail, seq);
@@ -2470,11 +2517,13 @@ usage: (nconc &rest LISTS) */)
}
/* This is the guts of all mapping functions.
- Apply FN to each element of SEQ, one by one,
- storing the results into elements of VALS, a C vector of Lisp_Objects.
- LENI is the length of VALS, which should also be the length of SEQ. */
+ Apply FN to each element of SEQ, one by one, storing the results
+ into elements of VALS, a C vector of Lisp_Objects. LENI is the
+ length of VALS, which should also be the length of SEQ. Return the
+ number of results; although this is normally LENI, it can be less
+ if SEQ is made shorter as a side effect of FN. */
-static void
+static EMACS_INT
mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
{
Lisp_Object tail, dummy;
@@ -2517,14 +2566,18 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
else /* Must be a list, since Flength did not get an error */
{
tail = seq;
- for (i = 0; i < leni && CONSP (tail); i++)
+ for (i = 0; i < leni; i++)
{
+ if (! CONSP (tail))
+ return i;
dummy = call1 (fn, XCAR (tail));
if (vals)
vals[i] = dummy;
tail = XCDR (tail);
}
}
+
+ return leni;
}
DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0,
@@ -2534,34 +2587,26 @@ SEPARATOR results in spaces between the values returned by FUNCTION.
SEQUENCE may be a list, a vector, a bool-vector, or a string. */)
(Lisp_Object function, Lisp_Object sequence, Lisp_Object separator)
{
- Lisp_Object len;
- EMACS_INT leni;
- EMACS_INT nargs;
- ptrdiff_t i;
- Lisp_Object *args;
- Lisp_Object ret;
USE_SAFE_ALLOCA;
-
- len = Flength (sequence);
+ EMACS_INT leni = XFASTINT (Flength (sequence));
if (CHAR_TABLE_P (sequence))
wrong_type_argument (Qlistp, sequence);
- leni = XINT (len);
- nargs = leni + leni - 1;
- if (nargs < 0) return empty_unibyte_string;
-
- SAFE_ALLOCA_LISP (args, nargs);
-
- mapcar1 (leni, args, function, sequence);
+ EMACS_INT args_alloc = 2 * leni - 1;
+ if (args_alloc < 0)
+ return empty_unibyte_string;
+ Lisp_Object *args;
+ SAFE_ALLOCA_LISP (args, args_alloc);
+ ptrdiff_t nmapped = mapcar1 (leni, args, function, sequence);
+ ptrdiff_t nargs = 2 * nmapped - 1;
- for (i = leni - 1; i > 0; i--)
+ for (ptrdiff_t i = nmapped - 1; i > 0; i--)
args[i + i] = args[i];
- for (i = 1; i < nargs; i += 2)
+ for (ptrdiff_t i = 1; i < nargs; i += 2)
args[i] = separator;
- ret = Fconcat (nargs, args);
+ Lisp_Object ret = Fconcat (nargs, args);
SAFE_FREE ();
-
return ret;
}
@@ -2571,24 +2616,15 @@ The result is a list just as long as SEQUENCE.
SEQUENCE may be a list, a vector, a bool-vector, or a string. */)
(Lisp_Object function, Lisp_Object sequence)
{
- register Lisp_Object len;
- register EMACS_INT leni;
- register Lisp_Object *args;
- Lisp_Object ret;
USE_SAFE_ALLOCA;
-
- len = Flength (sequence);
+ EMACS_INT leni = XFASTINT (Flength (sequence));
if (CHAR_TABLE_P (sequence))
wrong_type_argument (Qlistp, sequence);
- leni = XFASTINT (len);
-
+ Lisp_Object *args;
SAFE_ALLOCA_LISP (args, leni);
-
- mapcar1 (leni, args, function, sequence);
-
- ret = Flist (leni, args);
+ ptrdiff_t nmapped = mapcar1 (leni, args, function, sequence);
+ Lisp_Object ret = Flist (nmapped, args);
SAFE_FREE ();
-
return ret;
}
@@ -2607,6 +2643,24 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */)
return sequence;
}
+
+DEFUN ("mapcan", Fmapcan, Smapcan, 2, 2, 0,
+ doc: /* Apply FUNCTION to each element of SEQUENCE, and concatenate
+the results by altering them (using `nconc').
+SEQUENCE may be a list, a vector, a bool-vector, or a string. */)
+ (Lisp_Object function, Lisp_Object sequence)
+{
+ USE_SAFE_ALLOCA;
+ EMACS_INT leni = XFASTINT (Flength (sequence));
+ if (CHAR_TABLE_P (sequence))
+ wrong_type_argument (Qlistp, sequence);
+ Lisp_Object *args;
+ SAFE_ALLOCA_LISP (args, leni);
+ ptrdiff_t nmapped = mapcar1 (leni, args, function, sequence);
+ Lisp_Object ret = Fnconc (nmapped, args);
+ SAFE_FREE ();
+ return ret;
+}
/* This is how C code calls `yes-or-no-p' and allows the user
to redefine it. */
@@ -2959,7 +3013,6 @@ The data read from the system are decoded using `locale-coding-system'. */)
{
char *str = NULL;
#ifdef HAVE_LANGINFO_CODESET
- Lisp_Object val;
if (EQ (item, Qcodeset))
{
str = nl_langinfo (CODESET);
@@ -2975,7 +3028,7 @@ The data read from the system are decoded using `locale-coding-system'. */)
for (i = 0; i < 7; i++)
{
str = nl_langinfo (days[i]);
- val = build_unibyte_string (str);
+ AUTO_STRING (val, str);
/* Fixme: Is this coding system necessarily right, even if
it is consistent with CODESET? If not, what to do? */
ASET (v, i, code_convert_string_norecord (val, Vlocale_coding_system,
@@ -2995,7 +3048,7 @@ The data read from the system are decoded using `locale-coding-system'. */)
for (i = 0; i < 12; i++)
{
str = nl_langinfo (months[i]);
- val = build_unibyte_string (str);
+ AUTO_STRING (val, str);
ASET (v, i, code_convert_string_norecord (val, Vlocale_coding_system,
0));
}
@@ -3140,7 +3193,7 @@ into shorter lines. */)
SET_PT_BOTH (XFASTINT (beg), ibeg);
insert (encoded, encoded_length);
SAFE_FREE ();
- del_range_byte (ibeg + encoded_length, iend + encoded_length, 1);
+ del_range_byte (ibeg + encoded_length, iend + encoded_length);
/* If point was outside of the region, restore it exactly; else just
move to the beginning of the region. */
@@ -3628,8 +3681,6 @@ larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max)
Low-level Functions
***********************************************************************/
-struct hash_table_test hashtest_eq, hashtest_eql, hashtest_equal;
-
/* Compare KEY1 which has hash code HASH1 and KEY2 with hash code
HASH2 in hash table H using `eql'. Value is true if KEY1 and
KEY2 are the same. */
@@ -3670,7 +3721,6 @@ cmpfn_user_defined (struct hash_table_test *ht,
return !NILP (call2 (ht->user_cmp_function, key1, key2));
}
-
/* Value is a hash code for KEY for use in hash table H which uses
`eq' to compare keys. The hash code returned is guaranteed to fit
in a Lisp integer. */
@@ -3678,34 +3728,27 @@ cmpfn_user_defined (struct hash_table_test *ht,
static EMACS_UINT
hashfn_eq (struct hash_table_test *ht, Lisp_Object key)
{
- EMACS_UINT hash = XHASH (key) ^ XTYPE (key);
- return hash;
+ return XHASH (key) ^ XTYPE (key);
}
/* Value is a hash code for KEY for use in hash table H which uses
- `eql' to compare keys. The hash code returned is guaranteed to fit
+ `equal' to compare keys. The hash code returned is guaranteed to fit
in a Lisp integer. */
static EMACS_UINT
-hashfn_eql (struct hash_table_test *ht, Lisp_Object key)
+hashfn_equal (struct hash_table_test *ht, Lisp_Object key)
{
- EMACS_UINT hash;
- if (FLOATP (key))
- hash = sxhash (key, 0);
- else
- hash = XHASH (key) ^ XTYPE (key);
- return hash;
+ return sxhash (key, 0);
}
/* Value is a hash code for KEY for use in hash table H which uses
- `equal' to compare keys. The hash code returned is guaranteed to fit
+ `eql' to compare keys. The hash code returned is guaranteed to fit
in a Lisp integer. */
static EMACS_UINT
-hashfn_equal (struct hash_table_test *ht, Lisp_Object key)
+hashfn_eql (struct hash_table_test *ht, Lisp_Object key)
{
- EMACS_UINT hash = sxhash (key, 0);
- return hash;
+ return FLOATP (key) ? hashfn_equal (ht, key) : hashfn_eq (ht, key);
}
/* Value is a hash code for KEY for use in hash table H which uses as
@@ -3719,6 +3762,14 @@ hashfn_user_defined (struct hash_table_test *ht, Lisp_Object key)
return hashfn_eq (ht, hash);
}
+struct hash_table_test const
+ hashtest_eq = { LISPSYM_INITIALLY (Qeq), LISPSYM_INITIALLY (Qnil),
+ LISPSYM_INITIALLY (Qnil), 0, hashfn_eq },
+ hashtest_eql = { LISPSYM_INITIALLY (Qeql), LISPSYM_INITIALLY (Qnil),
+ LISPSYM_INITIALLY (Qnil), cmpfn_eql, hashfn_eql },
+ hashtest_equal = { LISPSYM_INITIALLY (Qequal), LISPSYM_INITIALLY (Qnil),
+ LISPSYM_INITIALLY (Qnil), cmpfn_equal, hashfn_equal };
+
/* Allocate basically initialized hash table. */
static struct Lisp_Hash_Table *
@@ -4408,15 +4459,29 @@ sxhash (Lisp_Object obj, int depth)
Lisp Interface
***********************************************************************/
+DEFUN ("sxhash-eq", Fsxhash_eq, Ssxhash_eq, 1, 1, 0,
+ doc: /* Return an integer hash code for OBJ suitable for `eq'.
+If (eq A B), then (= (sxhash-eq A) (sxhash-eq B)). */)
+ (Lisp_Object obj)
+{
+ return make_number (hashfn_eq (NULL, obj));
+}
-DEFUN ("sxhash", Fsxhash, Ssxhash, 1, 1, 0,
- doc: /* Compute a hash code for OBJ and return it as integer. */)
+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)). */)
(Lisp_Object obj)
{
- EMACS_UINT hash = sxhash (obj, 0);
- return make_number (hash);
+ return make_number (hashfn_eql (NULL, obj));
}
+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)). */)
+ (Lisp_Object obj)
+{
+ return make_number (hashfn_equal (NULL, obj));
+}
DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0,
doc: /* Create and return a new hash table.
@@ -4697,6 +4762,21 @@ returns nil, then (funcall TEST x1 x2) also returns nil. */)
#include "sha256.h"
#include "sha512.h"
+static Lisp_Object
+make_digest_string (Lisp_Object digest, int digest_size)
+{
+ unsigned char *p = SDATA (digest);
+
+ for (int i = digest_size - 1; i >= 0; i--)
+ {
+ static char const hexdigit[16] = "0123456789abcdef";
+ int p_i = p[i];
+ p[2 * i] = hexdigit[p_i >> 4];
+ p[2 * i + 1] = hexdigit[p_i & 0xf];
+ }
+ return digest;
+}
+
/* ALGORITHM is a symbol: md5, sha1, sha224 and so on. */
static Lisp_Object
@@ -4704,7 +4784,6 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start,
Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror,
Lisp_Object binary)
{
- int i;
ptrdiff_t size, start_char = 0, start_byte, end_char = 0, end_byte;
register EMACS_INT b, e;
register struct buffer *bp;
@@ -4896,17 +4975,7 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start,
SSDATA (digest));
if (NILP (binary))
- {
- unsigned char *p = SDATA (digest);
- for (i = digest_size - 1; i >= 0; i--)
- {
- static char const hexdigit[16] = "0123456789abcdef";
- int p_i = p[i];
- p[2 * i] = hexdigit[p_i >> 4];
- p[2 * i + 1] = hexdigit[p_i & 0xf];
- }
- return digest;
- }
+ return make_digest_string (digest, digest_size);
else
return make_unibyte_string (SSDATA (digest), digest_size);
}
@@ -4957,6 +5026,45 @@ If BINARY is non-nil, returns a string in binary form. */)
{
return secure_hash (algorithm, object, start, end, Qnil, Qnil, binary);
}
+
+DEFUN ("buffer-hash", Fbuffer_hash, Sbuffer_hash, 0, 1, 0,
+ doc: /* Return a hash of the contents of BUFFER-OR-NAME.
+This hash is performed on the raw internal format of the buffer,
+disregarding any coding systems.
+If nil, use the current buffer." */ )
+ (Lisp_Object buffer_or_name)
+{
+ Lisp_Object buffer;
+ struct buffer *b;
+ struct sha1_ctx ctx;
+
+ if (NILP (buffer_or_name))
+ buffer = Fcurrent_buffer ();
+ else
+ buffer = Fget_buffer (buffer_or_name);
+ if (NILP (buffer))
+ nsberror (buffer_or_name);
+
+ b = XBUFFER (buffer);
+ sha1_init_ctx (&ctx);
+
+ /* Process the first part of the buffer. */
+ sha1_process_bytes (BUF_BEG_ADDR (b),
+ BUF_GPT_BYTE (b) - BUF_BEG_BYTE (b),
+ &ctx);
+
+ /* If the gap is before the end of the buffer, process the last half
+ of the buffer. */
+ if (BUF_GPT_BYTE (b) < BUF_Z_BYTE (b))
+ sha1_process_bytes (BUF_GAP_END_ADDR (b),
+ BUF_Z_ADDR (b) - BUF_GAP_END_ADDR (b),
+ &ctx);
+
+ Lisp_Object digest = make_uninit_string (SHA1_DIGEST_SIZE * 2);
+ sha1_finish_ctx (&ctx, SSDATA (digest));
+ return make_digest_string (digest, SHA1_DIGEST_SIZE);
+}
+
void
syms_of_fns (void)
@@ -4984,7 +5092,9 @@ syms_of_fns (void)
DEFSYM (Qkey_or_value, "key-or-value");
DEFSYM (Qkey_and_value, "key-and-value");
- defsubr (&Ssxhash);
+ defsubr (&Ssxhash_eq);
+ defsubr (&Ssxhash_eql);
+ defsubr (&Ssxhash_equal);
defsubr (&Smake_hash_table);
defsubr (&Scopy_hash_table);
defsubr (&Shash_table_count);
@@ -5020,6 +5130,9 @@ syms_of_fns (void)
doc: /* A list of symbols which are the features of the executing Emacs.
Used by `featurep' and `require', and altered by `provide'. */);
Vfeatures = list1 (Qemacs);
+ DEFSYM (Qfeatures, "features");
+ /* Let people use lexically scoped vars named `features'. */
+ Fmake_var_non_special (Qfeatures);
DEFSYM (Qsubfeatures, "subfeatures");
DEFSYM (Qfuncall, "funcall");
@@ -5055,6 +5168,7 @@ this variable. */);
defsubr (&Sstring_equal);
defsubr (&Scompare_strings);
defsubr (&Sstring_lessp);
+ defsubr (&Sstring_version_lessp);
defsubr (&Sstring_collate_lessp);
defsubr (&Sstring_collate_equalp);
defsubr (&Sappend);
@@ -5099,6 +5213,7 @@ this variable. */);
defsubr (&Snconc);
defsubr (&Smapcar);
defsubr (&Smapc);
+ defsubr (&Smapcan);
defsubr (&Smapconcat);
defsubr (&Syes_or_no_p);
defsubr (&Sload_average);
@@ -5115,23 +5230,6 @@ this variable. */);
defsubr (&Sbase64_decode_string);
defsubr (&Smd5);
defsubr (&Ssecure_hash);
+ defsubr (&Sbuffer_hash);
defsubr (&Slocale_info);
-
- hashtest_eq.name = Qeq;
- hashtest_eq.user_hash_function = Qnil;
- hashtest_eq.user_cmp_function = Qnil;
- hashtest_eq.cmpfn = 0;
- hashtest_eq.hashfn = hashfn_eq;
-
- hashtest_eql.name = Qeql;
- hashtest_eql.user_hash_function = Qnil;
- hashtest_eql.user_cmp_function = Qnil;
- hashtest_eql.cmpfn = cmpfn_eql;
- hashtest_eql.hashfn = hashfn_eql;
-
- hashtest_equal.name = Qequal;
- hashtest_equal.user_hash_function = Qnil;
- hashtest_equal.user_cmp_function = Qnil;
- hashtest_equal.cmpfn = cmpfn_equal;
- hashtest_equal.hashfn = hashfn_equal;
}
diff --git a/src/font.c b/src/font.c
index b85956f225c..ce632335256 100644
--- a/src/font.c
+++ b/src/font.c
@@ -23,6 +23,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <float.h>
#include <stdio.h>
+#include <stdlib.h>
#include <c-ctype.h>
@@ -264,14 +265,13 @@ font_intern_prop (const char *str, ptrdiff_t len, bool force_symbol)
break;
if (i == len)
{
- EMACS_INT n;
-
i = 0;
- for (n = 0; (n += str[i++] - '0') <= MOST_POSITIVE_FIXNUM; n *= 10)
+ for (EMACS_INT n = 0;
+ (n += str[i++] - '0') <= MOST_POSITIVE_FIXNUM; )
{
if (i == len)
return make_number (n);
- if (MOST_POSITIVE_FIXNUM / 10 < n)
+ if (INT_MULTIPLY_WRAPV (n, 10, &n))
break;
}
@@ -1771,7 +1771,8 @@ font_parse_family_registry (Lisp_Object family, Lisp_Object registry, Lisp_Objec
p1 = strchr (p0, '-');
if (! p1)
{
- AUTO_STRING (extra, (&"*-*"[len && p0[len - 1] == '*']));
+ bool asterisk = len && p0[len - 1] == '*';
+ AUTO_STRING_WITH_LEN (extra, &"*-*"[asterisk], 3 - asterisk);
registry = concat2 (registry, extra);
}
registry = Fdowncase (registry);
@@ -2233,7 +2234,8 @@ font_sort_entities (Lisp_Object list, Lisp_Object prefer,
struct font_sort_data *data;
unsigned best_score;
Lisp_Object best_entity;
- Lisp_Object tail, vec IF_LINT (= Qnil);
+ Lisp_Object tail;
+ Lisp_Object vec UNINIT;
USE_SAFE_ALLOCA;
for (i = FONT_WEIGHT_INDEX; i <= FONT_AVGWIDTH_INDEX; i++)
@@ -2861,7 +2863,7 @@ font_open_entity (struct frame *f, Lisp_Object entity, int pixel_size)
struct font_driver_list *driver_list;
Lisp_Object objlist, size, val, font_object;
struct font *font;
- int min_width, height, psize;
+ int height, psize;
eassert (FONT_ENTITY_P (entity));
size = AREF (entity, FONT_SIZE_INDEX);
@@ -2905,10 +2907,12 @@ font_open_entity (struct frame *f, Lisp_Object entity, int pixel_size)
Fcons (font_object, AREF (entity, FONT_OBJLIST_INDEX)));
font = XFONT_OBJECT (font_object);
- min_width = (font->min_width ? font->min_width
- : font->average_width ? font->average_width
- : font->space_width ? font->space_width
- : 1);
+#ifdef HAVE_WINDOW_SYSTEM
+ int min_width = (font->min_width ? font->min_width
+ : font->average_width ? font->average_width
+ : font->space_width ? font->space_width
+ : 1);
+#endif
int font_ascent, font_descent;
get_font_ascent_descent (font, &font_ascent, &font_descent);
@@ -5271,6 +5275,16 @@ font_deferred_log (const char *action, Lisp_Object arg, Lisp_Object result)
}
void
+font_drop_xrender_surfaces (struct frame *f)
+{
+ struct font_driver_list *list;
+
+ for (list = f->font_driver_list; list; list = list->next)
+ if (list->on && list->driver->drop_xrender_surfaces)
+ list->driver->drop_xrender_surfaces (f);
+}
+
+void
syms_of_font (void)
{
sort_shift_bits[FONT_TYPE_INDEX] = 0;
diff --git a/src/font.h b/src/font.h
index cf477290d06..c14823bc1eb 100644
--- a/src/font.h
+++ b/src/font.h
@@ -763,6 +763,13 @@ struct font_driver
Return non-nil if the driver support rendering of combining
characters for FONT according to Unicode combining class. */
Lisp_Object (*combining_capability) (struct font *font);
+
+ /* Optional
+
+ Called when frame F is double-buffered and its size changes; Xft
+ relies on this hook to throw away its old XftDraw (which won't
+ work after the size change) and get a new one. */
+ void (*drop_xrender_surfaces) (struct frame *f);
};
@@ -862,7 +869,9 @@ extern void *font_get_frame_data (struct frame *f, Lisp_Object);
extern void font_filter_properties (Lisp_Object font,
Lisp_Object alist,
const char *const boolean_properties[],
- const char *const non_boolean_properties[]);
+ const char *const non_boolean_properties[]);
+
+extern void font_drop_xrender_surfaces (struct frame *f);
#ifdef HAVE_FREETYPE
extern struct font_driver ftfont_driver;
diff --git a/src/fontset.c b/src/fontset.c
index 74e7df5ae09..38ff780ccba 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -26,6 +26,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
+#include <stdlib.h>
#include "lisp.h"
#include "blockinput.h"
@@ -63,17 +64,26 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
An element of a base fontset is a vector of FONT-DEFs which themselves
are vectors of the form [ FONT-SPEC ENCODING REPERTORY ].
- An element of a realized fontset is nil, t, 0, or a vector of this
- form:
+ An element of a realized fontset is nil, t, 0, or a cons that has
+ this from:
- [ PREFERRED-RFONT-DEF RFONT-DEF0 RFONT-DEF1 ... ]
+ (CHARSET-ORDERED-LIST-TICK . FONT-GROUP)
+
+ CHARSET_ORDERED_LIST_TICK is the same as charset_ordered_list_tick or -1.
+
+ FONT-GROUP is a vector of elements that have this form:
+
+ [ RFONT-DEF0 RFONT-DEF1 ... ]
Each RFONT-DEFn (i.e. Realized FONT-DEF) has this form:
[ FACE-ID FONT-DEF FONT-OBJECT SORTING-SCORE ]
- RFONT-DEFn are automatically reordered by the current charset
- priority list.
+ RFONT-DEFn are automatically reordered considering the current
+ charset priority list, the current language environment, and
+ priorities determined by font-backends.
+
+ RFONT-DEFn may not be a vector in the following cases.
The value nil means that we have not yet generated the above vector
from the base of the fontset.
@@ -83,7 +93,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
The value 0 means that no font is available for the corresponding
range of characters in this fontset, but may be available in the
- default fontset.
+ fallback font-group or in the default fontset.
A fontset has 8 extra slots.
@@ -407,6 +417,9 @@ reorder_font_vector (Lisp_Object font_group, struct font *font)
if (! NILP (encoding))
{
+ /* This spec specifies an encoding by a charset set
+ name. Reflect the preference order of that charset
+ in the upper bits of SCORE. */
Lisp_Object tail;
for (tail = Vcharset_ordered_list;
@@ -419,6 +432,10 @@ reorder_font_vector (Lisp_Object font_group, struct font *font)
}
else
{
+ /* This spec does not specify an encoding. If the spec
+ specifies a language, and the language is not for the
+ current language environment, make the score
+ larger. */
Lisp_Object lang = Ffont_get (font_spec, QClang);
if (! NILP (lang)
@@ -442,11 +459,11 @@ reorder_font_vector (Lisp_Object font_group, struct font *font)
XSETCAR (font_group, make_number (low_tick_bits));
}
-/* Return a font-group (actually a cons (-1 . FONT-GROUP-VECTOR)) for
- character C in FONTSET. If C is -1, return a fallback font-group.
- If C is not -1, the value may be Qt (FONTSET doesn't have a font
- for C even in the fallback group), or 0 (a font for C may be found
- only in the fallback group). */
+/* Return a font-group (actually a cons (CHARSET_ORDERED_LIST_TICK
+ . FONT-GROUP)) for character C or a fallback font-group in the
+ realized fontset FONTSET. The elements of FONT-GROUP are
+ RFONT-DEFs. The value may not be a cons. See the comment at the
+ head of this file for the detail of the return value. */
static Lisp_Object
fontset_get_font_group (Lisp_Object fontset, int c)
@@ -461,23 +478,37 @@ fontset_get_font_group (Lisp_Object fontset, int c)
else
font_group = FONTSET_FALLBACK (fontset);
if (! NILP (font_group))
+ /* We have already realized FONT-DEFs of this font group for C or
+ for fallback (FONT_GROUP is a cons), or we have already found
+ that no appropriate font was found (FONT_GROUP is t or 0). */
return font_group;
base_fontset = FONTSET_BASE (fontset);
if (NILP (base_fontset))
+ /* Actually we never come here because FONTSET is a realized one,
+ and thus it should have a base. */
font_group = Qnil;
else if (c >= 0)
font_group = char_table_ref_and_range (base_fontset, c, &from, &to);
else
font_group = FONTSET_FALLBACK (base_fontset);
+
+ /* FONT_GROUP not being a vector means that no fonts are specified
+ for C, or the fontset does not have fallback fonts. */
if (NILP (font_group))
{
font_group = make_number (0);
if (c >= 0)
+ /* Record that FONTSET does not specify fonts for C. As
+ there's a possibility that a font is found in a fallback
+ font group, we set 0 at the moment. */
char_table_set_range (fontset, from, to, font_group);
return font_group;
}
if (!VECTORP (font_group))
return font_group;
+
+ /* Now realize FONT-DEFs of this font group, and update the realized
+ fontset FONTSET. */
font_group = Fcopy_sequence (font_group);
for (i = 0; i < ASIZE (font_group); i++)
if (! NILP (AREF (font_group, i)))
@@ -498,21 +529,21 @@ fontset_get_font_group (Lisp_Object fontset, int c)
}
/* Return RFONT-DEF (vector) in the realized fontset FONTSET for the
- character C. If no font is found, return Qnil if there's a
+ character C. If no font is found, return Qnil or 0 if there's a
possibility that the default fontset or the fallback font groups
have a proper font, and return Qt if not.
If a font is found but is not yet opened, open it (if FACE is not
NULL) or return Qnil (if FACE is NULL).
- ID is a charset-id that must be preferred, or -1 meaning no
+ CHARSET_ID is a charset-id that must be preferred, or -1 meaning no
preference.
If FALLBACK, search only fallback fonts. */
static Lisp_Object
-fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id,
- bool fallback)
+fontset_find_font (Lisp_Object fontset, int c, struct face *face,
+ int charset_id, bool fallback)
{
Lisp_Object vec, font_group;
int i, charset_matched = 0, found_index;
@@ -534,8 +565,8 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id,
/* We have just created the font-group,
or the charset priorities were changed. */
reorder_font_vector (font_group, face->ascii_face->font);
- if (id >= 0)
- /* Find a spec matching with the charset ID to try at
+ if (charset_id >= 0)
+ /* Find a spec matching with CHARSET_ID to try it at
first. */
for (i = 0; i < ASIZE (vec); i++)
{
@@ -546,7 +577,7 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id,
break;
repertory = FONT_DEF_REPERTORY (RFONT_DEF_FONT_DEF (rfont_def));
- if (XINT (repertory) == id)
+ if (XINT (repertory) == charset_id)
{
charset_matched = i;
break;
@@ -554,7 +585,9 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id,
}
}
- /* Find the first available font in the vector of RFONT-DEF. */
+ /* Find the first available font in the vector of RFONT-DEF. If
+ CHARSET_MATCHED > 0, try the corresponding RFONT-DEF first, then
+ try the rest. */
for (i = 0; i < ASIZE (vec); i++)
{
Lisp_Object font_def;
@@ -565,13 +598,13 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id,
{
if (charset_matched > 0)
{
- /* Try the element matching with the charset ID at first. */
+ /* Try the element matching with CHARSET_ID at first. */
found_index = charset_matched;
/* Make this negative so that we don't come here in the
next loop. */
charset_matched = - charset_matched;
/* We must try the first element in the next loop. */
- i--;
+ i = -1;
}
}
else if (i == - charset_matched)
@@ -630,10 +663,10 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id,
if (NILP (font_object))
{
/* Something strange happened, perhaps because of a
- Font-backend problem. Too avoid crashing, record
+ Font-backend problem. To avoid crashing, record
that this spec is unusable. It may be better to find
another font of the same spec, but currently we don't
- have such an API. */
+ have such an API in font-backend. */
RFONT_DEF_SET_FACE (rfont_def, -1);
continue;
}
@@ -693,6 +726,7 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id,
i = found_index;
}
+ /* Record that no font in this font group supports C. */
FONTSET_SET (fontset, make_number (c), make_number (0));
return Qnil;
@@ -711,10 +745,14 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id,
}
+/* Return RFONT-DEF (vector) corresponding to the font for character
+ C. The value is not a vector if no font is found for C. */
+
static Lisp_Object
fontset_font (Lisp_Object fontset, int c, struct face *face, int id)
{
- Lisp_Object rfont_def, default_rfont_def IF_LINT (= Qnil);
+ Lisp_Object rfont_def;
+ Lisp_Object default_rfont_def UNINIT;
Lisp_Object base_fontset;
/* Try a font-group of FONTSET. */
@@ -1269,7 +1307,7 @@ free_realized_fontsets (Lisp_Object base)
{
struct frame *f = XFRAME (FONTSET_FRAME (this));
int face_id = XINT (XCDR (XCAR (tail)));
- struct face *face = FACE_FROM_ID (f, face_id);
+ struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
/* Face THIS itself is also freed by the following call. */
free_realized_face (f, face);
@@ -1601,7 +1639,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
continue;
if (fontset_id != FRAME_FONTSET (f))
continue;
- face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
+ face = FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID);
if (face)
font_object = font_load_for_lface (f, face->lface, font_spec);
else
diff --git a/src/frame.c b/src/frame.c
index 854f72e64b4..b1d89f396ec 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -20,6 +20,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
+#include <stdlib.h>
#include <errno.h>
#include <limits.h>
@@ -106,31 +107,32 @@ decode_any_frame (register Lisp_Object frame)
}
#ifdef HAVE_WINDOW_SYSTEM
-
bool
-window_system_available (struct frame *f)
+display_available (void)
{
- return f ? FRAME_WINDOW_P (f) || FRAME_MSDOS_P (f) : x_display_list != NULL;
+ return x_display_list != NULL;
}
-
-#endif /* HAVE_WINDOW_SYSTEM */
+#endif
struct frame *
decode_window_system_frame (Lisp_Object frame)
{
struct frame *f = decode_live_frame (frame);
-
- if (!window_system_available (f))
- error ("Window system frame should be used");
+ check_window_system (f);
+#ifdef HAVE_WINDOW_SYSTEM
return f;
+#endif
}
void
check_window_system (struct frame *f)
{
- if (!window_system_available (f))
- error (f ? "Window system frame should be used"
- : "Window system is not in use or not initialized");
+#ifdef HAVE_WINDOW_SYSTEM
+ if (window_system_available (f))
+ return;
+#endif
+ error (f ? "Window system frame should be used"
+ : "Window system is not in use or not initialized");
}
/* Return the value of frame parameter PROP in frame FRAME. */
@@ -500,8 +502,8 @@ adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit,
&& new_lines == old_lines)
/* No change. Sanitize window sizes and return. */
{
- sanitize_window_sizes (frame, Qt);
- sanitize_window_sizes (frame, Qnil);
+ sanitize_window_sizes (Qt);
+ sanitize_window_sizes (Qnil);
return;
}
@@ -537,7 +539,7 @@ adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit,
#endif
}
else if (new_cols != old_cols)
- call2 (Qwindow_pixel_to_total, frame, Qt);
+ call2 (Qwindow__pixel_to_total, frame, Qt);
if (new_windows_height != old_windows_height
/* When the top margin has changed we have to recalculate the top
@@ -553,7 +555,7 @@ adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit,
FrameRows (FRAME_TTY (f)) = new_lines + FRAME_TOP_MARGIN (f);
}
else if (new_lines != old_lines)
- call2 (Qwindow_pixel_to_total, frame, Qnil);
+ call2 (Qwindow__pixel_to_total, frame, Qnil);
frame_size_history_add
(f, Qadjust_frame_size_3, new_text_width, new_text_height,
@@ -581,8 +583,8 @@ adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit,
}
/* Sanitize window sizes. */
- sanitize_window_sizes (frame, Qt);
- sanitize_window_sizes (frame, Qnil);
+ sanitize_window_sizes (Qt);
+ sanitize_window_sizes (Qnil);
adjust_frame_glyphs (f);
calculate_costs (f);
@@ -594,8 +596,6 @@ adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit,
|| new_pixel_height != old_pixel_height);
unblock_input ();
-
- run_window_configuration_change_hook (f);
}
/* Allocate basically initialized frame. */
@@ -611,7 +611,7 @@ make_frame (bool mini_p)
{
Lisp_Object frame;
struct frame *f;
- struct window *rw, *mw IF_LINT (= NULL);
+ struct window *rw, *mw;
Lisp_Object root_window;
Lisp_Object mini_window;
@@ -659,6 +659,7 @@ make_frame (bool mini_p)
mw->mini = 1;
wset_frame (mw, frame);
fset_minibuffer_window (f, mini_window);
+ store_frame_param (f, Qminibuffer, Qt);
}
else
{
@@ -771,6 +772,7 @@ make_frame_without_minibuffer (Lisp_Object mini_window, KBOARD *kb,
}
fset_minibuffer_window (f, mini_window);
+ store_frame_param (f, Qminibuffer, mini_window);
/* Make the chosen minibuffer window display the proper minibuffer,
unless it is already showing a minibuffer. */
@@ -808,6 +810,7 @@ make_minibuffer_frame (void)
mini_window = f->root_window;
fset_minibuffer_window (f, mini_window);
+ store_frame_param (f, Qminibuffer, Qonly);
XWINDOW (mini_window)->mini = 1;
wset_next (XWINDOW (mini_window), Qnil);
wset_prev (XWINDOW (mini_window), Qnil);
@@ -1064,6 +1067,10 @@ affects all frames on the same terminal device. */)
(t->display_info.tty->name
? build_string (t->display_info.tty->name)
: Qnil));
+ /* On terminal frames the `minibuffer' frame parameter is always
+ virtually t. Avoid that a different value in parms causes
+ complaints, see Bug#24758. */
+ store_in_alist (&parms, Qminibuffer, Qt);
Fmodify_frame_parameters (frame, parms);
/* Make the frame face alist be frame-specific, so that each
@@ -1157,7 +1164,12 @@ do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object nor
if (FRAMEP (xfocus))
{
focus = FRAME_FOCUS_FRAME (XFRAME (xfocus));
- if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
+ if ((FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
+ /* Redirect frame focus also when FRAME has its minibuffer
+ window on the selected frame (see Bug#24500). */
+ || (NILP (focus)
+ && EQ (FRAME_MINIBUF_WINDOW (XFRAME (frame)),
+ sf->selected_window)))
Fredirect_frame_focus (xfocus, frame);
}
}
@@ -1824,7 +1836,7 @@ 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.
-FRAME defaults to the selected frame.
+FRAME must be a live frame and defaults to the selected one.
A frame may not be deleted if its minibuffer serves as surrogate
minibuffer for another frame. Normally, you may not delete a frame if
@@ -2137,10 +2149,12 @@ If omitted, FRAME defaults to the currently selected frame. */)
check_minibuf_window (frame, EQ (minibuf_window, selected_window));
/* I think this should be done with a hook. */
-#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
+ {
+#ifdef HAVE_WINDOW_SYSTEM
x_iconify_frame (f);
#endif
+ }
/* Make menu bar update for the Buffers and Frames menus. */
windows_or_buffers_changed = 17;
@@ -2403,6 +2417,46 @@ store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
{
register Lisp_Object old_alist_elt;
+ if (EQ (prop, Qminibuffer))
+ {
+ if (WINDOWP (val))
+ {
+ if (!MINI_WINDOW_P (XWINDOW (val)))
+ error ("The `minibuffer' parameter does not specify a valid minibuffer window");
+ else if (FRAME_MINIBUF_ONLY_P (f))
+ {
+ if (EQ (val, FRAME_MINIBUF_WINDOW (f)))
+ val = Qonly;
+ else
+ error ("Can't change the minibuffer window of a minibuffer-only frame");
+ }
+ else if (FRAME_HAS_MINIBUF_P (f))
+ {
+ if (EQ (val, FRAME_MINIBUF_WINDOW (f)))
+ val = Qt;
+ else
+ error ("Can't change the minibuffer window of a frame with its own minibuffer");
+ }
+ else
+ /* Store the chosen minibuffer window. */
+ fset_minibuffer_window (f, val);
+ }
+ else
+ {
+ Lisp_Object old_val = Fcdr (Fassq (Qminibuffer, f->param_alist));
+
+ if (!NILP (old_val))
+ {
+ if (WINDOWP (old_val) && NILP (val))
+ /* Don't change the value for a minibuffer-less frame if
+ only nil was specified as new value. */
+ val = old_val;
+ else if (!EQ (old_val, val))
+ error ("Can't change the `minibuffer' parameter of this frame");
+ }
+ }
+ }
+
/* The buffer-list parameters are stored in a special place and not
in the alist. All buffers must be live. */
if (EQ (prop, Qbuffer_list))
@@ -2474,19 +2528,6 @@ store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
else if (EQ (prop, Qname))
set_term_frame_name (f, val);
}
-
- if (EQ (prop, Qminibuffer) && WINDOWP (val))
- {
- if (! MINI_WINDOW_P (XWINDOW (val)))
- error ("Surrogate minibuffer windows must be minibuffer windows");
-
- if ((FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
- && !EQ (val, f->minibuffer_window))
- error ("Can't change the surrogate minibuffer of a frame with its own minibuffer");
-
- /* Install the chosen minibuffer window, with proper buffer. */
- fset_minibuffer_window (f, val);
- }
}
/* Return color matches UNSPEC on frame F or nil if UNSPEC
@@ -2564,10 +2605,6 @@ If FRAME is omitted or nil, return information on the currently selected frame.
: FRAME_COLS (f));
store_in_alist (&alist, Qwidth, make_number (width));
store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil));
- store_in_alist (&alist, Qminibuffer,
- (! FRAME_HAS_MINIBUF_P (f) ? Qnil
- : FRAME_MINIBUF_ONLY_P (f) ? Qonly
- : FRAME_MINIBUF_WINDOW (f)));
store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
store_in_alist (&alist, Qbuffer_list, f->buffer_list);
store_in_alist (&alist, Qburied_buffer_list, f->buried_buffer_list);
@@ -2606,6 +2643,22 @@ If FRAME is nil, describe the currently selected frame. */)
/* Avoid consing in frequent cases. */
if (EQ (parameter, Qname))
value = f->name;
+#ifdef HAVE_WINDOW_SYSTEM
+ /* These are used by vertical motion commands. */
+ else if (EQ (parameter, Qvertical_scroll_bars))
+ value = (f->vertical_scroll_bar_type == vertical_scroll_bar_none
+ ? Qnil
+ : (f->vertical_scroll_bar_type == vertical_scroll_bar_left
+ ? Qleft : Qright));
+ else if (EQ (parameter, Qhorizontal_scroll_bars))
+ value = f->horizontal_scroll_bars ? Qt : Qnil;
+ else if (EQ (parameter, Qline_spacing) && f->extra_line_spacing == 0)
+ /* If this is non-zero, we can't determine whether the user specified
+ an integer or float value without looking through 'param_alist'. */
+ value = make_number (0);
+ else if (EQ (parameter, Qfont) && FRAME_X_P (f))
+ value = FRAME_FONT (f)->props[FONT_NAME_INDEX];
+#endif /* HAVE_WINDOW_SYSTEM */
#ifdef HAVE_X_WINDOWS
else if (EQ (parameter, Qdisplay) && FRAME_X_P (f))
value = XCAR (FRAME_DISPLAY_INFO (f)->name_list_element);
@@ -3003,16 +3056,18 @@ or bottom edge of the outer frame of FRAME relative to the right or
bottom edge of FRAME's display. */)
(Lisp_Object frame, Lisp_Object x, Lisp_Object y)
{
- register struct frame *f = decode_live_frame (frame);
+ struct frame *f = decode_live_frame (frame);
CHECK_TYPE_RANGED_INTEGER (int, x);
CHECK_TYPE_RANGED_INTEGER (int, y);
/* I think this should be done with a hook. */
-#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
- x_set_offset (f, XINT (x), XINT (y), 1);
+ {
+#ifdef HAVE_WINDOW_SYSTEM
+ x_set_offset (f, XINT (x), XINT (y), 1);
#endif
+ }
return Qt;
}
@@ -3073,6 +3128,7 @@ static const struct frame_parm_table frame_parms[] =
{"alpha", SYMBOL_INDEX (Qalpha)},
{"sticky", SYMBOL_INDEX (Qsticky)},
{"tool-bar-position", SYMBOL_INDEX (Qtool_bar_position)},
+ {"inhibit-double-buffering", SYMBOL_INDEX (Qinhibit_double_buffering)},
};
#ifdef HAVE_WINDOW_SYSTEM
@@ -3091,8 +3147,7 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
/* If both of these parameters are present, it's more efficient to
set them both at once. So we wait until we've looked at the
entire list before we set them. */
- int width IF_LINT (= 0), height IF_LINT (= 0);
- bool width_change = false, height_change = false;
+ int width = -1, height = -1; /* -1 denotes they were not changed. */
/* Same here. */
Lisp_Object left, top;
@@ -3107,70 +3162,58 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
/* Record in these vectors all the parms specified. */
Lisp_Object *parms;
Lisp_Object *values;
- ptrdiff_t i, p;
+ ptrdiff_t i, j, size;
bool left_no_change = 0, top_no_change = 0;
#ifdef HAVE_X_WINDOWS
bool icon_left_no_change = 0, icon_top_no_change = 0;
#endif
- i = 0;
- for (tail = alist; CONSP (tail); tail = XCDR (tail))
- i++;
+ for (size = 0, tail = alist; CONSP (tail); tail = XCDR (tail))
+ size++;
USE_SAFE_ALLOCA;
- SAFE_ALLOCA_LISP (parms, 2 * i);
- values = parms + i;
+ SAFE_ALLOCA_LISP (parms, 2 * size);
+ values = parms + size;
/* Extract parm names and values into those vectors. */
- i = 0;
+ i = 0, j = size - 1;
for (tail = alist; CONSP (tail); tail = XCDR (tail))
{
- Lisp_Object elt;
-
- elt = XCAR (tail);
- parms[i] = Fcar (elt);
- values[i] = Fcdr (elt);
- i++;
- }
- /* TAIL and ALIST are not used again below here. */
- alist = tail = Qnil;
-
- top = left = Qunbound;
- icon_left = icon_top = Qunbound;
+ Lisp_Object elt = XCAR (tail), prop = Fcar (elt), val = Fcdr (elt);
- /* Process foreground_color and background_color before anything else.
- They are independent of other properties, but other properties (e.g.,
- cursor_color) are dependent upon them. */
- /* Process default font as well, since fringe widths depends on it. */
- for (p = 0; p < i; p++)
- {
- Lisp_Object prop, val;
+ /* Some properties are independent of other properties, but other
+ properties are dependent upon them. These special properties
+ are foreground_color, background_color (affects cursor_color)
+ and font (affects fringe widths); they're recorded starting
+ from the end of PARMS and VALUES to process them first by using
+ reverse iteration. */
- prop = parms[p];
- val = values[p];
if (EQ (prop, Qforeground_color)
|| EQ (prop, Qbackground_color)
|| EQ (prop, Qfont))
{
- register Lisp_Object param_index, old_value;
-
- old_value = get_frame_param (f, prop);
- if (NILP (Fequal (val, old_value)))
- {
- store_frame_param (f, prop, val);
-
- param_index = Fget (prop, Qx_frame_parameter);
- if (NATNUMP (param_index)
- && XFASTINT (param_index) < ARRAYELTS (frame_parms)
- && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
- (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
- }
+ parms[j] = prop;
+ values[j] = val;
+ j--;
+ }
+ else
+ {
+ parms[i] = prop;
+ values[i] = val;
+ i++;
}
}
- /* Now process them in reverse of specified order. */
- while (i-- != 0)
+ /* TAIL and ALIST are not used again below here. */
+ alist = tail = Qnil;
+
+ top = left = Qunbound;
+ icon_left = icon_top = Qunbound;
+
+ /* Reverse order is used to make sure that special
+ properties noticed above are processed first. */
+ for (i = size - 1; i >= 0; i--)
{
Lisp_Object prop, val;
@@ -3180,30 +3223,18 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
if (EQ (prop, Qwidth))
{
if (RANGED_INTEGERP (0, val, INT_MAX))
- {
- width = XFASTINT (val) * FRAME_COLUMN_WIDTH (f) ;
- width_change = true;
- }
+ width = XFASTINT (val) * FRAME_COLUMN_WIDTH (f) ;
else if (CONSP (val) && EQ (XCAR (val), Qtext_pixels)
&& RANGED_INTEGERP (0, XCDR (val), INT_MAX))
- {
- width = XFASTINT (XCDR (val));
- width_change = true;
- }
+ width = XFASTINT (XCDR (val));
}
else if (EQ (prop, Qheight))
{
if (RANGED_INTEGERP (0, val, INT_MAX))
- {
- height = XFASTINT (val) * FRAME_LINE_HEIGHT (f);
- height_change = true;
- }
+ height = XFASTINT (val) * FRAME_LINE_HEIGHT (f);
else if (CONSP (val) && EQ (XCAR (val), Qtext_pixels)
&& RANGED_INTEGERP (0, XCDR (val), INT_MAX))
- {
- height = XFASTINT (XCDR (val));
- height_change = true;
- }
+ height = XFASTINT (XCDR (val));
}
else if (EQ (prop, Qtop))
top = val;
@@ -3218,11 +3249,6 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
fullscreen = val;
fullscreen_change = true;
}
- else if (EQ (prop, Qforeground_color)
- || EQ (prop, Qbackground_color)
- || EQ (prop, Qfont))
- /* Processed above. */
- continue;
else
{
register Lisp_Object param_index, old_value;
@@ -3290,16 +3316,15 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
XSETFRAME (frame, f);
- if ((width_change && width != FRAME_TEXT_WIDTH (f))
- || (height_change && height != FRAME_TEXT_HEIGHT (f)))
+ if ((width != -1 && width != FRAME_TEXT_WIDTH (f))
+ || (height != -1 && height != FRAME_TEXT_HEIGHT (f)))
/* We could consider checking f->after_make_frame here, but I
don't have the faintest idea why the following is needed at
all. With the old setting it can get a Heisenbug when
EmacsFrameResize intermittently provokes a delayed
change_frame_size in the middle of adjust_frame_size. */
/** || (f->can_x_set_window_size && (f->new_height || f->new_width))) **/
- adjust_frame_size (f, width_change ? width : -1,
- height_change ? height : -1, 1, 0, Qx_set_frame_parameters);
+ adjust_frame_size (f, width, height, 1, 0, Qx_set_frame_parameters);
if ((!NILP (left) || !NILP (top))
&& ! (left_no_change && top_no_change)
@@ -3646,7 +3671,7 @@ x_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
x_new_font (f, font_object, fontset);
store_frame_param (f, Qfont, arg);
#ifdef HAVE_X_WINDOWS
- store_frame_param (f, Qfont_param, font_param);
+ store_frame_param (f, Qfont_parameter, font_param);
#endif
/* Recalculate toolbar height. */
f->n_tool_bar_rows = 0;
@@ -3741,8 +3766,8 @@ x_set_left_fringe (struct frame *f, Lisp_Object new_value, Lisp_Object old_value
if (new_width != old_width)
{
- FRAME_LEFT_FRINGE_WIDTH (f) = new_width;
- FRAME_FRINGE_COLS (f) /* Round up. */
+ f->left_fringe_width = new_width;
+ f->fringe_cols /* Round up. */
= (new_width + FRAME_RIGHT_FRINGE_WIDTH (f) + unit - 1) / unit;
if (FRAME_X_WINDOW (f) != 0)
@@ -3765,8 +3790,8 @@ x_set_right_fringe (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu
if (new_width != old_width)
{
- FRAME_RIGHT_FRINGE_WIDTH (f) = new_width;
- FRAME_FRINGE_COLS (f) /* Round up. */
+ f->right_fringe_width = new_width;
+ f->fringe_cols /* Round up. */
= (new_width + FRAME_LEFT_FRINGE_WIDTH (f) + unit - 1) / unit;
if (FRAME_X_WINDOW (f) != 0)
@@ -3795,13 +3820,11 @@ void
x_set_right_divider_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
int old = FRAME_RIGHT_DIVIDER_WIDTH (f);
-
CHECK_TYPE_RANGED_INTEGER (int, arg);
- FRAME_RIGHT_DIVIDER_WIDTH (f) = XINT (arg);
- if (FRAME_RIGHT_DIVIDER_WIDTH (f) < 0)
- FRAME_RIGHT_DIVIDER_WIDTH (f) = 0;
- if (FRAME_RIGHT_DIVIDER_WIDTH (f) != old)
+ int new = max (0, XINT (arg));
+ if (new != old)
{
+ f->right_divider_width = new;
adjust_frame_size (f, -1, -1, 4, 0, Qright_divider_width);
adjust_frame_glyphs (f);
SET_FRAME_GARBAGED (f);
@@ -3813,13 +3836,11 @@ void
x_set_bottom_divider_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
int old = FRAME_BOTTOM_DIVIDER_WIDTH (f);
-
CHECK_TYPE_RANGED_INTEGER (int, arg);
- FRAME_BOTTOM_DIVIDER_WIDTH (f) = XINT (arg);
- if (FRAME_BOTTOM_DIVIDER_WIDTH (f) < 0)
- FRAME_BOTTOM_DIVIDER_WIDTH (f) = 0;
- if (FRAME_BOTTOM_DIVIDER_WIDTH (f) != old)
+ int new = max (0, XINT (arg));
+ if (new != old)
{
+ f->bottom_divider_width = new;
adjust_frame_size (f, -1, -1, 4, 0, Qbottom_divider_width);
adjust_frame_glyphs (f);
SET_FRAME_GARBAGED (f);
@@ -4423,8 +4444,8 @@ XParseGeometry (char *string,
{
int mask = NoValue;
char *strind;
- unsigned long tempWidth, tempHeight;
- long int tempX, tempY;
+ unsigned long tempWidth UNINIT, tempHeight UNINIT;
+ long int tempX UNINIT, tempY UNINIT;
char *nextCharacter;
if (string == NULL || *string == '\0')
@@ -4889,7 +4910,7 @@ syms_of_frame (void)
DEFSYM (Qframep, "framep");
DEFSYM (Qframe_live_p, "frame-live-p");
DEFSYM (Qframe_windows_min_size, "frame-windows-min-size");
- DEFSYM (Qwindow_pixel_to_total, "window--pixel-to-total");
+ DEFSYM (Qwindow__pixel_to_total, "window--pixel-to-total");
DEFSYM (Qexplicit_name, "explicit-name");
DEFSYM (Qheight, "height");
DEFSYM (Qicon, "icon");
@@ -5024,6 +5045,7 @@ syms_of_frame (void)
DEFSYM (Qvertical_scroll_bars, "vertical-scroll-bars");
DEFSYM (Qvisibility, "visibility");
DEFSYM (Qwait_for_wm, "wait-for-wm");
+ DEFSYM (Qinhibit_double_buffering, "inhibit-double-buffering");
{
int i;
@@ -5267,6 +5289,21 @@ The function `frame--size-history' displays the value of this variable
in a more readable form. */);
frame_size_history = Qnil;
+ DEFVAR_BOOL ("tooltip-reuse-hidden-frame", tooltip_reuse_hidden_frame,
+ doc: /* Non-nil means reuse hidden tooltip frames.
+When this is nil, delete a tooltip frame when hiding the associated
+tooltip. When this is non-nil, make the tooltip frame invisible only,
+so it can be reused when the next tooltip is shown.
+
+Setting this to non-nil may drastically reduce the consing overhead
+incurred by creating new tooltip frames. However, a value of non-nil
+means also that intermittent changes of faces or `default-frame-alist'
+are not applied when showing a tooltip in a reused frame.
+
+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;
+
staticpro (&Vframe_list);
defsubr (&Sframep);
diff --git a/src/frame.h b/src/frame.h
index f0cdcd42096..5e3ee68942a 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -288,8 +288,9 @@ struct frame
cleared. */
bool_bf explicit_name : 1;
- /* True if size of some window on this frame has changed. */
- bool_bf window_sizes_changed : 1;
+ /* True if configuration of windows on this frame has changed since
+ last call of run_window_size_change_functions. */
+ bool_bf window_configuration_changed : 1;
/* True if the mouse has moved on this display device
since the last time we checked. */
@@ -828,10 +829,10 @@ default_pixels_per_inch_y (void)
are frozen on frame F. */
#define FRAME_WINDOWS_FROZEN(f) (f)->frozen_window_starts
-/* True if a size change has been requested for frame F
- but not yet really put into effect. This can be true temporarily
- when an X event comes in at a bad time. */
-#define FRAME_WINDOW_SIZES_CHANGED(f) (f)->window_sizes_changed
+/* True if the frame's window configuration has changed since last call
+ of run_window_size_change_functions. */
+#define FRAME_WINDOW_CONFIGURATION_CHANGED(f) \
+ (f)->window_configuration_changed
/* The minibuffer window of frame F, if it has one; otherwise nil. */
#define FRAME_MINIBUF_WINDOW(f) f->minibuffer_window
@@ -1101,7 +1102,14 @@ extern Lisp_Object selected_frame;
extern int frame_default_tool_bar_height;
#endif
-extern struct frame *decode_window_system_frame (Lisp_Object);
+#ifdef HAVE_WINDOW_SYSTEM
+# define WINDOW_SYSTEM_RETURN
+#else
+# define WINDOW_SYSTEM_RETURN _Noreturn
+#endif
+
+extern WINDOW_SYSTEM_RETURN struct frame *
+ decode_window_system_frame (Lisp_Object);
extern struct frame *decode_live_frame (Lisp_Object);
extern struct frame *decode_any_frame (Lisp_Object);
extern struct frame *make_initial_frame (void);
@@ -1111,11 +1119,20 @@ extern struct frame *make_minibuffer_frame (void);
extern struct frame *make_frame_without_minibuffer (Lisp_Object,
struct kboard *,
Lisp_Object);
-extern bool window_system_available (struct frame *);
-#else /* not HAVE_WINDOW_SYSTEM */
-#define window_system_available(f) ((void) (f), false)
-#endif /* HAVE_WINDOW_SYSTEM */
-extern void check_window_system (struct frame *);
+extern bool display_available (void);
+#endif
+
+INLINE bool
+window_system_available (struct frame *f)
+{
+#ifdef HAVE_WINDOW_SYSTEM
+ return f ? FRAME_WINDOW_P (f) || FRAME_MSDOS_P (f) : display_available ();
+#else
+ return false;
+#endif
+}
+
+extern WINDOW_SYSTEM_RETURN void check_window_system (struct frame *);
extern void frame_make_pointer_invisible (struct frame *);
extern void frame_make_pointer_visible (struct frame *);
extern Lisp_Object delete_frame (Lisp_Object, Lisp_Object);
@@ -1149,46 +1166,68 @@ extern Lisp_Object Vframe_list;
This value currently equals the average width of the default font of F. */
#define FRAME_COLUMN_WIDTH(F) ((F)->column_width)
-/* Pixel width of areas used to display truncation marks, continuation
- marks, overlay arrows. This is 0 for terminal frames. */
+/* Get a frame's window system dimension. If no window system, this is 0. */
+INLINE int
+frame_dimension (int x)
+{
#ifdef HAVE_WINDOW_SYSTEM
+ return x;
+#else
+ return 0;
+#endif
+}
/* Total width of fringes reserved for drawing truncation bitmaps,
continuation bitmaps and alike. The width is in canonical char
units of the frame. This must currently be the case because window
sizes aren't pixel values. If it weren't the case, we wouldn't be
able to split windows horizontally nicely. */
-#define FRAME_FRINGE_COLS(F) ((F)->fringe_cols)
+INLINE int
+FRAME_FRINGE_COLS (struct frame *f)
+{
+ return frame_dimension (f->fringe_cols);
+}
/* Pixel-width of the left and right fringe. */
-#define FRAME_LEFT_FRINGE_WIDTH(F) ((F)->left_fringe_width)
-#define FRAME_RIGHT_FRINGE_WIDTH(F) ((F)->right_fringe_width)
+INLINE int
+FRAME_LEFT_FRINGE_WIDTH (struct frame *f)
+{
+ return frame_dimension (f->left_fringe_width);
+}
+INLINE int
+FRAME_RIGHT_FRINGE_WIDTH (struct frame *f)
+{
+ return frame_dimension (f->right_fringe_width);
+}
/* Total width of fringes in pixels. */
-#define FRAME_TOTAL_FRINGE_WIDTH(F) \
- (FRAME_LEFT_FRINGE_WIDTH (F) + FRAME_RIGHT_FRINGE_WIDTH (F))
+INLINE int
+FRAME_TOTAL_FRINGE_WIDTH (struct frame *f)
+{
+ return FRAME_LEFT_FRINGE_WIDTH (f) + FRAME_RIGHT_FRINGE_WIDTH (f);
+}
/* Pixel-width of internal border lines */
-#define FRAME_INTERNAL_BORDER_WIDTH(F) ((F)->internal_border_width)
+INLINE int
+FRAME_INTERNAL_BORDER_WIDTH (struct frame *f)
+{
+ return frame_dimension (f->internal_border_width);
+}
/* Pixel-size of window border lines */
-#define FRAME_RIGHT_DIVIDER_WIDTH(F) ((F)->right_divider_width)
-#define FRAME_BOTTOM_DIVIDER_WIDTH(F) ((F)->bottom_divider_width)
-
-#else /* not HAVE_WINDOW_SYSTEM */
-
-#define FRAME_FRINGE_COLS(F) 0
-#define FRAME_TOTAL_FRINGE_WIDTH(F) 0
-#define FRAME_LEFT_FRINGE_WIDTH(F) 0
-#define FRAME_RIGHT_FRINGE_WIDTH(F) 0
-#define FRAME_INTERNAL_BORDER_WIDTH(F) 0
-#define FRAME_RIGHT_DIVIDER_WIDTH(F) 0
-#define FRAME_BOTTOM_DIVIDER_WIDTH(F) 0
-
-#endif /* not HAVE_WINDOW_SYSTEM */
+INLINE int
+FRAME_RIGHT_DIVIDER_WIDTH (struct frame *f)
+{
+ return frame_dimension (f->right_divider_width);
+}
+INLINE int
+FRAME_BOTTOM_DIVIDER_WIDTH (struct frame *f)
+{
+ return frame_dimension (f->bottom_divider_width);
+}
/***********************************************************************
Conversion between canonical units and pixels
@@ -1469,7 +1508,7 @@ INLINE_HEADER_END
/* Suppress -Wsuggest-attribute=const if there are no scroll bars.
This is for functions like x_set_horizontal_scroll_bars that have
no effect in this case. */
-#if ! USE_HORIZONTAL_SCROLL_BARS && 4 < __GNUC__ + (6 <= __GNUC_MINOR__)
+#if ! USE_HORIZONTAL_SCROLL_BARS && GNUC_PREREQ (4, 6, 0)
# pragma GCC diagnostic ignored "-Wsuggest-attribute=const"
#endif
diff --git a/src/fringe.c b/src/fringe.c
index 061f78658cf..986bde16f09 100644
--- a/src/fringe.c
+++ b/src/fringe.c
@@ -620,8 +620,7 @@ draw_fringe_bitmap_1 (struct window *w, struct glyph_row *row, int left_p, int o
break;
}
- p.face = FACE_FROM_ID (f, face_id);
-
+ p.face = FACE_FROM_ID_OR_NULL (f, face_id);
if (p.face == NULL)
{
/* This could happen after clearing face cache.
@@ -956,7 +955,7 @@ update_window_fringes (struct window *w, bool keep_current_p)
row->indicate_bob_p is set, so it's OK that top_row_ends_at_zv_p
is not initialized here. Similarly for bot_ind_rn,
row->indicate_eob_p and bot_row_ends_at_zv_p. */
- int top_row_ends_at_zv_p IF_LINT (= 0), bot_row_ends_at_zv_p IF_LINT (= 0);
+ int top_row_ends_at_zv_p UNINIT, bot_row_ends_at_zv_p UNINIT;
if (w->pseudo_window_p)
return 0;
@@ -1627,7 +1626,7 @@ If FACE is nil, reset face to default fringe face. */)
{
struct frame *f = SELECTED_FRAME ();
- if (FACE_FROM_ID (f, FRINGE_FACE_ID)
+ if (FACE_FROM_ID_OR_NULL (f, FRINGE_FACE_ID)
&& lookup_derived_face (f, face, FRINGE_FACE_ID, 1) < 0)
error ("No such face");
}
diff --git a/src/ftfont.c b/src/ftfont.c
index 7285aee9bd4..1ae3f88daa3 100644
--- a/src/ftfont.c
+++ b/src/ftfont.c
@@ -568,7 +568,6 @@ ftfont_get_charset (Lisp_Object registry)
char *str = SSDATA (SYMBOL_NAME (registry));
USE_SAFE_ALLOCA;
char *re = SAFE_ALLOCA (SBYTES (SYMBOL_NAME (registry)) * 2 + 1);
- Lisp_Object regexp;
int i, j;
for (i = j = 0; i < SBYTES (SYMBOL_NAME (registry)); i++, j++)
@@ -582,13 +581,13 @@ ftfont_get_charset (Lisp_Object registry)
re[j] = '.';
}
re[j] = '\0';
- regexp = make_unibyte_string (re, j);
- SAFE_FREE ();
+ AUTO_STRING_WITH_LEN (regexp, re, j);
for (i = 0; fc_charset_table[i].name; i++)
if (fast_c_string_match_ignore_case
(regexp, fc_charset_table[i].name,
strlen (fc_charset_table[i].name)) >= 0)
break;
+ SAFE_FREE ();
if (! fc_charset_table[i].name)
return -1;
if (! fc_charset_table[i].fc_charset)
diff --git a/src/ftxfont.c b/src/ftxfont.c
index f49d44ffc20..bfdeb4051b9 100644
--- a/src/ftxfont.c
+++ b/src/ftxfont.c
@@ -95,7 +95,7 @@ ftxfont_get_gcs (struct frame *f, unsigned long foreground, unsigned long backgr
if (! x_alloc_nearest_color (f, FRAME_X_COLORMAP (f), &color))
break;
xgcv.foreground = color.pixel;
- new->gcs[i - 1] = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ new->gcs[i - 1] = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
GCForeground, &xgcv);
}
unblock_input ();
@@ -139,14 +139,14 @@ ftxfont_draw_bitmap (struct frame *f, GC gc_fore, GC *gcs, struct font *font,
p[n[0]].y = y - bitmap.top + i;
if (++n[0] == size)
{
- XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
gc_fore, p, size, CoordModeOrigin);
n[0] = 0;
}
}
}
if (flush && n[0] > 0)
- XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
gc_fore, p, n[0], CoordModeOrigin);
}
else
@@ -168,7 +168,7 @@ ftxfont_draw_bitmap (struct frame *f, GC gc_fore, GC *gcs, struct font *font,
pp[n[idx]].y = y - bitmap.top + i;
if (++(n[idx]) == size)
{
- XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
idx == 6 ? gc_fore : gcs[idx], pp, size,
CoordModeOrigin);
n[idx] = 0;
@@ -180,10 +180,10 @@ ftxfont_draw_bitmap (struct frame *f, GC gc_fore, GC *gcs, struct font *font,
{
for (i = 0; i < 6; i++)
if (n[i] > 0)
- XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
gcs[i], p + 0x100 * i, n[i], CoordModeOrigin);
if (n[6] > 0)
- XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
gc_fore, p + 0x600, n[6], CoordModeOrigin);
}
}
@@ -203,7 +203,7 @@ ftxfont_draw_background (struct frame *f, struct font *font, GC gc, int x, int y
XGetGCValues (FRAME_X_DISPLAY (f), gc,
GCForeground | GCBackground, &xgcv);
XSetForeground (FRAME_X_DISPLAY (f), gc, xgcv.background);
- XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc,
+ XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), gc,
x, y - FONT_BASE (font), width, FONT_HEIGHT (font));
XSetForeground (FRAME_X_DISPLAY (f), gc, xgcv.foreground);
}
diff --git a/src/gmalloc.c b/src/gmalloc.c
index fb2861c18ac..3f7bbda84ab 100644
--- a/src/gmalloc.c
+++ b/src/gmalloc.c
@@ -25,14 +25,11 @@ License along with this library. If not, see <http://www.gnu.org/licenses/>.
#define USE_PTHREAD
#endif
+#include <stddef.h>
+#include <stdlib.h>
#include <string.h>
#include <limits.h>
#include <stdint.h>
-
-#ifdef HYBRID_GET_CURRENT_DIR_NAME
-#undef get_current_dir_name
-#endif
-
#include <unistd.h>
#ifdef USE_PTHREAD
@@ -40,7 +37,22 @@ License along with this library. If not, see <http://www.gnu.org/licenses/>.
#endif
#ifdef emacs
-extern _Noreturn void emacs_abort (void) NO_INLINE;
+# include "lisp.h"
+#endif
+
+#ifdef HAVE_MALLOC_H
+# if GNUC_PREREQ (4, 2, 0)
+# pragma GCC diagnostic ignored "-Wdeprecated-declarations"
+# endif
+# include <malloc.h>
+#endif
+#ifndef __MALLOC_HOOK_VOLATILE
+# define __MALLOC_HOOK_VOLATILE volatile
+#endif
+#ifndef HAVE_MALLOC_H
+extern void (*__MALLOC_HOOK_VOLATILE __after_morecore_hook) (void);
+extern void (*__MALLOC_HOOK_VOLATILE __malloc_initialize_hook) (void);
+extern void *(*__morecore) (ptrdiff_t);
#endif
/* If HYBRID_MALLOC is defined, then temacs will use malloc,
@@ -49,13 +61,7 @@ extern _Noreturn void emacs_abort (void) NO_INLINE;
however, will use the system malloc, realloc.... In other source
files, malloc, realloc... are renamed hybrid_malloc,
hybrid_realloc... via macros in conf_post.h. hybrid_malloc and
- friends are wrapper functions defined later in this file.
- aligned_alloc is defined as a macro only in alloc.c.
-
- As of this writing (August 2014), Cygwin is the only platform on
- which HYBRID_MACRO is defined. Any other platform that wants to
- define it will have to define the macros DUMPED and
- ALLOCATED_BEFORE_DUMPING, defined below for Cygwin. */
+ friends are wrapper functions defined later in this file. */
#undef malloc
#undef realloc
#undef calloc
@@ -66,15 +72,16 @@ extern _Noreturn void emacs_abort (void) NO_INLINE;
#define calloc gcalloc
#define aligned_alloc galigned_alloc
#define free gfree
+#define malloc_info gmalloc_info
-#ifdef CYGWIN
-extern void *bss_sbrk (ptrdiff_t size);
-extern int bss_sbrk_did_unexec;
-extern char bss_sbrk_buffer[];
-extern void *bss_sbrk_buffer_end;
-#define DUMPED bss_sbrk_did_unexec
-#define ALLOCATED_BEFORE_DUMPING(P) \
- ((P) < bss_sbrk_buffer_end && (P) >= (void *) bss_sbrk_buffer)
+#ifdef HYBRID_MALLOC
+# include "sheap.h"
+# define DUMPED bss_sbrk_did_unexec
+static bool
+ALLOCATED_BEFORE_DUMPING (char *p)
+{
+ return bss_sbrk_buffer <= p && p < bss_sbrk_buffer + STATIC_HEAP_SIZE;
+}
#endif
#ifdef __cplusplus
@@ -82,8 +89,9 @@ extern "C"
{
#endif
-#include <stddef.h>
-
+#ifdef HYBRID_MALLOC
+#define extern static
+#endif
/* Allocate SIZE bytes of memory. */
extern void *malloc (size_t size) ATTRIBUTE_MALLOC_SIZE ((1));
@@ -92,34 +100,28 @@ extern void *malloc (size_t size) ATTRIBUTE_MALLOC_SIZE ((1));
extern void *realloc (void *ptr, size_t size) ATTRIBUTE_ALLOC_SIZE ((2));
/* Allocate NMEMB elements of SIZE bytes each, all initialized to 0. */
extern void *calloc (size_t nmemb, size_t size) ATTRIBUTE_MALLOC_SIZE ((1,2));
-/* Free a block allocated by `malloc', `realloc' or `calloc'. */
+/* Free a block. */
extern void free (void *ptr);
/* Allocate SIZE bytes allocated to ALIGNMENT bytes. */
extern void *aligned_alloc (size_t, size_t);
-extern void *memalign (size_t, size_t);
#ifdef MSDOS
+extern void *memalign (size_t, size_t);
extern int posix_memalign (void **, size_t, size_t);
#endif
-#ifdef USE_PTHREAD
-/* Set up mutexes and make malloc etc. thread-safe. */
-extern void malloc_enable_thread (void);
-#endif
-
/* The allocator divides the heap into blocks of fixed size; large
requests receive one or more whole blocks, and small requests
receive a fragment of a block. Fragment sizes are powers of two,
and all fragments of a block are the same size. When all the
fragments in a block have been freed, the block itself is freed. */
-#define INT_BIT (CHAR_BIT * sizeof (int))
-#define BLOCKLOG (INT_BIT > 16 ? 12 : 9)
+#define BLOCKLOG (INT_WIDTH > 16 ? 12 : 9)
#define BLOCKSIZE (1 << BLOCKLOG)
#define BLOCKIFY(SIZE) (((SIZE) + BLOCKSIZE - 1) / BLOCKSIZE)
/* Determine the amount of memory spanned by the initial heap table
(not an absolute limit). */
-#define HEAP (INT_BIT > 16 ? 4194304 : 65536)
+#define HEAP (INT_WIDTH > 16 ? 4194304 : 65536)
/* Number of contiguous free blocks allowed to build up at the end of
memory before they will be returned to the system. */
@@ -238,36 +240,12 @@ extern int _malloc_thread_enabled_p;
#define UNLOCK_ALIGNED_BLOCKS()
#endif
-/* Given an address in the middle of a malloc'd object,
- return the address of the beginning of the object. */
-extern void *malloc_find_object_address (void *ptr);
-
-/* Underlying allocation function; successive calls should
- return contiguous pieces of memory. */
-extern void *(*__morecore) (ptrdiff_t size);
-
-/* Default value of `__morecore'. */
-extern void *__default_morecore (ptrdiff_t size);
-
-/* If not NULL, this function is called after each time
- `__morecore' is called to increase the data size. */
-extern void (*__after_morecore_hook) (void);
-
-/* Number of extra blocks to get each time we ask for more core.
- This reduces the frequency of calling `(*__morecore)'. */
-extern size_t __malloc_extra_blocks;
-
/* Nonzero if `malloc' has been called and done its initialization. */
extern int __malloc_initialized;
/* Function called to initialize malloc data structures. */
extern int __malloc_initialize (void);
-/* Hooks for debugging versions. */
-extern void (*__malloc_initialize_hook) (void);
-extern void (*__free_hook) (void *ptr);
-extern void *(*__malloc_hook) (size_t size);
-extern void *(*__realloc_hook) (void *ptr, size_t size);
-extern void *(*__memalign_hook) (size_t size, size_t alignment);
+#ifdef GC_MCHECK
/* Return values for `mprobe': these are the kinds of inconsistencies that
`mcheck' enables detection of. */
@@ -308,8 +286,9 @@ struct mstats
/* Pick up the current statistics. */
extern struct mstats mstats (void);
-/* Call WARNFUN with a warning message when memory usage is high. */
-extern void memory_warnings (void *start, void (*warnfun) (const char *));
+#endif
+
+#undef extern
#ifdef __cplusplus
}
@@ -337,10 +316,17 @@ License along with this library. If not, see <http://www.gnu.org/licenses/>.
#include <errno.h>
-void *(*__morecore) (ptrdiff_t size) = __default_morecore;
+/* Debugging hook for 'malloc'. */
+static void *(*__MALLOC_HOOK_VOLATILE gmalloc_hook) (size_t);
-/* Debugging hook for `malloc'. */
-void *(*__malloc_hook) (size_t size);
+/* Replacements for traditional glibc malloc hooks, for platforms that
+ do not already have these hooks. Platforms with these hooks all
+ used relaxed ref/def, so it is OK to define them here too. */
+void (*__MALLOC_HOOK_VOLATILE __malloc_initialize_hook) (void);
+void (*__MALLOC_HOOK_VOLATILE __after_morecore_hook) (void);
+void *(*__morecore) (ptrdiff_t);
+
+#ifndef HYBRID_MALLOC
/* Pointer to the base of the first block. */
char *_heapbase;
@@ -348,9 +334,6 @@ char *_heapbase;
/* Block information table. Allocated with align/__free (not malloc/free). */
malloc_info *_heapinfo;
-/* Number of info entries. */
-static size_t heapsize;
-
/* Search index in the info table. */
size_t _heapindex;
@@ -369,10 +352,21 @@ size_t _bytes_free;
/* Are you experienced? */
int __malloc_initialized;
+#else
+
+static struct list _fraghead[BLOCKLOG];
+
+#endif /* HYBRID_MALLOC */
+
+/* Number of extra blocks to get each time we ask for more core.
+ This reduces the frequency of calling `(*__morecore)'. */
+#if defined DOUG_LEA_MALLOC || defined HYBRID_MALLOC || defined SYSTEM_MALLOC
+static
+#endif
size_t __malloc_extra_blocks;
-void (*__malloc_initialize_hook) (void);
-void (*__after_morecore_hook) (void);
+/* Number of info entries. */
+static size_t heapsize;
#if defined GC_MALLOC_CHECK && defined GC_PROTECT_MALLOC_STATE
@@ -927,19 +921,19 @@ malloc (size_t size)
if (!__malloc_initialized && !__malloc_initialize ())
return NULL;
- /* Copy the value of __malloc_hook to an automatic variable in case
- __malloc_hook is modified in another thread between its
+ /* Copy the value of gmalloc_hook to an automatic variable in case
+ gmalloc_hook is modified in another thread between its
NULL-check and the use.
Note: Strictly speaking, this is not a right solution. We should
use mutexes to access non-read-only variables that are shared
among multiple threads. We just leave it for compatibility with
- glibc malloc (i.e., assignments to __malloc_hook) for now. */
- hook = __malloc_hook;
+ glibc malloc (i.e., assignments to gmalloc_hook) for now. */
+ hook = gmalloc_hook;
return (hook != NULL ? *hook : _malloc_internal) (size);
}
-#ifndef _LIBC
+#if !(defined (_LIBC) || defined (HYBRID_MALLOC))
/* On some ANSI C systems, some libc functions call _malloc, _free
and _realloc. Make them use the GNU functions. */
@@ -987,12 +981,14 @@ License along with this library. If not, see <http://www.gnu.org/licenses/>.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
-
/* Debugging hook for free. */
-void (*__free_hook) (void *__ptr);
+static void (*__MALLOC_HOOK_VOLATILE gfree_hook) (void *);
+
+#ifndef HYBRID_MALLOC
/* List of blocks allocated by aligned_alloc. */
struct alignlist *_aligned_blocks = NULL;
+#endif
/* Return memory to the heap.
Like `_free_internal' but don't lock mutex. */
@@ -1241,7 +1237,7 @@ _free_internal_nolock (void *ptr)
}
/* Return memory to the heap.
- Like `free' but don't call a __free_hook if there is one. */
+ Like 'free' but don't call a hook if there is one. */
void
_free_internal (void *ptr)
{
@@ -1255,7 +1251,7 @@ _free_internal (void *ptr)
void
free (void *ptr)
{
- void (*hook) (void *) = __free_hook;
+ void (*hook) (void *) = gfree_hook;
if (hook != NULL)
(*hook) (ptr);
@@ -1263,6 +1259,7 @@ free (void *ptr)
_free_internal (ptr);
}
+#ifndef HYBRID_MALLOC
/* Define the `cfree' alias for `free'. */
#ifdef weak_alias
weak_alias (free, cfree)
@@ -1273,6 +1270,7 @@ cfree (void *ptr)
free (ptr);
}
#endif
+#endif
/* Change the size of a block allocated by `malloc'.
Copyright 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
Written May 1989 by Mike Haertel.
@@ -1298,7 +1296,7 @@ License along with this library. If not, see <http://www.gnu.org/licenses/>.
#endif
/* Debugging hook for realloc. */
-void *(*__realloc_hook) (void *ptr, size_t size);
+static void *(*grealloc_hook) (void *, size_t);
/* Resize the given region to the new size, returning a pointer
to the (possibly moved) region. This is optimized for speed;
@@ -1442,7 +1440,7 @@ realloc (void *ptr, size_t size)
if (!__malloc_initialized && !__malloc_initialize ())
return NULL;
- hook = __realloc_hook;
+ hook = grealloc_hook;
return (hook != NULL ? *hook : _realloc_internal) (ptr, size);
}
/* Copyright (C) 1991, 1992, 1994 Free Software Foundation, Inc.
@@ -1512,11 +1510,11 @@ extern void *__sbrk (ptrdiff_t increment);
/* Allocate INCREMENT more bytes of data space,
and return the start of data space, or NULL on errors.
If INCREMENT is negative, shrink data space. */
-void *
-__default_morecore (ptrdiff_t increment)
+static void *
+gdefault_morecore (ptrdiff_t increment)
{
void *result;
-#if defined (CYGWIN)
+#ifdef HYBRID_MALLOC
if (!DUMPED)
{
return bss_sbrk (increment);
@@ -1527,6 +1525,9 @@ __default_morecore (ptrdiff_t increment)
return NULL;
return result;
}
+
+void *(*__morecore) (ptrdiff_t) = gdefault_morecore;
+
/* Copyright (C) 1991, 92, 93, 94, 95, 96 Free Software Foundation, Inc.
This library is free software; you can redistribute it and/or
@@ -1542,17 +1543,11 @@ General Public License for more details.
You should have received a copy of the GNU General Public
License along with this library. If not, see <http://www.gnu.org/licenses/>. */
-void *(*__memalign_hook) (size_t size, size_t alignment);
-
void *
aligned_alloc (size_t alignment, size_t size)
{
void *result;
size_t adj, lastadj;
- void *(*hook) (size_t, size_t) = __memalign_hook;
-
- if (hook)
- return (*hook) (alignment, size);
/* Allocate a block with enough extra space to pad the block with up to
(ALIGNMENT - 1) bytes if necessary. */
@@ -1631,6 +1626,8 @@ aligned_alloc (size_t alignment, size_t size)
return result;
}
+/* Note that memalign and posix_memalign are not used in Emacs. */
+#ifndef HYBRID_MALLOC
/* An obsolete alias for aligned_alloc, for any old libraries that use
this alias. */
@@ -1642,7 +1639,6 @@ memalign (size_t alignment, size_t size)
/* If HYBRID_MALLOC is defined, we may want to use the system
posix_memalign below. */
-#ifndef HYBRID_MALLOC
int
posix_memalign (void **memptr, size_t alignment, size_t size)
{
@@ -1682,16 +1678,18 @@ License along with this library. If not, see <http://www.gnu.org/licenses/>.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
+#ifndef HYBRID_MALLOC
+
+# ifndef HAVE_MALLOC_H
/* Allocate SIZE bytes on a page boundary. */
-#ifndef HAVE_DECL_VALLOC
extern void *valloc (size_t);
-#endif
+# endif
-#if defined _SC_PAGESIZE || !defined HAVE_GETPAGESIZE
-# include "getpagesize.h"
-#elif !defined getpagesize
+# if defined _SC_PAGESIZE || !defined HAVE_GETPAGESIZE
+# include "getpagesize.h"
+# elif !defined getpagesize
extern int getpagesize (void);
-#endif
+# endif
static size_t pagesize;
@@ -1703,6 +1701,7 @@ valloc (size_t size)
return aligned_alloc (pagesize, size);
}
+#endif /* HYBRID_MALLOC */
#undef malloc
#undef realloc
@@ -1796,19 +1795,6 @@ hybrid_realloc (void *ptr, size_t size)
return result;
}
-#ifdef HYBRID_GET_CURRENT_DIR_NAME
-/* Defined in sysdep.c. */
-char *gget_current_dir_name (void);
-
-char *
-hybrid_get_current_dir_name (void)
-{
- if (DUMPED)
- return get_current_dir_name ();
- return gget_current_dir_name ();
-}
-#endif
-
#else /* ! HYBRID_MALLOC */
void *
@@ -1943,9 +1929,9 @@ freehook (void *ptr)
else
hdr = NULL;
- __free_hook = old_free_hook;
+ gfree_hook = old_free_hook;
free (hdr);
- __free_hook = freehook;
+ gfree_hook = freehook;
}
static void *
@@ -1953,9 +1939,9 @@ mallochook (size_t size)
{
struct hdr *hdr;
- __malloc_hook = old_malloc_hook;
+ gmalloc_hook = old_malloc_hook;
hdr = malloc (sizeof *hdr + size + 1);
- __malloc_hook = mallochook;
+ gmalloc_hook = mallochook;
if (hdr == NULL)
return NULL;
@@ -1981,13 +1967,13 @@ reallochook (void *ptr, size_t size)
memset ((char *) ptr + size, FREEFLOOD, osize - size);
}
- __free_hook = old_free_hook;
- __malloc_hook = old_malloc_hook;
- __realloc_hook = old_realloc_hook;
+ gfree_hook = old_free_hook;
+ gmalloc_hook = old_malloc_hook;
+ grealloc_hook = old_realloc_hook;
hdr = realloc (hdr, sizeof *hdr + size + 1);
- __free_hook = freehook;
- __malloc_hook = mallochook;
- __realloc_hook = reallochook;
+ gfree_hook = freehook;
+ gmalloc_hook = mallochook;
+ grealloc_hook = reallochook;
if (hdr == NULL)
return NULL;
@@ -2044,12 +2030,12 @@ mcheck (void (*func) (enum mcheck_status))
/* These hooks may not be safely inserted if malloc is already in use. */
if (!__malloc_initialized && !mcheck_used)
{
- old_free_hook = __free_hook;
- __free_hook = freehook;
- old_malloc_hook = __malloc_hook;
- __malloc_hook = mallochook;
- old_realloc_hook = __realloc_hook;
- __realloc_hook = reallochook;
+ old_free_hook = gfree_hook;
+ gfree_hook = freehook;
+ old_malloc_hook = gmalloc_hook;
+ gmalloc_hook = mallochook;
+ old_realloc_hook = grealloc_hook;
+ grealloc_hook = reallochook;
mcheck_used = 1;
}
diff --git a/src/gnutls.c b/src/gnutls.c
index f0354d7fedf..af2ba52870c 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -26,7 +26,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "coding.h"
#ifdef HAVE_GNUTLS
-#include <gnutls/gnutls.h>
#ifdef WINDOWSNT
#include <windows.h>
@@ -55,7 +54,6 @@ DEF_DLL_FN (gnutls_alert_description_t, gnutls_alert_get,
(gnutls_session_t));
DEF_DLL_FN (const char *, gnutls_alert_get_name,
(gnutls_alert_description_t));
-DEF_DLL_FN (int, gnutls_alert_send_appropriate, (gnutls_session_t, int));
DEF_DLL_FN (int, gnutls_anon_allocate_client_credentials,
(gnutls_anon_client_credentials_t *));
DEF_DLL_FN (void, gnutls_anon_free_client_credentials,
@@ -111,8 +109,6 @@ DEF_DLL_FN (ssize_t, gnutls_record_send,
(gnutls_session_t, const void *, size_t));
DEF_DLL_FN (const char *, gnutls_strerror, (int));
DEF_DLL_FN (void, gnutls_transport_set_errno, (gnutls_session_t, int));
-DEF_DLL_FN (const char *, gnutls_check_version, (const char *));
-DEF_DLL_FN (void, gnutls_transport_set_lowat, (gnutls_session_t, int));
DEF_DLL_FN (void, gnutls_transport_set_ptr2,
(gnutls_session_t, gnutls_transport_ptr_t,
gnutls_transport_ptr_t));
@@ -156,8 +152,6 @@ DEF_DLL_FN (int, gnutls_x509_crt_get_subject_unique_id,
(gnutls_x509_crt_t, char *, size_t *));
DEF_DLL_FN (int, gnutls_x509_crt_get_signature_algorithm,
(gnutls_x509_crt_t));
-DEF_DLL_FN (int, gnutls_x509_crt_get_signature,
- (gnutls_x509_crt_t, char *, size_t *));
DEF_DLL_FN (int, gnutls_x509_crt_get_key_id,
(gnutls_x509_crt_t, unsigned int, unsigned char *, size_t *_size));
DEF_DLL_FN (const char*, gnutls_sec_param_get_name, (gnutls_sec_param_t));
@@ -184,7 +178,7 @@ init_gnutls_functions (void)
HMODULE library;
int max_log_level = 1;
- if (!(library = w32_delayed_load (Qgnutls_dll)))
+ if (!(library = w32_delayed_load (Qgnutls)))
{
GNUTLS_LOG (1, max_log_level, "GnuTLS library not found");
return 0;
@@ -192,7 +186,6 @@ init_gnutls_functions (void)
LOAD_DLL_FN (library, gnutls_alert_get);
LOAD_DLL_FN (library, gnutls_alert_get_name);
- LOAD_DLL_FN (library, gnutls_alert_send_appropriate);
LOAD_DLL_FN (library, gnutls_anon_allocate_client_credentials);
LOAD_DLL_FN (library, gnutls_anon_free_client_credentials);
LOAD_DLL_FN (library, gnutls_bye);
@@ -229,11 +222,6 @@ init_gnutls_functions (void)
LOAD_DLL_FN (library, gnutls_record_send);
LOAD_DLL_FN (library, gnutls_strerror);
LOAD_DLL_FN (library, gnutls_transport_set_errno);
- LOAD_DLL_FN (library, gnutls_check_version);
- /* We don't need to call gnutls_transport_set_lowat in GnuTLS 2.11.1
- and later, and the function was removed entirely in 3.0.0. */
- if (!fn_gnutls_check_version ("2.11.1"))
- LOAD_DLL_FN (library, gnutls_transport_set_lowat);
LOAD_DLL_FN (library, gnutls_transport_set_ptr2);
LOAD_DLL_FN (library, gnutls_transport_set_pull_function);
LOAD_DLL_FN (library, gnutls_transport_set_push_function);
@@ -255,7 +243,6 @@ init_gnutls_functions (void)
LOAD_DLL_FN (library, gnutls_x509_crt_get_issuer_unique_id);
LOAD_DLL_FN (library, gnutls_x509_crt_get_subject_unique_id);
LOAD_DLL_FN (library, gnutls_x509_crt_get_signature_algorithm);
- LOAD_DLL_FN (library, gnutls_x509_crt_get_signature);
LOAD_DLL_FN (library, gnutls_x509_crt_get_key_id);
LOAD_DLL_FN (library, gnutls_sec_param_get_name);
LOAD_DLL_FN (library, gnutls_sign_get_name);
@@ -272,7 +259,7 @@ init_gnutls_functions (void)
max_log_level = global_gnutls_log_level;
{
- Lisp_Object name = CAR_SAFE (Fget (Qgnutls_dll, QCloaded_from));
+ Lisp_Object name = CAR_SAFE (Fget (Qgnutls, QCloaded_from));
GNUTLS_LOG2 (1, max_log_level, "GnuTLS library loaded:",
STRINGP (name) ? (const char *) SDATA (name) : "unknown");
}
@@ -282,7 +269,6 @@ init_gnutls_functions (void)
# define gnutls_alert_get fn_gnutls_alert_get
# define gnutls_alert_get_name fn_gnutls_alert_get_name
-# define gnutls_alert_send_appropriate fn_gnutls_alert_send_appropriate
# define gnutls_anon_allocate_client_credentials fn_gnutls_anon_allocate_client_credentials
# define gnutls_anon_free_client_credentials fn_gnutls_anon_free_client_credentials
# define gnutls_bye fn_gnutls_bye
@@ -296,7 +282,6 @@ init_gnutls_functions (void)
# define gnutls_certificate_set_x509_trust_file fn_gnutls_certificate_set_x509_trust_file
# define gnutls_certificate_type_get fn_gnutls_certificate_type_get
# define gnutls_certificate_verify_peers2 fn_gnutls_certificate_verify_peers2
-# define gnutls_check_version fn_gnutls_check_version
# define gnutls_cipher_get fn_gnutls_cipher_get
# define gnutls_cipher_get_name fn_gnutls_cipher_get_name
# define gnutls_credentials_set fn_gnutls_credentials_set
@@ -327,7 +312,6 @@ init_gnutls_functions (void)
# define gnutls_sign_get_name fn_gnutls_sign_get_name
# define gnutls_strerror fn_gnutls_strerror
# define gnutls_transport_set_errno fn_gnutls_transport_set_errno
-# define gnutls_transport_set_lowat fn_gnutls_transport_set_lowat
# define gnutls_transport_set_ptr2 fn_gnutls_transport_set_ptr2
# define gnutls_transport_set_pull_function fn_gnutls_transport_set_pull_function
# define gnutls_transport_set_push_function fn_gnutls_transport_set_push_function
@@ -343,7 +327,6 @@ init_gnutls_functions (void)
# define gnutls_x509_crt_get_key_id fn_gnutls_x509_crt_get_key_id
# define gnutls_x509_crt_get_pk_algorithm fn_gnutls_x509_crt_get_pk_algorithm
# define gnutls_x509_crt_get_serial fn_gnutls_x509_crt_get_serial
-# define gnutls_x509_crt_get_signature fn_gnutls_x509_crt_get_signature
# define gnutls_x509_crt_get_signature_algorithm fn_gnutls_x509_crt_get_signature_algorithm
# define gnutls_x509_crt_get_subject_unique_id fn_gnutls_x509_crt_get_subject_unique_id
# define gnutls_x509_crt_get_version fn_gnutls_x509_crt_get_version
@@ -390,18 +373,72 @@ gnutls_log_function2 (int level, const char *string, const char *extra)
message ("gnutls.c: [%d] %s %s", level, string, extra);
}
-/* Log a message and an integer. */
-static void
-gnutls_log_function2i (int level, const char *string, int extra)
+int
+gnutls_try_handshake (struct Lisp_Process *proc)
{
- message ("gnutls.c: [%d] %s %d", level, string, extra);
+ gnutls_session_t state = proc->gnutls_state;
+ int ret;
+ bool non_blocking = proc->is_non_blocking_client;
+
+ if (proc->gnutls_complete_negotiation_p)
+ non_blocking = false;
+
+ if (non_blocking)
+ proc->gnutls_p = true;
+
+ do
+ {
+ ret = gnutls_handshake (state);
+ emacs_gnutls_handle_error (state, ret);
+ QUIT;
+ }
+ while (ret < 0
+ && gnutls_error_is_fatal (ret) == 0
+ && ! non_blocking);
+
+ proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED;
+
+ if (ret == GNUTLS_E_SUCCESS)
+ {
+ /* Here we're finally done. */
+ proc->gnutls_initstage = GNUTLS_STAGE_READY;
+ }
+ else
+ {
+ /* check_memory_full (gnutls_alert_send_appropriate (state, ret)); */
+ }
+ return ret;
}
+#ifndef WINDOWSNT
+static int
+emacs_gnutls_nonblock_errno (gnutls_transport_ptr_t ptr)
+{
+ int err = errno;
+
+ switch (err)
+ {
+# ifdef _AIX
+ /* This is taken from the GnuTLS system_errno function circa 2016;
+ see <http://savannah.gnu.org/support/?107464>. */
+ case 0:
+ errno = EAGAIN;
+ /* Fall through. */
+# endif
+ case EINPROGRESS:
+ case ENOTCONN:
+ return EAGAIN;
+
+ default:
+ return err;
+ }
+}
+#endif
+
static int
emacs_gnutls_handshake (struct Lisp_Process *proc)
{
gnutls_session_t state = proc->gnutls_state;
- int ret;
if (proc->gnutls_initstage < GNUTLS_STAGE_HANDSHAKE_CANDO)
return -1;
@@ -417,20 +454,6 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
(gnutls_transport_ptr_t) proc);
gnutls_transport_set_push_function (state, &emacs_gnutls_push);
gnutls_transport_set_pull_function (state, &emacs_gnutls_pull);
-
- /* For non blocking sockets or other custom made pull/push
- functions the gnutls_transport_set_lowat must be called, with
- a zero low water mark value. (GnuTLS 2.10.4 documentation)
-
- (Note: this is probably not strictly necessary as the lowat
- value is only used when no custom pull/push functions are
- set.) */
- /* According to GnuTLS NEWS file, lowat level has been set to
- zero by default in version 2.11.1, and the function
- gnutls_transport_set_lowat was removed from the library in
- version 2.99.0. */
- if (!gnutls_check_version ("2.11.1"))
- gnutls_transport_set_lowat (state, 0);
#else
/* This is how GnuTLS takes sockets: as file descriptors passed
in. For an Emacs process socket, infd and outfd are the
@@ -438,31 +461,15 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
gnutls_transport_set_ptr2 (state,
(void *) (intptr_t) proc->infd,
(void *) (intptr_t) proc->outfd);
+ if (proc->is_non_blocking_client)
+ gnutls_transport_set_errno_function (state,
+ emacs_gnutls_nonblock_errno);
#endif
proc->gnutls_initstage = GNUTLS_STAGE_TRANSPORT_POINTERS_SET;
}
- do
- {
- ret = gnutls_handshake (state);
- emacs_gnutls_handle_error (state, ret);
- QUIT;
- }
- while (ret < 0 && gnutls_error_is_fatal (ret) == 0);
-
- proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED;
-
- if (ret == GNUTLS_E_SUCCESS)
- {
- /* Here we're finally done. */
- proc->gnutls_initstage = GNUTLS_STAGE_READY;
- }
- else
- {
- check_memory_full (gnutls_alert_send_appropriate (state, ret));
- }
- return ret;
+ return gnutls_try_handshake (proc);
}
ptrdiff_t
@@ -528,26 +535,12 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte)
ssize_t rtnval;
gnutls_session_t state = proc->gnutls_state;
- int log_level = proc->gnutls_log_level;
-
if (proc->gnutls_initstage != GNUTLS_STAGE_READY)
{
- /* If the handshake count is under the limit, try the handshake
- again and increment the handshake count. This count is kept
- per process (connection), not globally. */
- if (proc->gnutls_handshakes_tried < GNUTLS_EMACS_HANDSHAKES_LIMIT)
- {
- proc->gnutls_handshakes_tried++;
- emacs_gnutls_handshake (proc);
- GNUTLS_LOG2i (5, log_level, "Retried handshake",
- proc->gnutls_handshakes_tried);
- return -1;
- }
-
- GNUTLS_LOG (2, log_level, "Giving up on handshake; resetting retries");
- proc->gnutls_handshakes_tried = 0;
- return 0;
+ errno = EAGAIN;
+ return -1;
}
+
rtnval = gnutls_record_recv (state, buf, nbyte);
if (rtnval >= 0)
return rtnval;
@@ -655,7 +648,7 @@ emacs_gnutls_deinit (Lisp_Object proc)
CHECK_PROCESS (proc);
- if (XPROCESS (proc)->gnutls_p == 0)
+ if (! XPROCESS (proc)->gnutls_p)
return Qnil;
log_level = XPROCESS (proc)->gnutls_log_level;
@@ -682,10 +675,23 @@ emacs_gnutls_deinit (Lisp_Object proc)
GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1;
}
- XPROCESS (proc)->gnutls_p = 0;
+ XPROCESS (proc)->gnutls_p = false;
return Qt;
}
+DEFUN ("gnutls-asynchronous-parameters", Fgnutls_asynchronous_parameters,
+ Sgnutls_asynchronous_parameters, 2, 2, 0,
+ doc: /* Mark this process as being a pre-init GnuTLS process.
+The second parameter is the list of parameters to feed to gnutls-boot
+to finish setting up the connection. */)
+ (Lisp_Object proc, Lisp_Object params)
+{
+ CHECK_PROCESS (proc);
+
+ XPROCESS (proc)->gnutls_boot_parameters = params;
+ return Qnil;
+}
+
DEFUN ("gnutls-get-initstage", Fgnutls_get_initstage, Sgnutls_get_initstage, 1, 1, 0,
doc: /* Return the GnuTLS init stage of process PROC.
See also `gnutls-boot'. */)
@@ -703,7 +709,9 @@ usage: (gnutls-errorp ERROR) */
attributes: const)
(Lisp_Object err)
{
- if (EQ (err, Qt)) return Qnil;
+ if (EQ (err, Qt)
+ || EQ (err, Qgnutls_e_again))
+ return Qnil;
return Qt;
}
@@ -874,8 +882,6 @@ gnutls_certificate_details (gnutls_x509_crt_t cert)
xfree (dn);
}
- /* Versions older than 2.11 doesn't have these four functions. */
-#if GNUTLS_VERSION_NUMBER >= 0x020b00
/* SubjectPublicKeyInfo. */
{
unsigned int bits;
@@ -924,7 +930,6 @@ gnutls_certificate_details (gnutls_x509_crt_t cert)
make_string (buf, buf_size)));
xfree (buf);
}
-#endif
/* Signature. */
err = gnutls_x509_crt_get_signature_algorithm (cert);
@@ -1022,7 +1027,7 @@ The return value is a property list with top-level keys :warnings and
CHECK_PROCESS (proc);
- if (GNUTLS_INITSTAGE (proc) < GNUTLS_STAGE_INIT)
+ if (GNUTLS_INITSTAGE (proc) != GNUTLS_STAGE_READY)
return Qnil;
/* Then collect any warnings already computed by the handshake. */
@@ -1154,6 +1159,160 @@ emacs_gnutls_global_deinit (void)
}
#endif
+static void ATTRIBUTE_FORMAT_PRINTF (2, 3)
+boot_error (struct Lisp_Process *p, const char *m, ...)
+{
+ va_list ap;
+ va_start (ap, m);
+ if (p->is_non_blocking_client)
+ pset_status (p, list2 (Qfailed, vformat_string (m, ap)));
+ else
+ verror (m, ap);
+ va_end (ap);
+}
+
+Lisp_Object
+gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist)
+{
+ int ret;
+ struct Lisp_Process *p = XPROCESS (proc);
+ gnutls_session_t state = p->gnutls_state;
+ unsigned int peer_verification;
+ Lisp_Object warnings;
+ int max_log_level = p->gnutls_log_level;
+ Lisp_Object hostname, verify_error;
+ bool verify_error_all = false;
+ char *c_hostname;
+
+ if (NILP (proplist))
+ proplist = Fcdr (Fplist_get (p->childp, QCtls_parameters));
+
+ verify_error = Fplist_get (proplist, QCverify_error);
+ hostname = Fplist_get (proplist, QChostname);
+
+ if (EQ (verify_error, Qt))
+ verify_error_all = true;
+ else if (NILP (Flistp (verify_error)))
+ {
+ boot_error (p,
+ "gnutls-boot: invalid :verify_error parameter (not a list)");
+ return Qnil;
+ }
+
+ if (!STRINGP (hostname))
+ {
+ boot_error (p, "gnutls-boot: invalid :hostname parameter (not a string)");
+ return Qnil;
+ }
+ c_hostname = SSDATA (hostname);
+
+ /* Now verify the peer, following
+ http://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html.
+ The peer should present at least one certificate in the chain; do a
+ check of the certificate's hostname with
+ gnutls_x509_crt_check_hostname against :hostname. */
+
+ ret = gnutls_certificate_verify_peers2 (state, &peer_verification);
+ if (ret < GNUTLS_E_SUCCESS)
+ return gnutls_make_error (ret);
+
+ XPROCESS (proc)->gnutls_peer_verification = peer_verification;
+
+ warnings = Fplist_get (Fgnutls_peer_status (proc), intern (":warnings"));
+ if (!NILP (warnings))
+ {
+ for (Lisp_Object tail = warnings; CONSP (tail); tail = XCDR (tail))
+ {
+ Lisp_Object warning = XCAR (tail);
+ Lisp_Object message = Fgnutls_peer_status_warning_describe (warning);
+ if (!NILP (message))
+ GNUTLS_LOG2 (1, max_log_level, "verification:", SSDATA (message));
+ }
+ }
+
+ if (peer_verification != 0)
+ {
+ if (verify_error_all
+ || !NILP (Fmember (QCtrustfiles, verify_error)))
+ {
+ emacs_gnutls_deinit (proc);
+ boot_error (p,
+ "Certificate validation failed %s, verification code %x",
+ c_hostname, peer_verification);
+ return Qnil;
+ }
+ else
+ {
+ GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:",
+ c_hostname);
+ }
+ }
+
+ /* Up to here the process is the same for X.509 certificates and
+ OpenPGP keys. From now on X.509 certificates are assumed. This
+ can be easily extended to work with openpgp keys as well. */
+ if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
+ {
+ gnutls_x509_crt_t gnutls_verify_cert;
+ const gnutls_datum_t *gnutls_verify_cert_list;
+ unsigned int gnutls_verify_cert_list_size;
+
+ ret = gnutls_x509_crt_init (&gnutls_verify_cert);
+ if (ret < GNUTLS_E_SUCCESS)
+ return gnutls_make_error (ret);
+
+ gnutls_verify_cert_list
+ = gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
+
+ if (gnutls_verify_cert_list == NULL)
+ {
+ gnutls_x509_crt_deinit (gnutls_verify_cert);
+ emacs_gnutls_deinit (proc);
+ boot_error (p, "No x509 certificate was found\n");
+ return Qnil;
+ }
+
+ /* Check only the first certificate in the given chain. */
+ ret = gnutls_x509_crt_import (gnutls_verify_cert,
+ &gnutls_verify_cert_list[0],
+ GNUTLS_X509_FMT_DER);
+
+ if (ret < GNUTLS_E_SUCCESS)
+ {
+ gnutls_x509_crt_deinit (gnutls_verify_cert);
+ return gnutls_make_error (ret);
+ }
+
+ XPROCESS (proc)->gnutls_certificate = gnutls_verify_cert;
+
+ int err = gnutls_x509_crt_check_hostname (gnutls_verify_cert,
+ c_hostname);
+ check_memory_full (err);
+ if (!err)
+ {
+ XPROCESS (proc)->gnutls_extra_peer_verification
+ |= CERTIFICATE_NOT_MATCHING;
+ if (verify_error_all
+ || !NILP (Fmember (QChostname, verify_error)))
+ {
+ gnutls_x509_crt_deinit (gnutls_verify_cert);
+ emacs_gnutls_deinit (proc);
+ boot_error (p, "The x509 certificate does not match \"%s\"",
+ c_hostname);
+ return Qnil;
+ }
+ else
+ GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:",
+ c_hostname);
+ }
+ }
+
+ /* Set this flag only if the whole initialization succeeded. */
+ XPROCESS (proc)->gnutls_p = true;
+
+ return gnutls_make_error (ret);
+}
+
DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0,
doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST.
Currently only client mode is supported. Return a success/failure
@@ -1190,6 +1349,9 @@ t to do all checks. Currently it can contain `:trustfiles' and
:min-prime-bits is the minimum accepted number of bits the client will
accept in Diffie-Hellman key exchange.
+:complete-negotiation, if non-nil, will make negotiation complete
+before returning even on non-blocking sockets.
+
The debug level will be set for this process AND globally for GnuTLS.
So if you set it higher or lower at any point, it affects global
debugging.
@@ -1212,14 +1374,12 @@ one trustfile (usually a CA bundle). */)
{
int ret = GNUTLS_E_SUCCESS;
int max_log_level = 0;
- bool verify_error_all = 0;
gnutls_session_t state;
gnutls_certificate_credentials_t x509_cred = NULL;
gnutls_anon_client_credentials_t anon_cred = NULL;
Lisp_Object global_init;
char const *priority_string_ptr = "NORMAL"; /* default priority string. */
- unsigned int peer_verification;
char *c_hostname;
/* Placeholders for the property list elements. */
@@ -1230,40 +1390,38 @@ one trustfile (usually a CA bundle). */)
/* Lisp_Object callbacks; */
Lisp_Object loglevel;
Lisp_Object hostname;
- Lisp_Object verify_error;
Lisp_Object prime_bits;
- Lisp_Object warnings;
+ struct Lisp_Process *p = XPROCESS (proc);
CHECK_PROCESS (proc);
CHECK_SYMBOL (type);
CHECK_LIST (proplist);
if (NILP (Fgnutls_available_p ()))
- error ("GnuTLS not available");
-
- if (!EQ (type, Qgnutls_x509pki) && !EQ (type, Qgnutls_anon))
- error ("Invalid GnuTLS credential type");
-
- hostname = Fplist_get (proplist, QCgnutls_bootprop_hostname);
- priority_string = Fplist_get (proplist, QCgnutls_bootprop_priority);
- trustfiles = Fplist_get (proplist, QCgnutls_bootprop_trustfiles);
- keylist = Fplist_get (proplist, QCgnutls_bootprop_keylist);
- crlfiles = Fplist_get (proplist, QCgnutls_bootprop_crlfiles);
- loglevel = Fplist_get (proplist, QCgnutls_bootprop_loglevel);
- verify_error = Fplist_get (proplist, QCgnutls_bootprop_verify_error);
- prime_bits = Fplist_get (proplist, QCgnutls_bootprop_min_prime_bits);
-
- if (EQ (verify_error, Qt))
{
- verify_error_all = 1;
+ boot_error (p, "GnuTLS not available");
+ return Qnil;
}
- else if (NILP (Flistp (verify_error)))
+
+ if (!EQ (type, Qgnutls_x509pki) && !EQ (type, Qgnutls_anon))
{
- error ("gnutls-boot: invalid :verify_error parameter (not a list)");
+ boot_error (p, "Invalid GnuTLS credential type");
+ 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);
+
if (!STRINGP (hostname))
- error ("gnutls-boot: invalid :hostname parameter (not a string)");
+ {
+ boot_error (p, "gnutls-boot: invalid :hostname parameter (not a string)");
+ return Qnil;
+ }
c_hostname = SSDATA (hostname);
state = XPROCESS (proc)->gnutls_state;
@@ -1307,7 +1465,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, QCgnutls_bootprop_verify_flags);
+ verify_flags = Fplist_get (proplist, QCverify_flags);
if (NUMBERP (verify_flags))
{
gnutls_verify_flags = XINT (verify_flags);
@@ -1371,7 +1529,8 @@ one trustfile (usually a CA bundle). */)
else
{
emacs_gnutls_deinit (proc);
- error ("Invalid trustfile");
+ boot_error (p, "Invalid trustfile");
+ return Qnil;
}
}
@@ -1395,7 +1554,8 @@ one trustfile (usually a CA bundle). */)
else
{
emacs_gnutls_deinit (proc);
- error ("Invalid CRL file");
+ boot_error (p, "Invalid CRL file");
+ return Qnil;
}
}
@@ -1424,8 +1584,9 @@ one trustfile (usually a CA bundle). */)
else
{
emacs_gnutls_deinit (proc);
- error (STRINGP (keyfile) ? "Invalid client cert file"
- : "Invalid client key file");
+ boot_error (p, STRINGP (keyfile) ? "Invalid client cert file"
+ : "Invalid client key file");
+ return Qnil;
}
}
}
@@ -1437,7 +1598,12 @@ one trustfile (usually a CA bundle). */)
/* Call gnutls_init here: */
GNUTLS_LOG (1, max_log_level, "gnutls_init");
- ret = gnutls_init (&state, GNUTLS_CLIENT);
+ int gnutls_flags = GNUTLS_CLIENT;
+#ifdef GNUTLS_NONBLOCK
+ if (XPROCESS (proc)->is_non_blocking_client)
+ gnutls_flags |= GNUTLS_NONBLOCK;
+#endif
+ ret = gnutls_init (&state, gnutls_flags);
XPROCESS (proc)->gnutls_state = state;
if (ret < GNUTLS_E_SUCCESS)
return gnutls_make_error (ret);
@@ -1479,114 +1645,14 @@ one trustfile (usually a CA bundle). */)
return gnutls_make_error (ret);
}
+ XPROCESS (proc)->gnutls_complete_negotiation_p =
+ !NILP (Fplist_get (proplist, QCcomplete_negotiation));
GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
ret = emacs_gnutls_handshake (XPROCESS (proc));
if (ret < GNUTLS_E_SUCCESS)
return gnutls_make_error (ret);
- /* Now verify the peer, following
- http://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html.
- The peer should present at least one certificate in the chain; do a
- check of the certificate's hostname with
- gnutls_x509_crt_check_hostname against :hostname. */
-
- ret = gnutls_certificate_verify_peers2 (state, &peer_verification);
- if (ret < GNUTLS_E_SUCCESS)
- return gnutls_make_error (ret);
-
- XPROCESS (proc)->gnutls_peer_verification = peer_verification;
-
- warnings = Fplist_get (Fgnutls_peer_status (proc), intern (":warnings"));
- if (!NILP (warnings))
- {
- Lisp_Object tail;
- for (tail = warnings; CONSP (tail); tail = XCDR (tail))
- {
- Lisp_Object warning = XCAR (tail);
- Lisp_Object message = Fgnutls_peer_status_warning_describe (warning);
- if (!NILP (message))
- GNUTLS_LOG2 (1, max_log_level, "verification:", SSDATA (message));
- }
- }
-
- if (peer_verification != 0)
- {
- if (verify_error_all
- || !NILP (Fmember (QCgnutls_bootprop_trustfiles, verify_error)))
- {
- emacs_gnutls_deinit (proc);
- error ("Certificate validation failed %s, verification code %x",
- c_hostname, peer_verification);
- }
- else
- {
- GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:",
- c_hostname);
- }
- }
-
- /* Up to here the process is the same for X.509 certificates and
- OpenPGP keys. From now on X.509 certificates are assumed. This
- can be easily extended to work with openpgp keys as well. */
- if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
- {
- gnutls_x509_crt_t gnutls_verify_cert;
- const gnutls_datum_t *gnutls_verify_cert_list;
- unsigned int gnutls_verify_cert_list_size;
-
- ret = gnutls_x509_crt_init (&gnutls_verify_cert);
- if (ret < GNUTLS_E_SUCCESS)
- return gnutls_make_error (ret);
-
- gnutls_verify_cert_list =
- gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
-
- if (gnutls_verify_cert_list == NULL)
- {
- gnutls_x509_crt_deinit (gnutls_verify_cert);
- emacs_gnutls_deinit (proc);
- error ("No x509 certificate was found\n");
- }
-
- /* We only check the first certificate in the given chain. */
- ret = gnutls_x509_crt_import (gnutls_verify_cert,
- &gnutls_verify_cert_list[0],
- GNUTLS_X509_FMT_DER);
-
- if (ret < GNUTLS_E_SUCCESS)
- {
- gnutls_x509_crt_deinit (gnutls_verify_cert);
- return gnutls_make_error (ret);
- }
-
- XPROCESS (proc)->gnutls_certificate = gnutls_verify_cert;
-
- int err = gnutls_x509_crt_check_hostname (gnutls_verify_cert,
- c_hostname);
- check_memory_full (err);
- if (!err)
- {
- XPROCESS (proc)->gnutls_extra_peer_verification |=
- CERTIFICATE_NOT_MATCHING;
- if (verify_error_all
- || !NILP (Fmember (QCgnutls_bootprop_hostname, verify_error)))
- {
- gnutls_x509_crt_deinit (gnutls_verify_cert);
- emacs_gnutls_deinit (proc);
- error ("The x509 certificate does not match \"%s\"", c_hostname);
- }
- else
- {
- GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:",
- c_hostname);
- }
- }
- }
-
- /* Set this flag only if the whole initialization succeeded. */
- XPROCESS (proc)->gnutls_p = 1;
-
- return gnutls_make_error (ret);
+ return gnutls_verify_boot (proc, proplist);
}
DEFUN ("gnutls-bye", Fgnutls_bye,
@@ -1627,14 +1693,14 @@ DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0,
{
#ifdef HAVE_GNUTLS
# ifdef WINDOWSNT
- Lisp_Object found = Fassq (Qgnutls_dll, Vlibrary_cache);
+ Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache);
if (CONSP (found))
return XCDR (found);
else
{
Lisp_Object status;
status = init_gnutls_functions () ? Qt : Qnil;
- Vlibrary_cache = Fcons (Fcons (Qgnutls_dll, status), Vlibrary_cache);
+ Vlibrary_cache = Fcons (Fcons (Qgnutls, status), Vlibrary_cache);
return status;
}
# else /* !WINDOWSNT */
@@ -1666,15 +1732,16 @@ syms_of_gnutls (void)
DEFSYM (Qgnutls_x509pki, "gnutls-x509pki");
/* The following are for the property list of 'gnutls-boot'. */
- DEFSYM (QCgnutls_bootprop_hostname, ":hostname");
- DEFSYM (QCgnutls_bootprop_priority, ":priority");
- DEFSYM (QCgnutls_bootprop_trustfiles, ":trustfiles");
- DEFSYM (QCgnutls_bootprop_keylist, ":keylist");
- DEFSYM (QCgnutls_bootprop_crlfiles, ":crlfiles");
- DEFSYM (QCgnutls_bootprop_min_prime_bits, ":min-prime-bits");
- DEFSYM (QCgnutls_bootprop_loglevel, ":loglevel");
- DEFSYM (QCgnutls_bootprop_verify_flags, ":verify-flags");
- DEFSYM (QCgnutls_bootprop_verify_error, ":verify-error");
+ DEFSYM (QChostname, ":hostname");
+ DEFSYM (QCpriority, ":priority");
+ DEFSYM (QCtrustfiles, ":trustfiles");
+ DEFSYM (QCkeylist, ":keylist");
+ DEFSYM (QCcrlfiles, ":crlfiles");
+ DEFSYM (QCmin_prime_bits, ":min-prime-bits");
+ DEFSYM (QCloglevel, ":loglevel");
+ DEFSYM (QCcomplete_negotiation, ":complete-negotiation");
+ DEFSYM (QCverify_flags, ":verify-flags");
+ DEFSYM (QCverify_error, ":verify-error");
DEFSYM (Qgnutls_e_interrupted, "gnutls-e-interrupted");
Fput (Qgnutls_e_interrupted, Qgnutls_code,
@@ -1693,6 +1760,7 @@ syms_of_gnutls (void)
make_number (GNUTLS_E_APPLICATION_ERROR_MIN));
defsubr (&Sgnutls_get_initstage);
+ defsubr (&Sgnutls_asynchronous_parameters);
defsubr (&Sgnutls_errorp);
defsubr (&Sgnutls_error_fatalp);
defsubr (&Sgnutls_error_string);
diff --git a/src/gnutls.h b/src/gnutls.h
index e9348e7423e..41769a47f54 100644
--- a/src/gnutls.h
+++ b/src/gnutls.h
@@ -25,8 +25,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "lisp.h"
-/* This limits the attempts to handshake per process (connection). */
-#define GNUTLS_EMACS_HANDSHAKES_LIMIT 100
+/* This limits the attempts to handshake per process (connection). It
+ should work out to about one minute in asynchronous cases. */
+#define GNUTLS_EMACS_HANDSHAKES_LIMIT 6000
typedef enum
{
@@ -70,7 +71,7 @@ typedef enum
#define GNUTLS_LOG2i(level, max, string, extra) \
do { \
if ((level) <= (max)) \
- gnutls_log_function2i (level, "(Emacs) " string, extra); \
+ message ("gnutls.c: [%d] %s %d", level, string, extra); \
} while (false)
extern ptrdiff_t
@@ -84,6 +85,8 @@ extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err);
#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);
#endif
diff --git a/src/gtkutil.c b/src/gtkutil.c
index e323216bb79..3d35a3dee81 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -48,6 +48,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "emacsgtkfixed.h"
#endif
+#ifdef HAVE_XDBE
+#include <X11/extensions/Xdbe.h>
+#endif
+
#ifndef HAVE_GTK_WIDGET_SET_HAS_WINDOW
#define gtk_widget_set_has_window(w, b) \
(gtk_fixed_set_has_window (GTK_FIXED (w), b))
@@ -143,6 +147,8 @@ struct xg_frame_tb_info
GtkTextDirection dir;
};
+static GtkWidget * xg_get_widget_from_map (ptrdiff_t idx);
+
/***********************************************************************
Display handling functions
@@ -815,12 +821,6 @@ xg_clear_under_internal_border (struct frame *f)
{
if (FRAME_INTERNAL_BORDER_WIDTH (f) > 0)
{
-#ifndef USE_CAIRO
- GtkWidget *wfixed = f->output_data.x->edit_widget;
-
- gtk_widget_queue_draw (wfixed);
- gdk_window_process_all_updates ();
-#endif
x_clear_area (f, 0, 0,
FRAME_PIXEL_WIDTH (f), FRAME_INTERNAL_BORDER_WIDTH (f));
@@ -1233,6 +1233,7 @@ xg_create_frame_widgets (struct frame *f)
by callers of this function. */
gtk_widget_realize (wfixed);
FRAME_X_WINDOW (f) = GTK_WIDGET_TO_X_WIN (wfixed);
+ initial_set_up_x_back_buffer (f);
/* Since GTK clears its window by filling with the background color,
we must keep X and GTK background in sync. */
@@ -1296,8 +1297,11 @@ xg_free_frame_widgets (struct frame *f)
if (tbinfo)
xfree (tbinfo);
+ /* x_free_frame_resources should have taken care of it */
+ eassert (!FRAME_X_DOUBLE_BUFFERED_P (f));
gtk_widget_destroy (FRAME_GTK_OUTER_WIDGET (f));
FRAME_X_WINDOW (f) = 0; /* Set to avoid XDestroyWindow in xterm.c */
+ FRAME_X_RAW_DRAWABLE (f) = 0;
FRAME_GTK_OUTER_WIDGET (f) = 0;
#ifdef USE_GTK_TOOLTIP
if (x->ttip_lbl)
@@ -1440,6 +1444,18 @@ xg_set_background_color (struct frame *f, unsigned long bg)
{
block_input ();
xg_set_widget_bg (f, FRAME_GTK_WIDGET (f), FRAME_BACKGROUND_PIXEL (f));
+
+ Lisp_Object bar;
+ for (bar = FRAME_SCROLL_BARS (f);
+ !NILP (bar);
+ bar = XSCROLL_BAR (bar)->next)
+ {
+ GtkWidget *scrollbar =
+ xg_get_widget_from_map (XSCROLL_BAR (bar)->x_window);
+ GtkWidget *webox = gtk_widget_get_parent (scrollbar);
+ xg_set_widget_bg (f, webox, FRAME_BACKGROUND_PIXEL (f));
+ }
+
unblock_input ();
}
}
@@ -1829,7 +1845,8 @@ xg_get_file_with_chooser (struct frame *f,
{
char msgbuf[1024];
- GtkWidget *filewin, *wtoggle, *wbox, *wmessage IF_LINT (= NULL);
+ GtkWidget *filewin, *wtoggle, *wbox;
+ GtkWidget *wmessage UNINIT;
GtkWindow *gwin = GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f));
GtkFileChooserAction action = (mustmatch_p ?
GTK_FILE_CHOOSER_ACTION_OPEN :
@@ -2264,7 +2281,6 @@ xg_mark_data (void)
}
}
-
/* Callback called when a menu item is destroyed. Used to free data.
W is the widget that is being destroyed (not used).
CLIENT_DATA points to the xg_menu_item_cb_data associated with the W. */
@@ -3568,44 +3584,23 @@ xg_gtk_scroll_destroy (GtkWidget *widget, gpointer data)
xg_remove_widget_from_map (id);
}
-/* Create a scroll bar widget for frame F. Store the scroll bar
- in BAR.
- SCROLL_CALLBACK is the callback to invoke when the value of the
- bar changes.
- END_CALLBACK is the callback to invoke when scrolling ends.
- SCROLL_BAR_NAME is the name we use for the scroll bar. Can be used
- to set resources for the widget. */
-
-void
-xg_create_scroll_bar (struct frame *f,
- struct scroll_bar *bar,
- GCallback scroll_callback,
- GCallback end_callback,
- const char *scroll_bar_name)
+static void
+xg_finish_scroll_bar_creation (struct frame *f,
+ GtkWidget *wscroll,
+ struct scroll_bar *bar,
+ GCallback scroll_callback,
+ GCallback end_callback,
+ const char *scroll_bar_name)
{
- GtkWidget *wscroll;
- GtkWidget *webox;
- intptr_t scroll_id;
-#ifdef HAVE_GTK3
- GtkAdjustment *vadj;
-#else
- GtkObject *vadj;
-#endif
+ GtkWidget *webox = gtk_event_box_new ();
- /* Page, step increment values are not so important here, they
- will be corrected in x_set_toolkit_scroll_bar_thumb. */
- vadj = gtk_adjustment_new (XG_SB_MIN, XG_SB_MIN, XG_SB_MAX,
- 0.1, 0.1, 0.1);
-
- wscroll = gtk_scrollbar_new (GTK_ORIENTATION_VERTICAL, GTK_ADJUSTMENT (vadj));
- webox = gtk_event_box_new ();
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);
- scroll_id = xg_store_widget_in_map (wscroll);
+ ptrdiff_t scroll_id = xg_store_widget_in_map (wscroll);
g_signal_connect (G_OBJECT (wscroll),
"destroy",
@@ -3629,11 +3624,52 @@ xg_create_scroll_bar (struct frame *f,
gtk_fixed_put (GTK_FIXED (f->output_data.x->edit_widget), webox, -1, -1);
gtk_container_add (GTK_CONTAINER (webox), wscroll);
+ xg_set_widget_bg (f, webox, FRAME_BACKGROUND_PIXEL (f));
+
+ /* N.B. The event box doesn't become a real X11 window until we ask
+ for its XID via GTK_WIDGET_TO_X_WIN. If the event box is not a
+ real X window, it and its scroll-bar child try to draw on the
+ Emacs main window, which we draw over using Xlib. */
+ gtk_widget_realize (webox);
+ GTK_WIDGET_TO_X_WIN (webox);
/* Set the cursor to an arrow. */
xg_set_cursor (webox, FRAME_DISPLAY_INFO (f)->xg_cursor);
bar->x_window = scroll_id;
+}
+
+/* Create a scroll bar widget for frame F. Store the scroll bar
+ in BAR.
+ SCROLL_CALLBACK is the callback to invoke when the value of the
+ bar changes.
+ END_CALLBACK is the callback to invoke when scrolling ends.
+ SCROLL_BAR_NAME is the name we use for the scroll bar. Can be used
+ to set resources for the widget. */
+
+void
+xg_create_scroll_bar (struct frame *f,
+ struct scroll_bar *bar,
+ GCallback scroll_callback,
+ GCallback end_callback,
+ const char *scroll_bar_name)
+{
+ GtkWidget *wscroll;
+#ifdef HAVE_GTK3
+ GtkAdjustment *vadj;
+#else
+ GtkObject *vadj;
+#endif
+
+ /* Page, step increment values are not so important here, they
+ will be corrected in x_set_toolkit_scroll_bar_thumb. */
+ vadj = gtk_adjustment_new (XG_SB_MIN, XG_SB_MIN, XG_SB_MAX,
+ 0.1, 0.1, 0.1);
+
+ wscroll = gtk_scrollbar_new (GTK_ORIENTATION_VERTICAL, GTK_ADJUSTMENT (vadj));
+
+ xg_finish_scroll_bar_creation (f, wscroll, bar, scroll_callback,
+ end_callback, scroll_bar_name);
bar->horizontal = 0;
}
@@ -3651,8 +3687,6 @@ xg_create_horizontal_scroll_bar (struct frame *f,
const char *scroll_bar_name)
{
GtkWidget *wscroll;
- GtkWidget *webox;
- intptr_t scroll_id;
#ifdef HAVE_GTK3
GtkAdjustment *hadj;
#else
@@ -3665,42 +3699,9 @@ xg_create_horizontal_scroll_bar (struct frame *f,
0.1, 0.1, 0.1);
wscroll = gtk_scrollbar_new (GTK_ORIENTATION_HORIZONTAL, GTK_ADJUSTMENT (hadj));
- webox = gtk_event_box_new ();
- 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);
-
- scroll_id = xg_store_widget_in_map (wscroll);
-
- g_signal_connect (G_OBJECT (wscroll),
- "destroy",
- G_CALLBACK (xg_gtk_scroll_destroy),
- (gpointer) scroll_id);
- g_signal_connect (G_OBJECT (wscroll),
- "change-value",
- scroll_callback,
- (gpointer) bar);
- g_signal_connect (G_OBJECT (wscroll),
- "button-release-event",
- end_callback,
- (gpointer) bar);
-
- /* The scroll bar widget does not draw on a window of its own. Instead
- it draws on the parent window, in this case the edit widget. So
- whenever the edit widget is cleared, the scroll bar needs to redraw
- also, which causes flicker. Put an event box between the edit widget
- and the scroll bar, so the scroll bar instead draws itself on the
- event box window. */
- gtk_fixed_put (GTK_FIXED (f->output_data.x->edit_widget), webox, -1, -1);
- gtk_container_add (GTK_CONTAINER (webox), wscroll);
-
- /* Set the cursor to an arrow. */
- xg_set_cursor (webox, FRAME_DISPLAY_INFO (f)->xg_cursor);
-
- bar->x_window = scroll_id;
+ xg_finish_scroll_bar_creation (f, wscroll, bar, scroll_callback,
+ end_callback, scroll_bar_name);
bar->horizontal = 1;
}
@@ -3769,16 +3770,10 @@ xg_update_scrollbar_pos (struct frame *f,
gtk_widget_show_all (wparent);
gtk_widget_set_size_request (wscroll, width, height);
}
-#ifndef USE_CAIRO
- gtk_widget_queue_draw (wfixed);
- gdk_window_process_all_updates ();
-#endif
if (oldx != -1 && oldw > 0 && oldh > 0)
{
- /* Clear under old scroll bar position. This must be done after
- the gtk_widget_queue_draw and gdk_window_process_all_updates
- above. */
- oldw += (scale - 1) * oldw;
+ /* Clear under old scroll bar position. */
+ oldw += (scale - 1) * oldw;
oldx -= (scale - 1) * oldw;
x_clear_area (f, oldx, oldy, oldw, oldh);
}
@@ -3840,14 +3835,9 @@ xg_update_horizontal_scrollbar_pos (struct frame *f,
gtk_widget_show_all (wparent);
gtk_widget_set_size_request (wscroll, width, height);
}
- gtk_widget_queue_draw (wfixed);
- gdk_window_process_all_updates ();
if (oldx != -1 && oldw > 0 && oldh > 0)
- /* Clear under old scroll bar position. This must be done after
- the gtk_widget_queue_draw and gdk_window_process_all_updates
- above. */
- x_clear_area (f,
- oldx, oldy, oldw, oldh);
+ /* Clear under old scroll bar position. */
+ x_clear_area (f, oldx, oldy, oldw, oldh);
/* GTK does not redraw until the main loop is entered again, but
if there are no X events pending we will not enter it. So we sync
diff --git a/src/image.c b/src/image.c
index 6a62235673a..d82fedb8dea 100644
--- a/src/image.c
+++ b/src/image.c
@@ -30,7 +30,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#endif
#include <setjmp.h>
+
#include <c-ctype.h>
+#include <flexmember.h>
#include "lisp.h"
#include "frame.h"
@@ -56,6 +58,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include TERM_HEADER
#endif /* HAVE_WINDOW_SYSTEM */
+/* Work around GCC bug 54561. */
+#if GNUC_PREREQ (4, 3, 0)
+# pragma GCC diagnostic ignored "-Wclobbered"
+#endif
+
#ifdef HAVE_X_WINDOWS
typedef struct x_bitmap_record Bitmap_Record;
#define GET_PIXEL(ximg, x, y) XGetPixel (ximg, x, y)
@@ -80,7 +87,6 @@ typedef struct w32_bitmap_record Bitmap_Record;
#define PIX_MASK_DRAW 1
#define x_defined_color w32_defined_color
-#define DefaultDepthOfScreen(screen) (one_w32_display_info.n_cbits)
#endif /* HAVE_NTGUI */
@@ -91,11 +97,9 @@ typedef struct ns_bitmap_record Bitmap_Record;
#define NO_PIXMAP 0
#define PIX_MASK_RETAIN 0
-#define PIX_MASK_DRAW 1
#define x_defined_color(f, name, color_def, alloc) \
ns_defined_color (f, name, color_def, alloc, 0)
-#define DefaultDepthOfScreen(screen) x_display_list->n_planes
#endif /* HAVE_NS */
#if (defined HAVE_X_WINDOWS \
@@ -216,13 +220,14 @@ x_create_bitmap_from_data (struct frame *f, char *bits, unsigned int width, unsi
#ifdef HAVE_X_WINDOWS
Pixmap bitmap;
- bitmap = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ bitmap = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
bits, width, height);
if (! bitmap)
return -1;
#endif /* HAVE_X_WINDOWS */
#ifdef HAVE_NTGUI
+ Lisp_Object frame UNINIT; /* The value is not used. */
Pixmap bitmap;
bitmap = CreateBitmap (width, height,
FRAME_DISPLAY_INFO (XFRAME (frame))->n_planes,
@@ -270,11 +275,11 @@ x_create_bitmap_from_data (struct frame *f, char *bits, unsigned int width, unsi
ptrdiff_t
x_create_bitmap_from_file (struct frame *f, Lisp_Object file)
{
- Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f);
-
#ifdef HAVE_NTGUI
return -1; /* W32_TODO : bitmap support */
-#endif /* HAVE_NTGUI */
+#else
+ Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f);
+#endif
#ifdef HAVE_NS
ptrdiff_t id;
@@ -322,7 +327,7 @@ x_create_bitmap_from_file (struct frame *f, Lisp_Object file)
filename = SSDATA (found);
- result = XReadBitmapFile (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ result = XReadBitmapFile (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
filename, &width, &height, &bitmap, &xhot, &yhot);
if (result != BitmapSuccess)
return -1;
@@ -1142,7 +1147,8 @@ static RGB_PIXEL_COLOR
four_corners_best (XImagePtr_or_DC ximg, int *corners,
unsigned long width, unsigned long height)
{
- RGB_PIXEL_COLOR corner_pixels[4], best IF_LINT (= 0);
+ RGB_PIXEL_COLOR corner_pixels[4];
+ RGB_PIXEL_COLOR best UNINIT;
int i, best_count;
if (corners && corners[BOT_CORNER] >= 0)
@@ -1946,7 +1952,7 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth,
{
#ifdef HAVE_X_WINDOWS
Display *display = FRAME_X_DISPLAY (f);
- Window window = FRAME_X_WINDOW (f);
+ Drawable drawable = FRAME_X_DRAWABLE (f);
Screen *screen = FRAME_X_SCREEN (f);
eassert (input_blocked_p ());
@@ -1975,7 +1981,7 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth,
(*ximg)->data = xmalloc ((*ximg)->bytes_per_line * height);
/* Allocate a pixmap of the same size. */
- *pixmap = XCreatePixmap (display, window, width, height, depth);
+ *pixmap = XCreatePixmap (display, drawable, width, height, depth);
if (*pixmap == NO_PIXMAP)
{
x_destroy_x_image (*ximg);
@@ -2300,7 +2306,7 @@ x_find_image_fd (Lisp_Object file, int *pfd)
happens, e.g., under Auto Image File Mode.) 'openp'
didn't open the file, so we should, because the caller
expects that. */
- fd = emacs_open (SSDATA (file_found), O_RDONLY | O_BINARY, 0);
+ fd = emacs_open (SSDATA (file_found), O_RDONLY, 0);
}
}
else /* fd < 0, but not -2 */
@@ -2325,12 +2331,12 @@ x_find_image_file (Lisp_Object file)
occurred. FD is a file descriptor open for reading FILE. Set
*SIZE to the size of the file. */
-static unsigned char *
+static char *
slurp_file (int fd, ptrdiff_t *size)
{
FILE *fp = fdopen (fd, "rb");
- unsigned char *buf = NULL;
+ char *buf = NULL;
struct stat st;
if (fp)
@@ -2517,7 +2523,7 @@ xbm_image_p (Lisp_Object object)
if (STRINGP (elt))
{
if (SCHARS (elt)
- < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR)
+ < (width + CHAR_BIT - 1) / CHAR_BIT)
return 0;
}
else if (BOOL_VECTOR_P (elt))
@@ -2532,7 +2538,7 @@ xbm_image_p (Lisp_Object object)
else if (STRINGP (data))
{
if (SCHARS (data)
- < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR * height)
+ < (width + CHAR_BIT - 1) / CHAR_BIT * height)
return 0;
}
else if (BOOL_VECTOR_P (data))
@@ -2555,9 +2561,9 @@ xbm_image_p (Lisp_Object object)
scanning a number, store its value in *IVAL. */
static int
-xbm_scan (unsigned char **s, unsigned char *end, char *sval, int *ival)
+xbm_scan (char **s, char *end, char *sval, int *ival)
{
- unsigned int c;
+ unsigned char c;
loop:
@@ -2609,7 +2615,7 @@ xbm_scan (unsigned char **s, unsigned char *end, char *sval, int *ival)
if (*s < end)
*s = *s - 1;
*ival = value;
- c = XBM_TK_NUMBER;
+ return XBM_TK_NUMBER;
}
else if (c_isalpha (c) || c == '_')
{
@@ -2620,7 +2626,7 @@ xbm_scan (unsigned char **s, unsigned char *end, char *sval, int *ival)
*sval = 0;
if (*s < end)
*s = *s - 1;
- c = XBM_TK_IDENT;
+ return XBM_TK_IDENT;
}
else if (c == '/' && **s == '*')
{
@@ -2736,7 +2742,7 @@ Create_Pixmap_From_Bitmap_Data (struct frame *f, struct image *img, char *data,
img->pixmap =
(x_check_image_size (0, img->width, img->height)
? XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
- FRAME_X_WINDOW (f),
+ FRAME_X_DRAWABLE (f),
data,
img->width, img->height,
fg, bg,
@@ -2757,11 +2763,11 @@ Create_Pixmap_From_Bitmap_Data (struct frame *f, struct image *img, char *data,
bitmap remains unread). */
static bool
-xbm_read_bitmap_data (struct frame *f, unsigned char *contents, unsigned char *end,
+xbm_read_bitmap_data (struct frame *f, char *contents, char *end,
int *width, int *height, char **data,
bool inhibit_image_error)
{
- unsigned char *s = contents;
+ char *s = contents;
char buffer[BUFSIZ];
bool padding_p = 0;
bool v10 = 0;
@@ -2918,8 +2924,7 @@ xbm_read_bitmap_data (struct frame *f, unsigned char *contents, unsigned char *e
successful. */
static bool
-xbm_load_image (struct frame *f, struct image *img, unsigned char *contents,
- unsigned char *end)
+xbm_load_image (struct frame *f, struct image *img, char *contents, char *end)
{
bool rc;
char *data;
@@ -2979,8 +2984,8 @@ xbm_file_p (Lisp_Object data)
{
int w, h;
return (STRINGP (data)
- && xbm_read_bitmap_data (NULL, SDATA (data),
- (SDATA (data) + SBYTES (data)),
+ && xbm_read_bitmap_data (NULL, SSDATA (data),
+ SSDATA (data) + SBYTES (data),
&w, &h, NULL, 1));
}
@@ -3009,7 +3014,7 @@ xbm_load (struct frame *f, struct image *img)
}
ptrdiff_t size;
- unsigned char *contents = slurp_file (fd, &size);
+ char *contents = slurp_file (fd, &size);
if (contents == NULL)
{
image_error ("Error loading XBM image `%s'", file);
@@ -3070,9 +3075,8 @@ xbm_load (struct frame *f, struct image *img)
}
if (in_memory_file_p)
- success_p = xbm_load_image (f, img, SDATA (data),
- (SDATA (data)
- + SBYTES (data)));
+ success_p = xbm_load_image (f, img, SSDATA (data),
+ SSDATA (data) + SBYTES (data));
else
{
USE_SAFE_ALLOCA;
@@ -3081,7 +3085,7 @@ xbm_load (struct frame *f, struct image *img)
{
int i;
char *p;
- int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
+ int nbytes = (img->width + CHAR_BIT - 1) / CHAR_BIT;
SAFE_NALLOCA (bits, nbytes, img->height);
p = bits;
@@ -3105,7 +3109,7 @@ xbm_load (struct frame *f, struct image *img)
int nbytes, i;
/* Windows mono bitmaps are reversed compared with X. */
invertedBits = bits;
- nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
+ nbytes = (img->width + CHAR_BIT - 1) / CHAR_BIT;
SAFE_NALLOCA (bits, nbytes, img->height);
for (i = 0; i < nbytes; i++)
bits[i] = XBM_BIT_SHUFFLE (invertedBits[i]);
@@ -3158,16 +3162,18 @@ static bool xpm_load (struct frame *f, struct image *img);
#define XColor xpm_XColor
#define XImage xpm_XImage
#define Display xpm_Display
-#define PIXEL_ALREADY_TYPEDEFED
+#ifdef CYGWIN
+#include "noX/xpm.h"
+#else /* not CYGWIN */
#include "X11/xpm.h"
+#endif /* not CYGWIN */
#undef FOR_MSW
#undef XColor
#undef XImage
#undef Display
-#undef PIXEL_ALREADY_TYPEDEFED
-#else
+#else /* not HAVE_NTGUI */
#include "X11/xpm.h"
-#endif /* HAVE_NTGUI */
+#endif /* not HAVE_NTGUI */
#endif /* HAVE_XPM */
#if defined (HAVE_XPM) || defined (HAVE_NS)
@@ -3339,7 +3345,7 @@ xpm_cache_color (struct frame *f, char *color_name, XColor *color, int bucket)
if (bucket < 0)
bucket = xpm_color_bucket (color_name);
- nbytes = offsetof (struct xpm_cached_color, name) + strlen (color_name) + 1;
+ nbytes = FLEXSIZEOF (struct xpm_cached_color, name, strlen (color_name) + 1);
p = xmalloc (nbytes);
strcpy (p->name, color_name);
p->color = *color;
@@ -3514,7 +3520,7 @@ x_create_bitmap_from_xpm_data (struct frame *f, const char **bits)
xpm_init_color_cache (f, &attrs);
#endif
- rc = XpmCreatePixmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ rc = XpmCreatePixmapFromData (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
(char **) bits, &bitmap, &mask, &attrs);
if (rc != XpmSuccess)
{
@@ -3677,7 +3683,7 @@ xpm_load (struct frame *f, struct image *img)
#endif
/* XpmReadFileToPixmap is not available in the Windows port of
libxpm. But XpmReadFileToImage almost does what we want. */
- rc = XpmReadFileToImage (&hdc, SDATA (file),
+ rc = XpmReadFileToImage (&hdc, SSDATA (file),
&xpm_image, &xpm_mask,
&attrs);
#else
@@ -3701,7 +3707,7 @@ xpm_load (struct frame *f, struct image *img)
#ifdef HAVE_NTGUI
/* XpmCreatePixmapFromBuffer is not available in the Windows port
of libxpm. But XpmCreateImageFromBuffer almost does what we want. */
- rc = XpmCreateImageFromBuffer (&hdc, SDATA (buffer),
+ rc = XpmCreateImageFromBuffer (&hdc, SSDATA (buffer),
&xpm_image, &xpm_mask,
&attrs);
#else
@@ -3752,7 +3758,7 @@ xpm_load (struct frame *f, struct image *img)
#ifdef HAVE_X_WINDOWS
if (rc == XpmSuccess)
{
- img->pixmap = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ img->pixmap = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
img->ximg->width, img->ximg->height,
img->ximg->depth);
if (img->pixmap == NO_PIXMAP)
@@ -3762,7 +3768,7 @@ xpm_load (struct frame *f, struct image *img)
}
else if (img->mask_img)
{
- img->mask = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ img->mask = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
img->mask_img->width,
img->mask_img->height,
img->mask_img->depth);
@@ -3884,14 +3890,12 @@ xpm_load (struct frame *f, struct image *img)
/* XPM support functions for NS where libxpm is not available.
Only XPM version 3 (without any extensions) is supported. */
-static void xpm_put_color_table_v (Lisp_Object, const unsigned char *,
+static void xpm_put_color_table_v (Lisp_Object, const char *,
int, Lisp_Object);
-static Lisp_Object xpm_get_color_table_v (Lisp_Object,
- const unsigned char *, int);
-static void xpm_put_color_table_h (Lisp_Object, const unsigned char *,
+static Lisp_Object xpm_get_color_table_v (Lisp_Object, const char *, int);
+static void xpm_put_color_table_h (Lisp_Object, const char *,
int, Lisp_Object);
-static Lisp_Object xpm_get_color_table_h (Lisp_Object,
- const unsigned char *, int);
+static Lisp_Object xpm_get_color_table_h (Lisp_Object, const char *, int);
/* Tokens returned from xpm_scan. */
@@ -3910,12 +3914,9 @@ enum xpm_token
length of the corresponding token, respectively. */
static int
-xpm_scan (const unsigned char **s,
- const unsigned char *end,
- const unsigned char **beg,
- ptrdiff_t *len)
+xpm_scan (const char **s, const char *end, const char **beg, ptrdiff_t *len)
{
- int c;
+ unsigned char c;
while (*s < end)
{
@@ -3978,12 +3979,9 @@ xpm_scan (const unsigned char **s,
hash table is used. */
static Lisp_Object
-xpm_make_color_table_v (void (**put_func) (Lisp_Object,
- const unsigned char *,
- int,
+xpm_make_color_table_v (void (**put_func) (Lisp_Object, const char *, int,
Lisp_Object),
- Lisp_Object (**get_func) (Lisp_Object,
- const unsigned char *,
+ Lisp_Object (**get_func) (Lisp_Object, const char *,
int))
{
*put_func = xpm_put_color_table_v;
@@ -3993,28 +3991,27 @@ xpm_make_color_table_v (void (**put_func) (Lisp_Object,
static void
xpm_put_color_table_v (Lisp_Object color_table,
- const unsigned char *chars_start,
+ const char *chars_start,
int chars_len,
Lisp_Object color)
{
- ASET (color_table, *chars_start, color);
+ unsigned char uc = *chars_start;
+ ASET (color_table, uc, color);
}
static Lisp_Object
xpm_get_color_table_v (Lisp_Object color_table,
- const unsigned char *chars_start,
+ const char *chars_start,
int chars_len)
{
- return AREF (color_table, *chars_start);
+ unsigned char uc = *chars_start;
+ return AREF (color_table, uc);
}
static Lisp_Object
-xpm_make_color_table_h (void (**put_func) (Lisp_Object,
- const unsigned char *,
- int,
+xpm_make_color_table_h (void (**put_func) (Lisp_Object, const char *, int,
Lisp_Object),
- Lisp_Object (**get_func) (Lisp_Object,
- const unsigned char *,
+ Lisp_Object (**get_func) (Lisp_Object, const char *,
int))
{
*put_func = xpm_put_color_table_h;
@@ -4027,7 +4024,7 @@ xpm_make_color_table_h (void (**put_func) (Lisp_Object,
static void
xpm_put_color_table_h (Lisp_Object color_table,
- const unsigned char *chars_start,
+ const char *chars_start,
int chars_len,
Lisp_Object color)
{
@@ -4041,7 +4038,7 @@ xpm_put_color_table_h (Lisp_Object color_table,
static Lisp_Object
xpm_get_color_table_h (Lisp_Object color_table,
- const unsigned char *chars_start,
+ const char *chars_start,
int chars_len)
{
struct Lisp_Hash_Table *table = XHASH_TABLE (color_table);
@@ -4075,20 +4072,22 @@ xpm_str_to_color_key (const char *s)
static bool
xpm_load_image (struct frame *f,
struct image *img,
- const unsigned char *contents,
- const unsigned char *end)
+ const char *contents,
+ const char *end)
{
- const unsigned char *s = contents, *beg, *str;
- unsigned char buffer[BUFSIZ];
+ const char *s = contents, *beg, *str;
+ char buffer[BUFSIZ];
int width, height, x, y;
int num_colors, chars_per_pixel;
ptrdiff_t len;
int LA1;
- void (*put_color_table) (Lisp_Object, const unsigned char *, int, Lisp_Object);
- Lisp_Object (*get_color_table) (Lisp_Object, const unsigned char *, int);
+ void (*put_color_table) (Lisp_Object, const char *, int, Lisp_Object);
+ Lisp_Object (*get_color_table) (Lisp_Object, const char *, int);
Lisp_Object frame, color_symbols, color_table;
int best_key;
+#ifndef HAVE_NS
bool have_mask = false;
+#endif
XImagePtr ximg = NULL, mask_img = NULL;
#define match() \
@@ -4327,7 +4326,7 @@ xpm_load (struct frame *f,
}
ptrdiff_t size;
- unsigned char *contents = slurp_file (fd, &size);
+ char *contents = slurp_file (fd, &size);
if (contents == NULL)
{
image_error ("Error loading XPM image `%s'", file);
@@ -4347,8 +4346,8 @@ xpm_load (struct frame *f,
image_error ("Invalid image data `%s'", data);
return 0;
}
- success_p = xpm_load_image (f, img, SDATA (data),
- SDATA (data) + SBYTES (data));
+ success_p = xpm_load_image (f, img, SSDATA (data),
+ SSDATA (data) + SBYTES (data));
}
return success_p;
@@ -5041,13 +5040,13 @@ static void
x_build_heuristic_mask (struct frame *f, struct image *img, Lisp_Object how)
{
XImagePtr_or_DC ximg;
-#ifndef HAVE_NTGUI
- XImagePtr mask_img;
-#else
+#ifdef HAVE_NTGUI
HGDIOBJ prev;
char *mask_img;
int row_width;
-#endif /* HAVE_NTGUI */
+#elif !defined HAVE_NS
+ XImagePtr mask_img;
+#endif
int x, y;
bool use_img_background;
unsigned long bg = 0;
@@ -5222,20 +5221,22 @@ pbm_image_p (Lisp_Object object)
end of input. */
static int
-pbm_next_char (unsigned char **s, unsigned char *end)
+pbm_next_char (char **s, char *end)
{
- int c = -1;
-
- while (*s < end && (c = *(*s)++, c == '#'))
+ while (*s < end)
{
- /* Skip to the next line break. */
- while (*s < end && (c = *(*s)++, c != '\n' && c != '\r'))
- ;
-
- c = -1;
+ unsigned char c = *(*s)++;
+ if (c != '#')
+ return c;
+ while (*s < end)
+ {
+ c = *(*s)++;
+ if (c == '\n' || c == '\r')
+ break;
+ }
}
- return c;
+ return -1;
}
@@ -5244,7 +5245,7 @@ pbm_next_char (unsigned char **s, unsigned char *end)
end of input. */
static int
-pbm_scan_number (unsigned char **s, unsigned char *end)
+pbm_scan_number (char **s, char *end)
{
int c = 0, val = -1;
@@ -5274,12 +5275,9 @@ pbm_load (struct frame *f, struct image *img)
int width, height, max_color_idx = 0;
Lisp_Object specified_file;
enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type;
- unsigned char *contents = NULL;
- unsigned char *end, *p;
-#ifdef USE_CAIRO
- unsigned char *data = 0;
- uint32_t *dataptr;
-#else
+ char *contents = NULL;
+ char *end, *p;
+#ifndef USE_CAIRO
XImagePtr ximg;
#endif
@@ -5315,7 +5313,7 @@ pbm_load (struct frame *f, struct image *img)
image_error ("Invalid image data `%s'", data);
return 0;
}
- p = SDATA (data);
+ p = SSDATA (data);
end = p + SBYTES (data);
}
@@ -5366,8 +5364,8 @@ pbm_load (struct frame *f, struct image *img)
height = pbm_scan_number (&p, end);
#ifdef USE_CAIRO
- data = (unsigned char *) xmalloc (width * height * 4);
- dataptr = (uint32_t *) data;
+ uint32_t *data = xmalloc (width * height * 4);
+ uint32_t *dataptr = data;
#endif
if (type != PBM_MONO)
@@ -5396,7 +5394,8 @@ pbm_load (struct frame *f, struct image *img)
if (type == PBM_MONO)
{
- int c = 0, g;
+ unsigned char c = 0;
+ int g;
struct image_keyword fmt[PBM_LAST];
unsigned long fg = FRAME_FOREGROUND_PIXEL (f);
unsigned long bg = FRAME_BACKGROUND_PIXEL (f);
@@ -5894,13 +5893,12 @@ struct png_load_context
static bool
png_load_body (struct frame *f, struct image *img, struct png_load_context *c)
{
- Lisp_Object specified_file;
- Lisp_Object specified_data;
+ Lisp_Object specified_file, specified_data;
+ FILE *fp = NULL;
int x, y;
ptrdiff_t i;
png_struct *png_ptr;
png_info *info_ptr = NULL, *end_info = NULL;
- FILE *fp = NULL;
png_byte sig[8];
png_byte *pixels = NULL;
png_byte **rows = NULL;
@@ -5922,7 +5920,6 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c)
/* Find out what file to load. */
specified_file = image_spec_value (img->spec, QCfile, NULL);
specified_data = image_spec_value (img->spec, QCdata, NULL);
- IF_LINT (Lisp_Object volatile specified_data_volatile = specified_data);
if (NILP (specified_data))
{
@@ -6018,10 +6015,6 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c)
return 0;
}
- /* Silence a bogus diagnostic; see GCC bug 54561. */
- IF_LINT (fp = c->fp);
- IF_LINT (specified_data = specified_data_volatile);
-
/* Read image info. */
if (!NILP (specified_data))
png_set_read_fn (png_ptr, &tbr, png_read_from_memory);
@@ -6671,10 +6664,8 @@ static bool
jpeg_load_body (struct frame *f, struct image *img,
struct my_jpeg_error_mgr *mgr)
{
- Lisp_Object specified_file;
- Lisp_Object specified_data;
- /* The 'volatile' silences a bogus diagnostic; see GCC bug 54561. */
- FILE * IF_LINT (volatile) fp = NULL;
+ Lisp_Object specified_file, specified_data;
+ FILE *volatile fp = NULL;
JSAMPARRAY buffer;
int row_stride, x, y;
unsigned long *colors;
@@ -6687,7 +6678,6 @@ jpeg_load_body (struct frame *f, struct image *img,
/* Open the JPEG file. */
specified_file = image_spec_value (img->spec, QCfile, NULL);
specified_data = image_spec_value (img->spec, QCdata, NULL);
- IF_LINT (Lisp_Object volatile specified_data_volatile = specified_data);
if (NILP (specified_data))
{
@@ -6751,9 +6741,6 @@ jpeg_load_body (struct frame *f, struct image *img,
return 0;
}
- /* Silence a bogus diagnostic; see GCC bug 54561. */
- IF_LINT (specified_data = specified_data_volatile);
-
/* Create the JPEG decompression object. Let it read from fp.
Read the JPEG image header. */
jpeg_CreateDecompress (&mgr->cinfo, JPEG_LIB_VERSION, sizeof *&mgr->cinfo);
@@ -7491,7 +7478,11 @@ gif_image_p (Lisp_Object object)
/* avoid conflict with QuickdrawText.h */
# define DrawText gif_DrawText
# include <gif_lib.h>
-# undef DrawText
+/* The bogus ifdef below, which is always true, is to avoid a compiler
+ warning about DrawText being unused. */
+# ifdef DrawText
+# undef DrawText
+# endif
/* Giflib before 5.0 didn't define these macros (used only if HAVE_NTGUI). */
# ifndef GIFLIB_MINOR
@@ -8077,15 +8068,25 @@ compute_image_size (size_t width, size_t height,
{
Lisp_Object value;
int desired_width, desired_height;
+ double scale = 1;
+
+ value = image_spec_value (spec, QCscale, NULL);
+ if (NUMBERP (value))
+ scale = extract_float (value);
/* If width and/or height is set in the display spec assume we want
to scale to those values. If either h or w is unspecified, the
unspecified should be calculated from the specified to preserve
aspect ratio. */
value = image_spec_value (spec, QCwidth, NULL);
- desired_width = NATNUMP (value) ? min (XFASTINT (value), INT_MAX) : -1;
+ desired_width = NATNUMP (value) ?
+ min (XFASTINT (value) * scale, INT_MAX) : -1;
value = image_spec_value (spec, QCheight, NULL);
- desired_height = NATNUMP (value) ? min (XFASTINT (value), INT_MAX) : -1;
+ desired_height = NATNUMP (value) ?
+ min (XFASTINT (value) * scale, INT_MAX) : -1;
+
+ width = width * scale;
+ height = height * scale;
if (desired_width == -1)
{
@@ -8136,6 +8137,13 @@ compute_image_size (size_t width, size_t height,
/* h known, calculate w. */
desired_width = scale_image_size (desired_height, height, width);
+ /* We have no width/height settings, so just apply the scale. */
+ if (desired_width == -1 && desired_height == -1)
+ {
+ desired_width = width;
+ desired_height = height;
+ }
+
*d_width = desired_width;
*d_height = desired_height;
}
@@ -8315,8 +8323,8 @@ static struct animation_cache *
imagemagick_create_cache (char *signature)
{
struct animation_cache *cache
- = xmalloc (offsetof (struct animation_cache, signature)
- + strlen (signature) + 1);
+ = xmalloc (FLEXSIZEOF (struct animation_cache, signature,
+ strlen (signature) + 1));
cache->wand = 0;
cache->index = 0;
cache->next = 0;
@@ -8519,7 +8527,6 @@ imagemagick_load_image (struct frame *f, struct image *img,
EMACS_INT ino;
int desired_width, desired_height;
double rotation;
- int pixelwidth;
char hint_buffer[MaxTextExtent];
char *filename_hint = NULL;
@@ -8550,6 +8557,18 @@ imagemagick_load_image (struct frame *f, struct image *img,
return 0;
}
+#ifdef HAVE_MAGICKAUTOORIENTIMAGE
+ /* If no :rotation is explicitly specified, apply the automatic
+ rotation from EXIF. */
+ if (NILP (image_spec_value (img->spec, QCrotation, NULL)))
+ if (MagickAutoOrientImage (image_wand) == MagickFalse)
+ {
+ image_error ("Error applying automatic orientation in image `%s'", img->spec);
+ DestroyMagickWand (image_wand);
+ return 0;
+ }
+#endif
+
if (ino < 0 || ino >= MagickGetNumberImages (image_wand))
{
image_error ("Invalid image number `%s' in image `%s'", image, img->spec);
@@ -8736,7 +8755,7 @@ imagemagick_load_image (struct frame *f, struct image *img,
on rgb display.
seems about 3 times as fast as pixel pushing(not carefully measured)
*/
- pixelwidth = CharPixel; /*??? TODO figure out*/
+ int pixelwidth = CharPixel; /*??? TODO figure out*/
MagickExportImagePixels (image_wand, 0, 0, width, height,
exportdepth, pixelwidth, ximg->data);
}
@@ -8920,7 +8939,7 @@ static bool svg_image_p (Lisp_Object object);
static bool svg_load (struct frame *f, struct image *img);
static bool svg_load_image (struct frame *, struct image *,
- unsigned char *, ptrdiff_t, char *);
+ char *, ptrdiff_t, char *);
/* Indices of image specification fields in svg_format, below. */
@@ -9009,10 +9028,13 @@ svg_image_p (Lisp_Object object)
# ifdef WINDOWSNT
+/* Restore the original definition of __MINGW_MAJOR_VERSION. */
# ifdef W32_SAVE_MINGW_VERSION
# undef __MINGW_MAJOR_VERSION
# define __MINGW_MAJOR_VERSION W32_SAVE_MINGW_VERSION
-# undef W32_SAVE_MINGW_VERSION
+# ifdef __MINGW_MAJOR_VERSION
+# undef W32_SAVE_MINGW_VERSION
+# endif
# endif
/* SVG library functions. */
@@ -9112,7 +9134,9 @@ init_svg_functions (void)
# define gdk_pixbuf_get_width fn_gdk_pixbuf_get_width
# define g_clear_error fn_g_clear_error
# define g_object_unref fn_g_object_unref
-# define g_type_init fn_g_type_init
+# if ! GLIB_CHECK_VERSION (2, 36, 0)
+# define g_type_init fn_g_type_init
+# endif
# define rsvg_handle_close fn_rsvg_handle_close
# define rsvg_handle_get_dimensions fn_rsvg_handle_get_dimensions
# define rsvg_handle_get_pixbuf fn_rsvg_handle_get_pixbuf
@@ -9145,7 +9169,7 @@ svg_load (struct frame *f, struct image *img)
/* Read the entire file into memory. */
ptrdiff_t size;
- unsigned char *contents = slurp_file (fd, &size);
+ char *contents = slurp_file (fd, &size);
if (contents == NULL)
{
image_error ("Error loading SVG image `%s'", file);
@@ -9169,7 +9193,7 @@ svg_load (struct frame *f, struct image *img)
return 0;
}
original_filename = BVAR (current_buffer, filename);
- success_p = svg_load_image (f, img, SDATA (data), SBYTES (data),
+ success_p = svg_load_image (f, img, SSDATA (data), SBYTES (data),
(NILP (original_filename) ? NULL
: SSDATA (original_filename)));
}
@@ -9177,19 +9201,16 @@ svg_load (struct frame *f, struct image *img)
return success_p;
}
-/* svg_load_image is a helper function for svg_load, which does the
- actual loading given contents and size, apart from frame and image
- structures, passed from svg_load.
+/* Load frame F and image IMG. CONTENTS contains the SVG XML data to
+ be parsed, SIZE is its size, and FILENAME is the name of the SVG
+ file being loaded.
- Uses librsvg to do most of the image processing.
+ Use librsvg to do most of the image processing.
- Returns true when successful. */
+ Return true when successful. */
static bool
-svg_load_image (struct frame *f, /* Pointer to emacs frame structure. */
- struct image *img, /* Pointer to emacs image structure. */
- unsigned char *contents, /* String containing the SVG XML data to be parsed. */
- ptrdiff_t size, /* Size of data in bytes. */
- char *filename) /* Name of SVG file being loaded. */
+svg_load_image (struct frame *f, struct image *img, char *contents,
+ ptrdiff_t size, char *filename)
{
RsvgHandle *rsvg_handle;
RsvgDimensionData dimension_data;
@@ -9216,7 +9237,7 @@ svg_load_image (struct frame *f, /* Pointer to emacs frame structure. *
rsvg_handle_set_base_uri(rsvg_handle, filename);
/* Parse the contents argument and fill in the rsvg_handle. */
- rsvg_handle_write (rsvg_handle, contents, size, &err);
+ rsvg_handle_write (rsvg_handle, (unsigned char *) contents, size, &err);
if (err) goto rsvg_error;
/* The parsing is complete, rsvg_handle is ready to used, close it
@@ -9249,8 +9270,8 @@ svg_load_image (struct frame *f, /* Pointer to emacs frame structure. *
eassert (gdk_pixbuf_get_has_alpha (pixbuf));
eassert (gdk_pixbuf_get_bits_per_sample (pixbuf) == 8);
-#ifdef USE_CAIRO
{
+#ifdef USE_CAIRO
unsigned char *data = (unsigned char *) xmalloc (width*height*4);
uint32_t bgcolor = get_spec_bg_or_alpha_as_argb (img, f);
@@ -9276,82 +9297,77 @@ svg_load_image (struct frame *f, /* Pointer to emacs frame structure. *
create_cairo_image_surface (img, data, width, height);
g_object_unref (pixbuf);
- }
#else
- /* Try to create a x pixmap to hold the svg pixmap. */
- XImagePtr ximg;
- if (!image_create_x_image_and_pixmap (f, img, width, height, 0, &ximg, 0))
- {
- g_object_unref (pixbuf);
- return 0;
- }
+ /* Try to create a x pixmap to hold the svg pixmap. */
+ XImagePtr ximg;
+ if (!image_create_x_image_and_pixmap (f, img, width, height, 0, &ximg, 0))
+ {
+ g_object_unref (pixbuf);
+ return 0;
+ }
- init_color_table ();
+ init_color_table ();
- /* Handle alpha channel by combining the image with a background
- color. */
- XColor background;
- Lisp_Object specified_bg = image_spec_value (img->spec, QCbackground, NULL);
- if (!STRINGP (specified_bg)
- || !x_defined_color (f, SSDATA (specified_bg), &background, 0))
- x_query_frame_background_color (f, &background);
-
- /* SVG pixmaps specify transparency in the last byte, so right
- shift 8 bits to get rid of it, since emacs doesn't support
- transparency. */
- background.red >>= 8;
- background.green >>= 8;
- background.blue >>= 8;
-
- /* This loop handles opacity values, since Emacs assumes
- non-transparent images. Each pixel must be "flattened" by
- calculating the resulting color, given the transparency of the
- pixel, and the image background color. */
- for (int y = 0; y < height; ++y)
- {
- for (int x = 0; x < width; ++x)
- {
- int red;
- int green;
- int blue;
- int opacity;
-
- red = *pixels++;
- green = *pixels++;
- blue = *pixels++;
- opacity = *pixels++;
-
- red = ((red * opacity)
- + (background.red * ((1 << 8) - opacity)));
- green = ((green * opacity)
- + (background.green * ((1 << 8) - opacity)));
- blue = ((blue * opacity)
- + (background.blue * ((1 << 8) - opacity)));
-
- XPutPixel (ximg, x, y, lookup_rgb_color (f, red, green, blue));
- }
+ /* Handle alpha channel by combining the image with a background
+ color. */
+ XColor background;
+ Lisp_Object specified_bg = image_spec_value (img->spec, QCbackground, NULL);
+ if (!STRINGP (specified_bg)
+ || !x_defined_color (f, SSDATA (specified_bg), &background, 0))
+ x_query_frame_background_color (f, &background);
+
+ /* SVG pixmaps specify transparency in the last byte, so right
+ shift 8 bits to get rid of it, since emacs doesn't support
+ transparency. */
+ background.red >>= 8;
+ background.green >>= 8;
+ background.blue >>= 8;
+
+ /* This loop handles opacity values, since Emacs assumes
+ non-transparent images. Each pixel must be "flattened" by
+ calculating the resulting color, given the transparency of the
+ pixel, and the image background color. */
+ for (int y = 0; y < height; ++y)
+ {
+ for (int x = 0; x < width; ++x)
+ {
+ int red = *pixels++;
+ int green = *pixels++;
+ int blue = *pixels++;
+ int opacity = *pixels++;
+
+ red = ((red * opacity)
+ + (background.red * ((1 << 8) - opacity)));
+ green = ((green * opacity)
+ + (background.green * ((1 << 8) - opacity)));
+ blue = ((blue * opacity)
+ + (background.blue * ((1 << 8) - opacity)));
+
+ XPutPixel (ximg, x, y, lookup_rgb_color (f, red, green, blue));
+ }
- pixels += rowstride - 4 * width;
- }
+ pixels += rowstride - 4 * width;
+ }
#ifdef COLOR_TABLE_SUPPORT
- /* Remember colors allocated for this image. */
- img->colors = colors_in_color_table (&img->ncolors);
- free_color_table ();
+ /* Remember colors allocated for this image. */
+ img->colors = colors_in_color_table (&img->ncolors);
+ free_color_table ();
#endif /* COLOR_TABLE_SUPPORT */
- g_object_unref (pixbuf);
+ g_object_unref (pixbuf);
- img->width = width;
- img->height = height;
+ img->width = width;
+ img->height = height;
- /* Maybe fill in the background field while we have ximg handy.
- Casting avoids a GCC warning. */
- IMAGE_BACKGROUND (img, f, (XImagePtr_or_DC)ximg);
+ /* Maybe fill in the background field while we have ximg handy.
+ Casting avoids a GCC warning. */
+ IMAGE_BACKGROUND (img, f, (XImagePtr_or_DC)ximg);
- /* Put ximg into the image. */
- image_put_x_image (f, img, ximg, 0);
+ /* Put ximg into the image. */
+ image_put_x_image (f, img, ximg, 0);
#endif /* ! USE_CAIRO */
+ }
return 1;
@@ -9525,7 +9541,7 @@ gs_load (struct frame *f, struct image *img)
{
/* Only W32 version did BLOCK_INPUT here. ++kfs */
block_input ();
- img->pixmap = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ img->pixmap = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
img->width, img->height,
DefaultDepthOfScreen (FRAME_X_SCREEN (f)));
unblock_input ();
@@ -9541,7 +9557,7 @@ gs_load (struct frame *f, struct image *img)
if successful. We do not record_unwind_protect here because
other places in redisplay like calling window scroll functions
don't either. Let the Lisp loader use `unwind-protect' instead. */
- printnum1 = FRAME_X_WINDOW (f);
+ printnum1 = FRAME_X_DRAWABLE (f);
printnum2 = img->pixmap;
window_and_pixmap_id
= make_formatted_string (buffer, "%"pMu" %"pMu, printnum1, printnum2);
@@ -9816,6 +9832,7 @@ non-numeric, there is no explicit limit on the size of images. */);
DEFSYM (QCcrop, ":crop");
DEFSYM (QCrotation, ":rotation");
DEFSYM (QCmatrix, ":matrix");
+ DEFSYM (QCscale, ":scale");
DEFSYM (QCcolor_adjustment, ":color-adjustment");
DEFSYM (QCmask, ":mask");
diff --git a/src/indent.c b/src/indent.c
index 578dac83df5..b68b60297fd 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -296,7 +296,7 @@ skip_invisible (ptrdiff_t pos, ptrdiff_t *next_boundary_p, ptrdiff_t to, Lisp_Ob
if (dp != 0 && VECTORP (DISP_CHAR_VECTOR (dp, ch))) \
width = sanitize_char_width (ASIZE (DISP_CHAR_VECTOR (dp, ch))); \
else \
- width = CHAR_WIDTH (ch); \
+ width = CHARACTER_WIDTH (ch); \
} \
} while (0)
@@ -1162,7 +1162,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
int prev_tab_offset; /* Previous tab offset. */
int continuation_glyph_width;
struct buffer *cache_buffer = current_buffer;
- struct region_cache *width_cache;
+ struct region_cache *width_cache = NULL;
struct composition_it cmp_it;
@@ -1170,11 +1170,14 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
if (cache_buffer->base_buffer)
cache_buffer = cache_buffer->base_buffer;
- width_cache = width_run_cache_on_off ();
if (dp == buffer_display_table ())
- width_table = (VECTORP (BVAR (current_buffer, width_table))
- ? XVECTOR (BVAR (current_buffer, width_table))->contents
- : 0);
+ {
+ width_table = (VECTORP (BVAR (current_buffer, width_table))
+ ? XVECTOR (BVAR (current_buffer, width_table))->contents
+ : 0);
+ if (width_table)
+ width_cache = width_run_cache_on_off ();
+ }
else
/* If the window has its own display table, we can't use the width
run cache, because that's based on the buffer's display table. */
@@ -1873,9 +1876,9 @@ vmotion (register ptrdiff_t from, register ptrdiff_t from_byte,
}
pos = *compute_motion (prevline, bytepos, 0, lmargin, 0, from,
/* Don't care for VPOS... */
- 1 << (BITS_PER_SHORT - 1),
+ 1 << (SHRT_WIDTH - 1),
/* ... nor HPOS. */
- 1 << (BITS_PER_SHORT - 1),
+ 1 << (SHRT_WIDTH - 1),
-1, hscroll, 0, w);
vpos -= pos.vpos;
first = 0;
@@ -1923,9 +1926,9 @@ vmotion (register ptrdiff_t from, register ptrdiff_t from_byte,
}
pos = *compute_motion (prevline, bytepos, 0, lmargin, 0, from,
/* Don't care for VPOS... */
- 1 << (BITS_PER_SHORT - 1),
+ 1 << (SHRT_WIDTH - 1),
/* ... nor HPOS. */
- 1 << (BITS_PER_SHORT - 1),
+ 1 << (SHRT_WIDTH - 1),
-1, hscroll, 0, w);
did_motion = 1;
}
@@ -1936,7 +1939,7 @@ vmotion (register ptrdiff_t from, register ptrdiff_t from_byte,
did_motion = 0;
}
return compute_motion (from, from_byte, vpos, pos.hpos, did_motion,
- ZV, vtarget, - (1 << (BITS_PER_SHORT - 1)),
+ ZV, vtarget, - (1 << (SHRT_WIDTH - 1)),
-1, hscroll, 0, w);
}
@@ -1995,7 +1998,7 @@ whether or not it is currently displayed in some window. */)
struct text_pos pt;
struct window *w;
Lisp_Object old_buffer;
- EMACS_INT old_charpos IF_LINT (= 0), old_bytepos IF_LINT (= 0);
+ EMACS_INT old_charpos UNINIT, old_bytepos UNINIT;
Lisp_Object lcols;
void *itdata = NULL;
@@ -2037,8 +2040,8 @@ whether or not it is currently displayed in some window. */)
bool disp_string_at_start_p = 0;
ptrdiff_t nlines = XINT (lines);
int vpos_init = 0;
- double start_col IF_LINT (= 0);
- int start_x IF_LINT (= 0);
+ double start_col UNINIT;
+ int start_x UNINIT;
int to_x = -1;
bool start_x_given = !NILP (cur_col);
@@ -2179,6 +2182,7 @@ whether or not it is currently displayed in some window. */)
if (nlines <= 0)
{
it.vpos = vpos_init;
+ it.current_y = 0;
/* Do this even if LINES is 0, so that we move back to the
beginning of the current line as we ought. */
if ((nlines < 0 && IT_CHARPOS (it) > 0)
@@ -2188,6 +2192,7 @@ whether or not it is currently displayed in some window. */)
else if (overshoot_handled)
{
it.vpos = vpos_init;
+ it.current_y = 0;
move_it_by_lines (&it, min (PTRDIFF_MAX, nlines));
}
else
@@ -2201,6 +2206,7 @@ whether or not it is currently displayed in some window. */)
while (IT_CHARPOS (it) <= it_start)
{
it.vpos = 0;
+ it.current_y = 0;
move_it_by_lines (&it, 1);
}
if (nlines > 1)
@@ -2209,6 +2215,7 @@ whether or not it is currently displayed in some window. */)
else /* it_start = ZV */
{
it.vpos = 0;
+ it.current_y = 0;
move_it_by_lines (&it, min (PTRDIFF_MAX, nlines));
/* We could have some display or overlay string at ZV,
in which case it.vpos will be nonzero now, while
diff --git a/src/insdel.c b/src/insdel.c
index fc3f19fd581..ed914ec6f75 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -364,6 +364,78 @@ adjust_markers_for_replace (ptrdiff_t from, ptrdiff_t from_byte,
check_markers ();
}
+/* Starting at POS (BYTEPOS), find the byte position corresponding to
+ ENDPOS, which could be either before or after POS. */
+static ptrdiff_t
+count_bytes (ptrdiff_t pos, ptrdiff_t bytepos, ptrdiff_t endpos)
+{
+ eassert (BEG_BYTE <= bytepos && bytepos <= Z_BYTE
+ && BEG <= endpos && endpos <= Z);
+
+ if (pos <= endpos)
+ for ( ; pos < endpos; pos++)
+ INC_POS (bytepos);
+ else
+ for ( ; pos > endpos; pos--)
+ DEC_POS (bytepos);
+
+ return bytepos;
+}
+
+/* Adjust byte positions of markers when their character positions
+ didn't change. This is used in several places that replace text,
+ but keep the character positions of the markers unchanged -- the
+ byte positions could still change due to different numbers of bytes
+ in the new text.
+
+ FROM (FROM_BYTE) and TO (TO_BYTE) specify the region of text where
+ changes have been done. TO_Z, if non-zero, means all the markers
+ whose positions are after TO should also be adjusted. */
+void
+adjust_markers_bytepos (ptrdiff_t from, ptrdiff_t from_byte,
+ ptrdiff_t to, ptrdiff_t to_byte, int to_z)
+{
+ register struct Lisp_Marker *m;
+ ptrdiff_t beg = from, begbyte = from_byte;
+
+ adjust_suspend_auto_hscroll (from, to);
+
+ if (Z == Z_BYTE || (!to_z && to == to_byte))
+ {
+ /* Make sure each affected marker's bytepos is equal to
+ its charpos. */
+ for (m = BUF_MARKERS (current_buffer); m; m = m->next)
+ {
+ if (m->bytepos > from_byte
+ && (to_z || m->bytepos <= to_byte))
+ m->bytepos = m->charpos;
+ }
+ }
+ else
+ {
+ for (m = BUF_MARKERS (current_buffer); m; m = m->next)
+ {
+ /* Recompute each affected marker's bytepos. */
+ if (m->bytepos > from_byte
+ && (to_z || m->bytepos <= to_byte))
+ {
+ if (m->charpos < beg
+ && beg - m->charpos > m->charpos - from)
+ {
+ beg = from;
+ begbyte = from_byte;
+ }
+ m->bytepos = count_bytes (beg, begbyte, m->charpos);
+ beg = m->charpos;
+ begbyte = m->bytepos;
+ }
+ }
+ }
+
+ /* Make sure cached charpos/bytepos is invalid. */
+ clear_charpos_cache (current_buffer);
+}
+
void
buffer_overflow (void)
@@ -1400,6 +1472,16 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new,
if (markers)
adjust_markers_for_replace (from, from_byte, nchars_del, nbytes_del,
inschars, outgoing_insbytes);
+ else
+ {
+ /* The character positions of the markers remain intact, but we
+ still need to update their byte positions, because the
+ deleted and the inserted text might have multibyte sequences
+ which make the original byte positions of the markers
+ invalid. */
+ adjust_markers_bytepos (from, from_byte, from + inschars,
+ from_byte + outgoing_insbytes, 1);
+ }
/* Adjust the overlay center as needed. This must be done after
adjusting the markers that bound the overlays. */
@@ -1515,10 +1597,22 @@ replace_range_2 (ptrdiff_t from, ptrdiff_t from_byte,
eassert (GPT <= GPT_BYTE);
/* Adjust markers for the deletion and the insertion. */
- if (markers
- && ! (nchars_del == 1 && inschars == 1 && nbytes_del == insbytes))
- adjust_markers_for_replace (from, from_byte, nchars_del, nbytes_del,
- inschars, insbytes);
+ if (! (nchars_del == 1 && inschars == 1 && nbytes_del == insbytes))
+ {
+ if (markers)
+ adjust_markers_for_replace (from, from_byte, nchars_del, nbytes_del,
+ inschars, insbytes);
+ else
+ {
+ /* The character positions of the markers remain intact, but
+ we still need to update their byte positions, because the
+ deleted and the inserted text might have multibyte
+ sequences which make the original byte positions of the
+ markers invalid. */
+ adjust_markers_bytepos (from, from_byte, from + inschars,
+ from_byte + insbytes, 1);
+ }
+ }
/* Adjust the overlay center as needed. This must be done after
adjusting the markers that bound the overlays. */
@@ -1596,7 +1690,7 @@ del_range_1 (ptrdiff_t from, ptrdiff_t to, bool prepare, bool ret_string)
/* Like del_range_1 but args are byte positions, not char positions. */
void
-del_range_byte (ptrdiff_t from_byte, ptrdiff_t to_byte, bool prepare)
+del_range_byte (ptrdiff_t from_byte, ptrdiff_t to_byte)
{
ptrdiff_t from, to;
@@ -1612,23 +1706,22 @@ del_range_byte (ptrdiff_t from_byte, ptrdiff_t to_byte, bool prepare)
from = BYTE_TO_CHAR (from_byte);
to = BYTE_TO_CHAR (to_byte);
- if (prepare)
- {
- ptrdiff_t old_from = from, old_to = Z - to;
- ptrdiff_t range_length = to - from;
- prepare_to_modify_buffer (from, to, &from);
- to = from + range_length;
-
- if (old_from != from)
- from_byte = CHAR_TO_BYTE (from);
- if (to > ZV)
- {
- to = ZV;
- to_byte = ZV_BYTE;
- }
- else if (old_to == Z - to)
- to_byte = CHAR_TO_BYTE (to);
- }
+ {
+ ptrdiff_t old_from = from, old_to = Z - to;
+ ptrdiff_t range_length = to - from;
+ prepare_to_modify_buffer (from, to, &from);
+ to = from + range_length;
+
+ if (old_from != from)
+ from_byte = CHAR_TO_BYTE (from);
+ if (to > ZV)
+ {
+ to = ZV;
+ to_byte = ZV_BYTE;
+ }
+ else if (old_to == Z - to)
+ to_byte = CHAR_TO_BYTE (to);
+ }
del_range_2 (from, from_byte, to, to_byte, 0);
signal_after_change (from, to - from, 0);
diff --git a/src/intervals.c b/src/intervals.c
index 8451069708c..e797e25ce9c 100644
--- a/src/intervals.c
+++ b/src/intervals.c
@@ -1821,11 +1821,16 @@ set_point (ptrdiff_t charpos)
void
set_point_from_marker (Lisp_Object marker)
{
+ ptrdiff_t charpos = clip_to_bounds (BEGV, marker_position (marker), ZV);
+ ptrdiff_t bytepos = marker_byte_position (marker);
+
+ /* Don't trust the byte position if the marker belongs to a
+ different buffer. */
if (XMARKER (marker)->buffer != current_buffer)
- signal_error ("Marker points into wrong buffer", marker);
- set_point_both
- (clip_to_bounds (BEGV, marker_position (marker), ZV),
- clip_to_bounds (BEGV_BYTE, marker_byte_position (marker), ZV_BYTE));
+ bytepos = buf_charpos_to_bytepos (current_buffer, charpos);
+ else
+ bytepos = clip_to_bounds (BEGV_BYTE, bytepos, ZV_BYTE);
+ set_point_both (charpos, bytepos);
}
/* If there's an invisible character at position POS + TEST_OFFS in the
diff --git a/src/intervals.h b/src/intervals.h
index b8cdcfdc0f5..9a38d849b88 100644
--- a/src/intervals.h
+++ b/src/intervals.h
@@ -197,12 +197,12 @@ set_interval_plist (INTERVAL i, Lisp_Object plist)
/* Is this interval writable? Replace later with cache access. */
#define INTERVAL_WRITABLE_P(i) \
- (i && (NILP (textget ((i)->plist, Qread_only)) \
- || !NILP (textget ((i)->plist, Qinhibit_read_only)) \
- || ((CONSP (Vinhibit_read_only) \
- ? !NILP (Fmemq (textget ((i)->plist, Qread_only), \
- Vinhibit_read_only)) \
- : !NILP (Vinhibit_read_only))))) \
+ (NILP (textget ((i)->plist, Qread_only)) \
+ || !NILP (textget ((i)->plist, Qinhibit_read_only)) \
+ || ((CONSP (Vinhibit_read_only) \
+ ? !NILP (Fmemq (textget ((i)->plist, Qread_only), \
+ Vinhibit_read_only)) \
+ : !NILP (Vinhibit_read_only))))
/* Macros to tell whether insertions before or after this interval
should stick to it. Now we have Vtext_property_default_nonsticky,
@@ -285,7 +285,7 @@ extern void set_text_properties_1 (Lisp_Object, Lisp_Object,
Lisp_Object text_property_list (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object);
void add_text_properties_from_list (Lisp_Object, Lisp_Object, Lisp_Object);
-Lisp_Object extend_property_ranges (Lisp_Object, Lisp_Object);
+Lisp_Object extend_property_ranges (Lisp_Object, Lisp_Object, Lisp_Object);
Lisp_Object get_char_property_and_overlay (Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object*);
extern int text_property_stickiness (Lisp_Object prop, Lisp_Object pos,
diff --git a/src/keyboard.c b/src/keyboard.c
index f24d86e8833..65938a5eb56 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -75,6 +75,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
# pragma GCC diagnostic ignored "-Wclobbered"
#endif
+#ifdef WINDOWSNT
+char const DEV_TTY[] = "CONOUT$";
+#else
+char const DEV_TTY[] = "/dev/tty";
+#endif
+
/* Variables for blockinput.h: */
/* Positive if interrupt input is blocked right now. */
@@ -696,7 +702,7 @@ recursive_edit_1 (void)
val = command_loop ();
if (EQ (val, Qt))
- Fsignal (Qquit, Qnil);
+ quit ();
/* Handle throw from read_minibuf when using minibuffer
while it's active but we're in another window. */
if (STRINGP (val))
@@ -2135,7 +2141,7 @@ read_event_from_main_queue (struct timespec *end_time,
{
Lisp_Object c = Qnil;
sys_jmp_buf save_jump;
- KBOARD *kb IF_LINT (= NULL);
+ KBOARD *kb;
start:
@@ -2206,8 +2212,8 @@ read_decoded_event_from_main_queue (struct timespec *end_time,
Lisp_Object prev_event,
bool *used_mouse_menu)
{
-#define MAX_ENCODED_BYTES 16
#ifndef WINDOWSNT
+#define MAX_ENCODED_BYTES 16
Lisp_Object events[MAX_ENCODED_BYTES];
int n = 0;
#endif
@@ -2847,7 +2853,16 @@ read_char (int commandflag, Lisp_Object map,
last_input_event = c;
call4 (Qcommand_execute, tem, Qnil, Fvector (1, &last_input_event), Qt);
- if (CONSP (c) && EQ (XCAR (c), Qselect_window) && !end_time)
+ if (CONSP (c)
+ && (EQ (XCAR (c), Qselect_window)
+#ifdef HAVE_DBUS
+ || EQ (XCAR (c), Qdbus_event)
+#endif
+#ifdef USE_FILE_NOTIFY
+ || EQ (XCAR (c), Qfile_notify)
+#endif
+ || EQ (XCAR (c), Qconfig_changed_event))
+ && !end_time)
/* We stopped being idle for this event; undo that. This
prevents automatic window selection (under
mouse-autoselect-window) from acting as a real input event, for
@@ -3897,6 +3912,16 @@ kbd_buffer_get_event (KBOARD **kbp,
kbd_fetch_ptr = event + 1;
}
#endif
+
+#ifdef HAVE_NTGUI
+ else if (event->kind == END_SESSION_EVENT)
+ {
+ /* Make an event (end-session). */
+ obj = list1 (Qend_session);
+ kbd_fetch_ptr = event + 1;
+ }
+#endif
+
#if defined (HAVE_X11) || defined (HAVE_NTGUI) \
|| defined (HAVE_NS)
else if (event->kind == ICONIFY_EVENT)
@@ -5392,6 +5417,36 @@ make_lispy_event (struct input_event *event)
{
c &= 0377;
eassert (c == event->code);
+ }
+
+ /* Caps-lock shouldn't affect interpretation of key chords:
+ Control+s should produce C-s whether caps-lock is on or
+ not. And Control+Shift+s should produce C-S-s whether
+ caps-lock is on or not. */
+ if (event->modifiers & ~shift_modifier)
+ {
+ /* This is a key chord: some non-shift modifier is
+ depressed. */
+
+ if (uppercasep (c) &&
+ !(event->modifiers & shift_modifier))
+ {
+ /* Got a capital letter without a shift. The caps
+ lock is on. Un-capitalize the letter. */
+ c = downcase (c);
+ }
+ else if (lowercasep (c) &&
+ (event->modifiers & shift_modifier))
+ {
+ /* Got a lower-case letter even though shift is
+ depressed. The caps lock is on. Capitalize the
+ letter. */
+ c = upcase (c);
+ }
+ }
+
+ if (event->kind == ASCII_KEYSTROKE_EVENT)
+ {
/* Turn ASCII characters into control characters
when proper. */
if (event->modifiers & ctrl_modifier)
@@ -5984,7 +6039,6 @@ make_lispy_event (struct input_event *event)
}
#endif
-
#if defined HAVE_INOTIFY || defined HAVE_KQUEUE || defined HAVE_GFILENOTIFY
case FILE_NOTIFY_EVENT:
{
@@ -6603,7 +6657,12 @@ has the same base event type and all the specified modifiers. */)
int
parse_solitary_modifier (Lisp_Object symbol)
{
- Lisp_Object name = SYMBOL_NAME (symbol);
+ Lisp_Object name;
+
+ if (!SYMBOLP (symbol))
+ return 0;
+
+ name = SYMBOL_NAME (symbol);
switch (SREF (name, 0))
{
@@ -6884,7 +6943,10 @@ tty_read_avail_input (struct terminal *terminal,
the kbd_buffer can really hold. That may prevent loss
of characters on some systems when input is stuffed at us. */
unsigned char cbuf[KBD_BUFFER_SIZE - 1];
- int n_to_read, i;
+#ifndef WINDOWSNT
+ int n_to_read;
+#endif
+ int i;
struct tty_display_info *tty = terminal->display_info.tty;
int nread = 0;
#ifdef subprocesses
@@ -7560,7 +7622,7 @@ menu_item_eval_property_1 (Lisp_Object arg)
/* If we got a quit from within the menu computation,
quit all the way out of it. This takes care of C-] in the debugger. */
if (CONSP (arg) && EQ (XCAR (arg), Qquit))
- Fsignal (Qquit, Qnil);
+ quit ();
return Qnil;
}
@@ -8833,7 +8895,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
/* The length of the echo buffer when we started reading, and
the length of this_command_keys when we started reading. */
- ptrdiff_t echo_start IF_LINT (= 0);
+ ptrdiff_t echo_start UNINIT;
ptrdiff_t keys_start;
Lisp_Object current_binding = Qnil;
@@ -8881,7 +8943,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
While we're reading, we keep the event here. */
Lisp_Object delayed_switch_frame;
- Lisp_Object original_uppercase IF_LINT (= Qnil);
+ Lisp_Object original_uppercase UNINIT;
int original_uppercase_position = -1;
/* Gets around Microsoft compiler limitations. */
@@ -8991,7 +9053,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
while those allow us to restart the entire key sequence,
echo_local_start and keys_local_start allow us to throw away
just one key. */
- ptrdiff_t echo_local_start IF_LINT (= 0);
+ ptrdiff_t echo_local_start UNINIT;
int keys_local_start;
Lisp_Object new_binding;
@@ -10026,11 +10088,9 @@ DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
doc: /* Return the current depth in recursive edits. */)
(void)
{
- Lisp_Object temp;
- /* Wrap around reliably on integer overflow. */
- EMACS_INT sum = (command_loop_level & INTMASK) + (minibuf_level & INTMASK);
- XSETINT (temp, sum);
- return temp;
+ EMACS_INT sum;
+ INT_ADD_WRAPV (command_loop_level, minibuf_level, &sum);
+ return make_number (sum);
}
DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
@@ -10215,7 +10275,7 @@ static void
handle_interrupt_signal (int sig)
{
/* See if we have an active terminal on our controlling tty. */
- struct terminal *terminal = get_named_terminal ("/dev/tty");
+ struct terminal *terminal = get_named_terminal (DEV_TTY);
if (!terminal)
{
/* If there are no frames there, let's pretend that we are a
@@ -10284,7 +10344,7 @@ handle_interrupt (bool in_signal_handler)
cancel_echoing ();
/* XXX This code needs to be revised for multi-tty support. */
- if (!NILP (Vquit_flag) && get_named_terminal ("/dev/tty"))
+ if (!NILP (Vquit_flag) && get_named_terminal (DEV_TTY))
{
if (! in_signal_handler)
{
@@ -10322,6 +10382,9 @@ handle_interrupt (bool in_signal_handler)
is used. Note that [Enter] is not echoed by dos. */
cursor_to (SELECTED_FRAME (), 0, 0);
#endif
+
+ write_stdout ("Emacs is resuming after an emergency escape.\n");
+
/* It doesn't work to autosave while GC is in progress;
the code used for auto-saving doesn't cope with the mark bit. */
if (!gc_in_progress)
@@ -10383,7 +10446,7 @@ handle_interrupt (bool in_signal_handler)
immediate_quit = false;
pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
saved = gl_state;
- Fsignal (Qquit, Qnil);
+ quit ();
gl_state = saved;
}
else
@@ -10580,7 +10643,7 @@ process.
See also `current-input-mode'. */)
(Lisp_Object quit)
{
- struct terminal *t = get_named_terminal ("/dev/tty");
+ struct terminal *t = get_named_terminal (DEV_TTY);
struct tty_display_info *tty;
if (!t)
@@ -10727,11 +10790,19 @@ The `posn-' functions access elements of such lists. */)
{
Lisp_Object x = XCAR (tem);
Lisp_Object y = XCAR (XCDR (tem));
+ Lisp_Object aux_info = XCDR (XCDR (tem));
+ int y_coord = XINT (y);
/* Point invisible due to hscrolling? X can be -1 when a
newline in a R2L line overflows into the left fringe. */
if (XINT (x) < -1)
return Qnil;
+ if (!NILP (aux_info) && y_coord < 0)
+ {
+ int rtop = XINT (XCAR (aux_info));
+
+ y = make_number (y_coord + rtop);
+ }
tem = Fposn_at_x_y (x, y, window, Qnil);
}
@@ -10988,6 +11059,7 @@ syms_of_keyboard (void)
#ifdef HAVE_NTGUI
DEFSYM (Qlanguage_change, "language-change");
+ DEFSYM (Qend_session, "end-session");
#endif
#ifdef HAVE_DBUS
@@ -11729,6 +11801,25 @@ Currently, the only supported values for this
variable are `sigusr1' and `sigusr2'. */);
Vdebug_on_event = intern_c_string ("sigusr2");
+ DEFVAR_BOOL ("attempt-stack-overflow-recovery",
+ attempt_stack_overflow_recovery,
+ doc: /* If non-nil, attempt to recover from C stack
+overflow. This recovery is unsafe and may lead to deadlocks or data
+corruption, but it usually works and may preserve modified buffers
+that would otherwise be lost. If nil, treat stack overflow like any
+other kind of crash. */);
+ attempt_stack_overflow_recovery = true;
+
+ DEFVAR_BOOL ("attempt-orderly-shutdown-on-fatal-signal",
+ attempt_orderly_shutdown_on_fatal_signal,
+ doc: /* If non-nil, attempt to perform an orderly
+shutdown when Emacs receives a fatal signal (e.g., a crash).
+This cleanup is unsafe and may lead to deadlocks or data corruption,
+but it usually works and may preserve modified buffers that would
+otherwise be lost. If nil, crash immediately in response to fatal
+signals. */);
+ attempt_orderly_shutdown_on_fatal_signal = true;
+
/* Create the initial keyboard. Qt means 'unset'. */
initial_kboard = allocate_kboard (Qt);
}
@@ -11744,6 +11835,10 @@ keys_of_keyboard (void)
initial_define_lispy_key (Vspecial_event_map, "delete-frame",
"handle-delete-frame");
+#ifdef HAVE_NTGUI
+ initial_define_lispy_key (Vspecial_event_map, "end-session",
+ "kill-emacs");
+#endif
initial_define_lispy_key (Vspecial_event_map, "ns-put-working-text",
"ns-put-working-text");
initial_define_lispy_key (Vspecial_event_map, "ns-unput-working-text",
diff --git a/src/keyboard.h b/src/keyboard.h
index 387378750c8..a5ed5e10a98 100644
--- a/src/keyboard.h
+++ b/src/keyboard.h
@@ -496,6 +496,8 @@ extern void mark_kboards (void);
extern const char *const lispy_function_keys[];
#endif
+extern char const DEV_TTY[];
+
INLINE_HEADER_END
#endif /* EMACS_KEYBOARD_H */
diff --git a/src/keymap.c b/src/keymap.c
index c975aad27d8..c4a59adff5b 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -41,6 +41,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
+#include <stdlib.h>
#include "lisp.h"
#include "commands.h"
@@ -971,8 +972,18 @@ copy_keymap_1 (Lisp_Object chartable, Lisp_Object idx, Lisp_Object elt)
DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
doc: /* Return a copy of the keymap KEYMAP.
-The copy starts out with the same definitions of KEYMAP,
-but changing either the copy or KEYMAP does not affect the other.
+
+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:
+
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map <theirmap>)
+ (define-key map ...)
+ ...)
+
+After performing `copy-keymap', the copy starts out with the same definitions
+of KEYMAP, but changing either the copy or KEYMAP does not affect the other.
Any key definitions that are subkeymaps are recursively copied.
However, a key definition which is a symbol whose definition is a keymap
is not copied. */)
@@ -1303,7 +1314,7 @@ silly_event_symbol_error (Lisp_Object c)
*p = 0;
c = reorder_modifiers (c);
- AUTO_STRING (new_mods_string, new_mods);
+ AUTO_STRING_WITH_LEN (new_mods_string, new_mods, p - new_mods);
keystring = concat2 (new_mods_string, XCDR (assoc));
error ("To bind the key %s, use [?%s], not [%s]",
diff --git a/src/kqueue.c b/src/kqueue.c
index 49ca0c95e27..d1d0a612044 100644
--- a/src/kqueue.c
+++ b/src/kqueue.c
@@ -29,6 +29,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "keyboard.h"
#include "process.h"
+#ifdef HAVE_SYS_RESOURCE_H
+#include <sys/resource.h>
+#endif /* HAVE_SYS_RESOURCE_H */
+
/* File handle for kqueue. */
static int kqueuefd = -1;
@@ -364,9 +368,12 @@ only when the upper directory of the renamed file is watched. */)
(Lisp_Object file, Lisp_Object flags, Lisp_Object callback)
{
Lisp_Object watch_object, dir_list;
- int fd, oflags;
+ int maxfd, fd, oflags;
u_short fflags = 0;
struct kevent kev;
+#ifdef HAVE_GETRLIMIT
+ struct rlimit rlim;
+#endif /* HAVE_GETRLIMIT */
/* Check parameters. */
CHECK_STRING (file);
@@ -379,6 +386,21 @@ only when the upper directory of the renamed file is watched. */)
if (! FUNCTIONP (callback))
wrong_type_argument (Qinvalid_function, callback);
+ /* Check available file descriptors. */
+#ifdef HAVE_GETRLIMIT
+ if (! getrlimit (RLIMIT_NOFILE, &rlim))
+ maxfd = rlim.rlim_cur;
+ else
+#endif /* HAVE_GETRLIMIT */
+ maxfd = 256;
+
+ /* We assume 50 file descriptors are sufficient for the rest of Emacs. */
+ if ((maxfd - 50) < XINT (Flength (watch_list)))
+ xsignal2
+ (Qfile_notify_error,
+ build_string ("File watching not possible, no file descriptor left"),
+ Flength (watch_list));
+
if (kqueuefd < 0)
{
/* Create kqueue descriptor. */
diff --git a/src/lastfile.c b/src/lastfile.c
index d516093b297..9d70b001d11 100644
--- a/src/lastfile.c
+++ b/src/lastfile.c
@@ -38,7 +38,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "lisp.h"
+#if ((!defined SYSTEM_MALLOC && !defined HYBRID_MALLOC) \
+ || defined WINDOWSNT || defined CYGWIN || defined DARWIN_OS)
char my_edata[] = "End of Emacs initialized data";
+#endif
/* Help unexec locate the end of the .bss area used by Emacs (which
isn't always a separate section in NT executables). */
diff --git a/src/lisp.h b/src/lisp.h
index 25f811e06ef..e087828d94f 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -21,10 +21,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifndef EMACS_LISP_H
#define EMACS_LISP_H
+#include <alloca.h>
#include <setjmp.h>
#include <stdalign.h>
#include <stdarg.h>
#include <stddef.h>
+#include <string.h>
#include <float.h>
#include <inttypes.h>
#include <limits.h>
@@ -68,6 +70,7 @@ DEFINE_GDB_SYMBOL_BEGIN (int, GCTYPEBITS)
DEFINE_GDB_SYMBOL_END (GCTYPEBITS)
/* EMACS_INT - signed integer wide enough to hold an Emacs value
+ EMACS_INT_WIDTH - width in bits of EMACS_INT
EMACS_INT_MAX - maximum value of EMACS_INT; can be used in #if
pI - printf length modifier for EMACS_INT
EMACS_UINT - unsigned variant of EMACS_INT */
@@ -77,18 +80,25 @@ DEFINE_GDB_SYMBOL_END (GCTYPEBITS)
# elif INTPTR_MAX <= INT_MAX && !defined WIDE_EMACS_INT
typedef int EMACS_INT;
typedef unsigned int EMACS_UINT;
+enum { EMACS_INT_WIDTH = INT_WIDTH };
# define EMACS_INT_MAX INT_MAX
# define pI ""
# elif INTPTR_MAX <= LONG_MAX && !defined WIDE_EMACS_INT
typedef long int EMACS_INT;
typedef unsigned long EMACS_UINT;
+enum { EMACS_INT_WIDTH = LONG_WIDTH };
# define EMACS_INT_MAX LONG_MAX
# define pI "l"
# elif INTPTR_MAX <= LLONG_MAX
typedef long long int EMACS_INT;
typedef unsigned long long int EMACS_UINT;
+enum { EMACS_INT_WIDTH = LLONG_WIDTH };
# define EMACS_INT_MAX LLONG_MAX
-# define pI "ll"
+# ifdef __MINGW32__
+# define pI "I64"
+# else
+# define pI "ll"
+# endif
# else
# error "INTPTR_MAX too large"
# endif
@@ -103,11 +113,12 @@ enum { BOOL_VECTOR_BITS_PER_CHAR =
/* An unsigned integer type representing a fixed-length bit sequence,
suitable for bool vector words, GC mark bits, etc. Normally it is size_t
- for speed, but it is unsigned char on weird platforms. */
+ for speed, but on weird platforms it is unsigned char and not all
+ its bits are used. */
#if BOOL_VECTOR_BITS_PER_CHAR == CHAR_BIT
typedef size_t bits_word;
# define BITS_WORD_MAX SIZE_MAX
-enum { BITS_PER_BITS_WORD = CHAR_BIT * sizeof (bits_word) };
+enum { BITS_PER_BITS_WORD = SIZE_WIDTH };
#else
typedef unsigned char bits_word;
# define BITS_WORD_MAX ((1u << BOOL_VECTOR_BITS_PER_CHAR) - 1)
@@ -115,15 +126,6 @@ enum { BITS_PER_BITS_WORD = BOOL_VECTOR_BITS_PER_CHAR };
#endif
verify (BITS_WORD_MAX >> (BITS_PER_BITS_WORD - 1) == 1);
-/* Number of bits in some machine integer types. */
-enum
- {
- BITS_PER_CHAR = CHAR_BIT,
- BITS_PER_SHORT = CHAR_BIT * sizeof (short),
- BITS_PER_LONG = CHAR_BIT * sizeof (long int),
- BITS_PER_EMACS_INT = CHAR_BIT * sizeof (EMACS_INT)
- };
-
/* printmax_t and uprintmax_t are types for printing large integers.
These are the widest integers that are supported for printing.
pMd etc. are conversions for printing them.
@@ -228,7 +230,7 @@ enum Lisp_Bits
#define GCALIGNMENT 8
/* Number of bits in a Lisp_Object value, not counting the tag. */
- VALBITS = BITS_PER_EMACS_INT - GCTYPEBITS,
+ VALBITS = EMACS_INT_WIDTH - GCTYPEBITS,
/* Number of bits in a Lisp fixnum tag. */
INTTYPEBITS = GCTYPEBITS - 1,
@@ -341,7 +343,9 @@ error !;
(struct Lisp_Symbol *) ((intptr_t) XLI (a) - Lisp_Symbol \
+ (char *) lispsym))
# define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK))
-# define lisp_h_XUNTAG(a, type) ((void *) (intptr_t) (XLI (a) - (type)))
+# define lisp_h_XUNTAG(a, type) \
+ __builtin_assume_aligned ((void *) (intptr_t) (XLI (a) - (type)), \
+ GCALIGNMENT)
#endif
/* When compiling via gcc -O0, define the key operations as macros, as
@@ -600,7 +604,9 @@ extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object);
extern _Noreturn void wrong_choice (Lisp_Object, Lisp_Object);
/* Defined in emacs.c. */
+#ifdef DOUG_LEA_MALLOC
extern bool might_dump;
+#endif
/* True means Emacs has already been initialized.
Used during startup to detect startup of dumped Emacs. */
extern bool initialized;
@@ -719,12 +725,16 @@ struct Lisp_Symbol
except the former expands to an integer constant expression. */
#define XLI_BUILTIN_LISPSYM(iname) TAG_SYMOFFSET ((iname) * sizeof *lispsym)
+/* LISPSYM_INITIALLY (Qfoo) is equivalent to Qfoo except it is
+ designed for use as an initializer, even for a constant initializer. */
+#define LISPSYM_INITIALLY(name) LISP_INITIALLY (XLI_BUILTIN_LISPSYM (i##name))
+
/* Declare extern constants for Lisp symbols. These can be helpful
when using a debugger like GDB, on older platforms where the debug
format does not represent C macros. */
#define DEFINE_LISP_SYMBOL(name) \
DEFINE_GDB_SYMBOL_BEGIN (Lisp_Object, name) \
- DEFINE_GDB_SYMBOL_END (LISP_INITIALLY (XLI_BUILTIN_LISPSYM (i##name)))
+ DEFINE_GDB_SYMBOL_END (LISPSYM_INITIALLY (name))
/* By default, define macros for Qt, etc., as this leads to a bit
better performance in the core Emacs interpreter. A plugin can
@@ -1417,13 +1427,6 @@ struct Lisp_Vector
Lisp_Object contents[FLEXIBLE_ARRAY_MEMBER];
};
-/* C11 prohibits alignof (struct Lisp_Vector), so compute it manually. */
-enum
- {
- ALIGNOF_STRUCT_LISP_VECTOR
- = alignof (union { struct vectorlike_header a; Lisp_Object b; })
- };
-
/* A boolvector is a kind of vectorlike, with contents like a string. */
struct Lisp_Bool_Vector
@@ -1740,7 +1743,7 @@ struct Lisp_Subr
short min_args, max_args;
const char *symbol_name;
const char *intspec;
- const char *doc;
+ EMACS_INT doc;
};
enum char_table_specials
@@ -2022,7 +2025,7 @@ static double const DEFAULT_REHASH_SIZE = 1.5;
INLINE EMACS_UINT
sxhash_combine (EMACS_UINT x, EMACS_UINT y)
{
- return (x << 4) + (x >> (BITS_PER_EMACS_INT - 4)) + y;
+ return (x << 4) + (x >> (EMACS_INT_WIDTH - 4)) + y;
}
/* Hash X, returning a value that fits into a fixnum. */
@@ -2030,7 +2033,7 @@ sxhash_combine (EMACS_UINT x, EMACS_UINT y)
INLINE EMACS_UINT
SXHASH_REDUCE (EMACS_UINT x)
{
- return (x ^ x >> (BITS_PER_EMACS_INT - FIXNUM_BITS)) & INTMASK;
+ return (x ^ x >> (EMACS_INT_WIDTH - FIXNUM_BITS)) & INTMASK;
}
/* These structures are used for various misc types. */
@@ -3032,12 +3035,6 @@ extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int);
defvar_int (&i_fwd, lname, &globals.f_ ## vname); \
} while (false)
-#define DEFVAR_BUFFER_DEFAULTS(lname, vname, doc) \
- do { \
- static struct Lisp_Objfwd o_fwd; \
- defvar_lisp_nopro (&o_fwd, lname, &BVAR (&buffer_defaults, vname)); \
- } while (false)
-
#define DEFVAR_KBOARD(lname, vname, doc) \
do { \
static struct Lisp_Kboard_Objfwd ko_fwd; \
@@ -3190,7 +3187,6 @@ struct handler
ptrdiff_t pdlcount;
int poll_suppress_count;
int interrupt_input_blocked;
- struct byte_stack *byte_stack;
};
extern Lisp_Object memory_signal_data;
@@ -3439,7 +3435,7 @@ ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *);
ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
EMACS_UINT);
void hash_remove_from_table (struct Lisp_Hash_Table *, Lisp_Object);
-extern struct hash_table_test hashtest_eq, hashtest_eql, hashtest_equal;
+extern struct hash_table_test const hashtest_eq, hashtest_eql, hashtest_equal;
extern void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object,
ptrdiff_t, ptrdiff_t *, ptrdiff_t *);
extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t,
@@ -3503,7 +3499,7 @@ extern void insert_from_string_before_markers (Lisp_Object, ptrdiff_t,
ptrdiff_t, bool);
extern void del_range (ptrdiff_t, ptrdiff_t);
extern Lisp_Object del_range_1 (ptrdiff_t, ptrdiff_t, bool, bool);
-extern void del_range_byte (ptrdiff_t, ptrdiff_t, bool);
+extern void del_range_byte (ptrdiff_t, ptrdiff_t);
extern void del_range_both (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, bool);
extern Lisp_Object del_range_2 (ptrdiff_t, ptrdiff_t,
ptrdiff_t, ptrdiff_t, bool);
@@ -3516,6 +3512,8 @@ extern void adjust_after_insert (ptrdiff_t, ptrdiff_t, ptrdiff_t,
ptrdiff_t, ptrdiff_t);
extern void adjust_markers_for_delete (ptrdiff_t, ptrdiff_t,
ptrdiff_t, ptrdiff_t);
+extern void adjust_markers_bytepos (ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t, int);
extern void replace_range (ptrdiff_t, ptrdiff_t, Lisp_Object, bool, bool, bool, bool);
extern void replace_range_2 (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t,
const char *, ptrdiff_t, ptrdiff_t, bool);
@@ -3584,13 +3582,8 @@ extern void mark_object (Lisp_Object);
#if defined REL_ALLOC && !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC
extern void refill_memory_reserve (void);
#endif
-#ifdef DOUG_LEA_MALLOC
extern void alloc_unexec_pre (void);
extern void alloc_unexec_post (void);
-#else
-INLINE void alloc_unexec_pre (void) {}
-INLINE void alloc_unexec_post (void) {}
-#endif
extern const char *pending_malloc_warning;
extern Lisp_Object zero_vector;
extern Lisp_Object *stack_base;
@@ -3728,7 +3721,6 @@ extern struct Lisp_Vector *allocate_pseudovector (int, int, int,
VECSIZE (type), tag))
extern bool gc_in_progress;
-extern bool abort_on_gc;
extern Lisp_Object make_float (double);
extern void display_malloc_warning (void);
extern ptrdiff_t inhibit_garbage_collection (void);
@@ -3756,6 +3748,15 @@ extern void check_cons_list (void);
INLINE void (check_cons_list) (void) { lisp_h_check_cons_list (); }
#endif
+/* Defined in gmalloc.c. */
+#if !defined DOUG_LEA_MALLOC && !defined HYBRID_MALLOC && !defined SYSTEM_MALLOC
+extern size_t __malloc_extra_blocks;
+#endif
+#if !HAVE_DECL_ALIGNED_ALLOC
+extern void *aligned_alloc (size_t, size_t) ATTRIBUTE_MALLOC_SIZE ((2));
+#endif
+extern void malloc_enable_thread (void);
+
#ifdef REL_ALLOC
/* Defined in ralloc.c. */
extern void *r_alloc (void **, size_t) ATTRIBUTE_ALLOC_SIZE ((2));
@@ -3861,7 +3862,12 @@ extern void run_hook_with_args_2 (Lisp_Object, Lisp_Object, Lisp_Object);
extern Lisp_Object run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args,
Lisp_Object (*funcall)
(ptrdiff_t nargs, Lisp_Object *args));
-extern _Noreturn void xsignal (Lisp_Object, Lisp_Object);
+extern Lisp_Object quit (void);
+INLINE _Noreturn void
+xsignal (Lisp_Object error_symbol, Lisp_Object data)
+{
+ Fsignal (error_symbol, data);
+}
extern _Noreturn void xsignal0 (Lisp_Object);
extern _Noreturn void xsignal1 (Lisp_Object, Lisp_Object);
extern _Noreturn void xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object);
@@ -3901,6 +3907,8 @@ extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object);
extern _Noreturn void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
extern _Noreturn void 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 call_debugger (Lisp_Object arg);
extern void *near_C_stack_top (void);
@@ -4119,6 +4127,7 @@ INLINE void fixup_locale (void) {}
INLINE void synchronize_system_messages_locale (void) {}
INLINE void synchronize_system_time_locale (void) {}
#endif
+extern char *emacs_strerror (int);
extern void shut_down_emacs (int, Lisp_Object);
/* True means don't do interactive redisplay and don't change tty modes. */
@@ -4127,12 +4136,14 @@ extern bool noninteractive;
/* True means remove site-lisp directories from load-path. */
extern bool no_site_lisp;
-/* Pipe used to send exit notification to the daemon parent at
- startup. On Windows, we use a kernel event instead. */
+/* True means put details like time stamps into builds. */
+extern bool build_details;
+
#ifndef WINDOWSNT
-extern int daemon_pipe[2];
-#define IS_DAEMON (daemon_pipe[1] != 0)
-#define DAEMON_RUNNING (daemon_pipe[1] >= 0)
+/* 0 not a daemon, 1 new-style (foreground), 2 old-style (background). */
+extern int daemon_type;
+#define IS_DAEMON (daemon_type != 0)
+#define DAEMON_RUNNING (daemon_type >= 0)
#else /* WINDOWSNT */
extern void *w32_daemon_event;
#define IS_DAEMON (w32_daemon_event != NULL)
@@ -4152,8 +4163,8 @@ extern void kill_buffer_processes (Lisp_Object);
extern int wait_reading_process_output (intmax_t, int, int, bool, Lisp_Object,
struct Lisp_Process *, int);
/* Max value for the first argument of wait_reading_process_output. */
-#if __GNUC__ == 3 || (__GNUC__ == 4 && __GNUC_MINOR__ <= 5)
-/* Work around a bug in GCC 3.4.2, known to be fixed in GCC 4.6.3.
+#if GNUC_PREREQ (3, 0, 0) && ! GNUC_PREREQ (4, 6, 0)
+/* Work around a bug in GCC 3.4.2, known to be fixed in GCC 4.6.0.
The bug merely causes a bogus warning, but the warning is annoying. */
# define WAIT_READING_MAX min (TYPE_MAXIMUM (time_t), INTMAX_MAX)
#else
@@ -4168,7 +4179,7 @@ extern void delete_keyboard_wait_descriptor (int);
extern void add_gpm_wait_descriptor (int);
extern void delete_gpm_wait_descriptor (int);
#endif
-extern void init_process_emacs (void);
+extern void init_process_emacs (int);
extern void syms_of_process (void);
extern void setup_process_coding_systems (Lisp_Object);
@@ -4202,10 +4213,9 @@ extern int read_bytecode_char (bool);
/* Defined in bytecode.c. */
extern void syms_of_bytecode (void);
-extern struct byte_stack *byte_stack_list;
-extern void relocate_byte_stack (void);
extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object, ptrdiff_t, Lisp_Object *);
+extern Lisp_Object get_byte_code_arity (Lisp_Object);
/* Defined in macros.c. */
extern void init_macros (void);
@@ -4238,9 +4248,14 @@ struct tty_display_info;
struct terminal;
/* Defined in sysdep.c. */
-#ifndef HAVE_GET_CURRENT_DIR_NAME
-extern char *get_current_dir_name (void);
+#ifdef HAVE_PERSONALITY_ADDR_NO_RANDOMIZE
+extern bool disable_address_randomization (void);
+#else
+INLINE bool disable_address_randomization (void) { return false; }
#endif
+extern int emacs_exec_file (char const *, char *const *, char *const *);
+extern void init_standard_fds (void);
+extern char *emacs_get_current_dir_name (void);
extern void stuff_char (char c);
extern void init_foreground_group (void);
extern void sys_subshell (void);
@@ -4495,12 +4510,14 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1));
} \
} while (false)
-/* SAFE_ALLOCA_LISP allocates an array of Lisp_Objects. */
+/* Set BUF to point to an allocated array of NELT Lisp_Objects,
+ immediately followed by EXTRA spare bytes. */
-#define SAFE_ALLOCA_LISP(buf, nelt) \
+#define SAFE_ALLOCA_LISP_EXTRA(buf, nelt, extra) \
do { \
ptrdiff_t alloca_nbytes; \
if (INT_MULTIPLY_WRAPV (nelt, word_size, &alloca_nbytes) \
+ || INT_ADD_WRAPV (alloca_nbytes, extra, &alloca_nbytes) \
|| SIZE_MAX < alloca_nbytes) \
memory_full (SIZE_MAX); \
else if (alloca_nbytes <= sa_avail) \
@@ -4515,6 +4532,10 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1));
} \
} while (false)
+/* Set BUF to point to an allocated array of NELT Lisp_Objects. */
+
+#define SAFE_ALLOCA_LISP(buf, nelt) SAFE_ALLOCA_LISP_EXTRA (buf, nelt, 0)
+
/* If USE_STACK_LISP_OBJECTS, define macros that and functions that allocate
block-scoped conses and strings. These objects are not
@@ -4526,8 +4547,7 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1));
Build with CPPFLAGS='-DUSE_STACK_LISP_OBJECTS=0' to disable it. */
#if (!defined USE_STACK_LISP_OBJECTS \
- && defined __GNUC__ && !defined __clang__ \
- && !(4 < __GNUC__ + (3 < __GNUC_MINOR__ + (2 <= __GNUC_PATCHLEVEL__))))
+ && defined __GNUC__ && !defined __clang__ && ! GNUC_PREREQ (4, 3, 2))
/* Work around GCC bugs 36584 and 35271, which were fixed in GCC 4.3.2. */
# define USE_STACK_LISP_OBJECTS false
#endif
@@ -4600,27 +4620,29 @@ enum
STACK_CONS (d, Qnil)))) \
: list4 (a, b, c, d))
-/* Check whether stack-allocated strings are ASCII-only. */
+/* Declare NAME as an auto Lisp string if possible, a GC-based one if not.
+ Take its unibyte value from the null-terminated string STR,
+ an expression that should not have side effects.
+ STR's value is not necessarily copied. The resulting Lisp string
+ should not be modified or made visible to user code. */
-#if defined (ENABLE_CHECKING) && USE_STACK_LISP_OBJECTS
-extern const char *verify_ascii (const char *);
-#else
-# define verify_ascii(str) (str)
-#endif
+#define AUTO_STRING(name, str) \
+ AUTO_STRING_WITH_LEN (name, str, strlen (str))
/* Declare NAME as an auto Lisp string if possible, a GC-based one if not.
- Take its value from STR. STR is not necessarily copied and should
- contain only ASCII characters. The resulting Lisp string should
- not be modified or made visible to user code. */
+ Take its unibyte value from the null-terminated string STR with length LEN.
+ STR may have side effects and may contain null bytes.
+ STR's value is not necessarily copied. The resulting Lisp string
+ should not be modified or made visible to user code. */
-#define AUTO_STRING(name, str) \
+#define AUTO_STRING_WITH_LEN(name, str, len) \
Lisp_Object name = \
(USE_STACK_STRING \
? (make_lisp_ptr \
((&(union Aligned_String) \
- {{strlen (str), -1, 0, (unsigned char *) verify_ascii (str)}}.s), \
- Lisp_String)) \
- : build_string (verify_ascii (str)))
+ {{len, -1, 0, (unsigned char *) (str)}}.s), \
+ Lisp_String)) \
+ : make_unibyte_string (str, len))
/* Loop over all tails of a list, checking for cycles.
FIXME: Make tortoise and n internal declarations.
diff --git a/src/lread.c b/src/lread.c
index 0bc34b228cc..eab9b8bea08 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -23,11 +23,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include "sysstdio.h"
+#include <stdlib.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <sys/file.h>
#include <errno.h>
-#include <limits.h> /* For CHAR_BIT. */
#include <math.h>
#include <stat-time.h>
#include "lisp.h"
@@ -36,13 +36,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "character.h"
#include "buffer.h"
#include "charset.h"
-#include "coding.h"
#include <epaths.h>
#include "commands.h"
#include "keyboard.h"
#include "systime.h"
#include "termhooks.h"
#include "blockinput.h"
+#include <c-ctype.h>
#ifdef MSDOS
#include "msdos.h"
@@ -1039,7 +1039,7 @@ Return t if the file exists and loads successfully. */)
{
FILE *stream;
int fd;
- int fd_index;
+ int fd_index UNINIT;
ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object found, efound, hist_file_name;
/* True means we printed the ".el is newer" message. */
@@ -1155,12 +1155,7 @@ Return t if the file exists and loads successfully. */)
#endif
}
- if (fd < 0)
- {
- /* Pacify older GCC with --enable-gcc-warnings. */
- IF_LINT (fd_index = 0);
- }
- else
+ if (0 <= fd)
{
fd_index = SPECPDL_INDEX ();
record_unwind_protect_int (close_file_unwind, fd);
@@ -1209,7 +1204,11 @@ Return t if the file exists and loads successfully. */)
specbind (Qold_style_backquotes, Qnil);
record_unwind_protect (load_warn_old_style_backquotes, file);
- if (suffix_p (found, ".elc") || (fd >= 0 && (version = safe_to_load_version (fd)) > 0))
+ int is_elc;
+ if ((is_elc = suffix_p (found, ".elc")) != 0
+ /* version = 1 means the file is empty, in which case we can
+ treat it as not byte-compiled. */
+ || (fd >= 0 && (version = safe_to_load_version (fd)) > 1))
/* Load .elc files directly, but not when they are
remote and have no handler! */
{
@@ -1236,7 +1235,7 @@ Return t if the file exists and loads successfully. */)
/* openp already checked for newness, no point doing it again.
FIXME would be nice to get a message when openp
ignores suffix order due to load_prefer_newer. */
- if (!load_prefer_newer)
+ if (!load_prefer_newer && is_elc)
{
result = stat (SSDATA (efound), &s1);
if (result == 0)
@@ -1465,6 +1464,8 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
for (; CONSP (path); path = XCDR (path))
{
+ ptrdiff_t baselen, prefixlen;
+
filename = Fexpand_file_name (str, XCAR (path));
if (!complete_filename_p (filename))
/* If there are non-absolute elts in PATH (eg "."). */
@@ -1486,6 +1487,14 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
fn = SAFE_ALLOCA (fn_size);
}
+ /* Copy FILENAME's data to FN but remove starting /: if any. */
+ prefixlen = ((SCHARS (filename) > 2
+ && SREF (filename, 0) == '/'
+ && SREF (filename, 1) == ':')
+ ? 2 : 0);
+ baselen = SBYTES (filename) - prefixlen;
+ memcpy (fn, SDATA (filename) + prefixlen, baselen);
+
/* Loop over suffixes. */
for (tail = NILP (suffixes) ? list1 (empty_unibyte_string) : suffixes;
CONSP (tail); tail = XCDR (tail))
@@ -1494,16 +1503,10 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
ptrdiff_t fnlen, lsuffix = SBYTES (suffix);
Lisp_Object handler;
- /* Concatenate path element/specified name with the suffix.
- If the directory starts with /:, remove that. */
- int prefixlen = ((SCHARS (filename) > 2
- && SREF (filename, 0) == '/'
- && SREF (filename, 1) == ':')
- ? 2 : 0);
- fnlen = SBYTES (filename) - prefixlen;
- memcpy (fn, SDATA (filename) + prefixlen, fnlen);
- memcpy (fn + fnlen, SDATA (suffix), lsuffix + 1);
- fnlen += lsuffix;
+ /* Make complete filename by appending SUFFIX. */
+ memcpy (fn + baselen, SDATA (suffix), lsuffix + 1);
+ fnlen = baselen + lsuffix;
+
/* Check that the file exists and is not a directory. */
/* We used to only check for handlers on non-absolute file names:
if (absolute)
@@ -1582,8 +1585,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
}
else
{
- int oflags = O_RDONLY + (NILP (predicate) ? 0 : O_BINARY);
- fd = emacs_open (pfn, oflags, 0);
+ fd = emacs_open (pfn, O_RDONLY, 0);
if (fd < 0)
{
if (errno != ENOENT)
@@ -2154,6 +2156,33 @@ grow_read_buffer (void)
MAX_MULTIBYTE_LENGTH, -1, 1);
}
+/* Return the scalar value that has the Unicode character name NAME.
+ Raise 'invalid-read-syntax' if there is no such character. */
+static int
+character_name_to_code (char const *name, ptrdiff_t name_len)
+{
+ /* For "U+XXXX", pass the leading '+' to string_to_number to reject
+ monstrosities like "U+-0000". */
+ Lisp_Object code
+ = (name[0] == 'U' && name[1] == '+'
+ ? string_to_number (name + 1, 16, false)
+ : call2 (Qchar_from_name, make_unibyte_string (name, name_len), Qt));
+
+ if (! RANGED_INTEGERP (0, code, MAX_UNICODE_CHAR)
+ || char_surrogate_p (XINT (code)))
+ {
+ AUTO_STRING (format, "\\N{%s}");
+ AUTO_STRING_WITH_LEN (namestr, name, name_len);
+ xsignal1 (Qinvalid_read_syntax, CALLN (Fformat, format, namestr));
+ }
+
+ return XINT (code);
+}
+
+/* Bound on the length of a Unicode character name. As of
+ Unicode 9.0.0 the maximum is 83, so this should be safe. */
+enum { UNICODE_CHARACTER_NAME_LENGTH_BOUND = 200 };
+
/* Read a \-escape sequence, assuming we already read the `\'.
If the escape sequence forces unibyte, return eight-bit char. */
@@ -2361,6 +2390,51 @@ read_escape (Lisp_Object readcharfun, bool stringp)
return i;
}
+ case 'N':
+ /* Named character. */
+ {
+ c = READCHAR;
+ if (c != '{')
+ invalid_syntax ("Expected opening brace after \\N");
+ char name[UNICODE_CHARACTER_NAME_LENGTH_BOUND + 1];
+ bool whitespace = false;
+ ptrdiff_t length = 0;
+ while (true)
+ {
+ c = READCHAR;
+ if (c < 0)
+ end_of_file_error ();
+ if (c == '}')
+ break;
+ if (! (0 < c && c < 0x80))
+ {
+ AUTO_STRING (format,
+ "Invalid character U+%04X in character name");
+ xsignal1 (Qinvalid_read_syntax,
+ CALLN (Fformat, format, make_natnum (c)));
+ }
+ /* Treat multiple adjacent whitespace characters as a
+ single space character. This makes it easier to use
+ character names in e.g. multi-line strings. */
+ if (c_isspace (c))
+ {
+ if (whitespace)
+ continue;
+ c = ' ';
+ whitespace = true;
+ }
+ else
+ whitespace = false;
+ name[length++] = c;
+ if (length >= sizeof name)
+ invalid_syntax ("Character name too long");
+ }
+ if (length == 0)
+ invalid_syntax ("Empty character name");
+ name[length] = '\0';
+ return character_name_to_code (name, length);
+ }
+
default:
return c;
}
@@ -2397,7 +2471,7 @@ read_integer (Lisp_Object readcharfun, EMACS_INT radix)
{
/* Room for sign, leading 0, other digits, trailing null byte.
Also, room for invalid syntax diagnostic. */
- char buf[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT + 1,
+ char buf[max (1 + 1 + UINTMAX_WIDTH + 1,
sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT))];
int valid = -1; /* 1 if valid, 0 if not, -1 if incomplete. */
@@ -2821,19 +2895,17 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
{
EMACS_INT n = 0;
Lisp_Object tem;
+ bool overflow = false;
/* Read a non-negative integer. */
while (c >= '0' && c <= '9')
{
- if (MOST_POSITIVE_FIXNUM / 10 < n
- || MOST_POSITIVE_FIXNUM < n * 10 + c - '0')
- n = MOST_POSITIVE_FIXNUM + 1;
- else
- n = n * 10 + c - '0';
+ overflow |= INT_MULTIPLY_WRAPV (n, 10, &n);
+ overflow |= INT_ADD_WRAPV (n, c - '0', &n);
c = READCHAR;
}
- if (n <= MOST_POSITIVE_FIXNUM)
+ if (!overflow && n <= MOST_POSITIVE_FIXNUM)
{
if (c == 'r' || c == 'R')
return read_integer (readcharfun, n);
@@ -4428,18 +4500,24 @@ void
dir_warning (char const *use, Lisp_Object dirname)
{
static char const format[] = "Warning: %s '%s': %s\n";
- int access_errno = errno;
- fprintf (stderr, format, use, SSDATA (ENCODE_SYSTEM (dirname)),
- strerror (access_errno));
+ char *diagnostic = emacs_strerror (errno);
+ fprintf (stderr, format, use, SSDATA (ENCODE_SYSTEM (dirname)), diagnostic);
/* Don't log the warning before we've initialized!! */
if (initialized)
{
- char const *diagnostic = emacs_strerror (access_errno);
+ ptrdiff_t diaglen = strlen (diagnostic);
+ AUTO_STRING_WITH_LEN (diag, diagnostic, diaglen);
+ if (! NILP (Vlocale_coding_system))
+ {
+ Lisp_Object s
+ = code_convert_string_norecord (diag, Vlocale_coding_system, false);
+ diagnostic = SSDATA (s);
+ diaglen = SBYTES (s);
+ }
USE_SAFE_ALLOCA;
char *buffer = SAFE_ALLOCA (sizeof format - 3 * (sizeof "%s" - 1)
- + strlen (use) + SBYTES (dirname)
- + strlen (diagnostic));
+ + strlen (use) + SBYTES (dirname) + diaglen);
ptrdiff_t message_len = esprintf (buffer, format, use, SSDATA (dirname),
diagnostic);
message_dolog (buffer, message_len, 0, STRING_MULTIBYTE (dirname));
@@ -4761,4 +4839,6 @@ that are loaded before your customizations are read! */);
DEFSYM (Qweakness, "weakness");
DEFSYM (Qrehash_size, "rehash-size");
DEFSYM (Qrehash_threshold, "rehash-threshold");
+
+ DEFSYM (Qchar_from_name, "char-from-name");
}
diff --git a/src/macfont.m b/src/macfont.m
index ed7c1e3bd7a..3af9edc148a 100644
--- a/src/macfont.m
+++ b/src/macfont.m
@@ -2856,7 +2856,8 @@ macfont_draw (struct glyph_string *s, int from, int to, int x, int y,
{
if (s->hl == DRAW_MOUSE_FACE)
{
- face = FACE_FROM_ID (s->f, MOUSE_HL_INFO (s->f)->mouse_face_face_id);
+ face = FACE_FROM_ID_OR_NULL (s->f,
+ MOUSE_HL_INFO (s->f)->mouse_face_face_id);
if (!face)
face = FACE_FROM_ID (s->f, MOUSE_FACE_ID);
}
@@ -2877,7 +2878,19 @@ macfont_draw (struct glyph_string *s, int from, int to, int x, int y,
if (macfont_info->synthetic_bold_p && ! no_antialias_p)
{
CGContextSetTextDrawingMode (context, kCGTextFillStroke);
+
+ /* Stroke line width for text drawing is not correctly
+ scaled on Retina display/HiDPI mode when drawn to screen
+ (whereas it is correctly scaled when drawn to bitmaps),
+ and synthetic bold looks thinner on such environments.
+ Apple says there are no plans to address this issue
+ (rdar://11644870) currently. So we add a workaround. */
+#if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_7
+ CGContextSetLineWidth (context, synthetic_bold_factor * font_size
+ * [[FRAME_NS_VIEW(f) window] backingScaleFactor]);
+#else
CGContextSetLineWidth (context, synthetic_bold_factor * font_size);
+#endif
CG_SET_STROKE_COLOR_WITH_FACE_FOREGROUND (context, face, f);
}
if (no_antialias_p)
@@ -3766,6 +3779,7 @@ mac_font_shape (CTFontRef font, CFStringRef string,
{
struct mac_glyph_layout *gl;
CGPoint position;
+ CGFloat max_x;
if (!RIGHT_TO_LEFT_P)
gl = glbuf + range.location;
@@ -3787,12 +3801,13 @@ mac_font_shape (CTFontRef font, CFStringRef string,
CTRunGetGlyphs (ctrun, range, &gl->glyph_id);
CTRunGetPositions (ctrun, range, &position);
+ max_x = position.x + CTRunGetTypographicBounds (ctrun, range,
+ NULL, NULL, NULL);
+ max_x = max (max_x, total_advance);
gl->advance_delta = position.x - total_advance;
gl->baseline_delta = position.y;
- gl->advance = (gl->advance_delta
- + CTRunGetTypographicBounds (ctrun, range,
- NULL, NULL, NULL));
- total_advance += gl->advance;
+ gl->advance = max_x - total_advance;
+ total_advance = max_x;
}
if (RIGHT_TO_LEFT_P)
diff --git a/src/marker.c b/src/marker.c
index febdb17689a..05e5bb87474 100644
--- a/src/marker.c
+++ b/src/marker.c
@@ -507,7 +507,11 @@ set_marker_internal (Lisp_Object marker, Lisp_Object position,
charpos = clip_to_bounds
(restricted ? BUF_BEGV (b) : BUF_BEG (b), charpos,
restricted ? BUF_ZV (b) : BUF_Z (b));
- if (bytepos == -1)
+ /* Don't believe BYTEPOS if it comes from a different buffer,
+ since that buffer might have a very different correspondence
+ between character and byte positions. */
+ if (bytepos == -1
+ || !(MARKERP (position) && XMARKER (position)->buffer == b))
bytepos = buf_charpos_to_bytepos (b, charpos);
else
bytepos = clip_to_bounds
diff --git a/src/menu.c b/src/menu.c
index 9504cee5923..638810b36f8 100644
--- a/src/menu.c
+++ b/src/menu.c
@@ -42,12 +42,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#endif /* HAVE_WINDOW_SYSTEM */
#ifdef HAVE_NTGUI
-# ifdef NTGUI_UNICODE
-# define unicode_append_menu AppendMenuW
-# else /* !NTGUI_UNICODE */
extern AppendMenuW_Proc unicode_append_menu;
-# endif /* NTGUI_UNICODE */
-extern HMENU current_popup_menu;
#endif /* HAVE_NTGUI */
#include "menu.h"
@@ -408,7 +403,7 @@ single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *sk
if (prefix)
{
- AUTO_STRING (prefix_obj, prefix);
+ AUTO_STRING_WITH_LEN (prefix_obj, prefix, 4);
item_string = concat2 (prefix_obj, item_string);
}
}
@@ -1050,7 +1045,7 @@ menu_item_width (const unsigned char *str)
int ch_len;
int ch = STRING_CHAR_AND_LENGTH (p, ch_len);
- len += CHAR_WIDTH (ch);
+ len += CHARACTER_WIDTH (ch);
p += ch_len;
}
return len;
diff --git a/src/minibuf.c b/src/minibuf.c
index 3d34635c6c0..57eea05b0fc 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -194,7 +194,7 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial,
int c;
unsigned char hide_char = 0;
struct emacs_tty etty;
- bool etty_valid;
+ bool etty_valid UNINIT;
/* Check, whether we need to suppress echoing. */
if (CHARACTERP (Vread_hide_char))
@@ -203,10 +203,10 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial,
/* Manipulate tty. */
if (hide_char)
{
- etty_valid = emacs_get_tty (fileno (stdin), &etty) == 0;
+ etty_valid = emacs_get_tty (STDIN_FILENO, &etty) == 0;
if (etty_valid)
- set_binary_mode (fileno (stdin), O_BINARY);
- suppress_echo_on_tty (fileno (stdin));
+ set_binary_mode (STDIN_FILENO, O_BINARY);
+ suppress_echo_on_tty (STDIN_FILENO);
}
fwrite (SDATA (prompt), 1, SBYTES (prompt), stdout);
@@ -240,8 +240,8 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial,
fprintf (stdout, "\n");
if (etty_valid)
{
- emacs_set_tty (fileno (stdin), &etty, 0);
- set_binary_mode (fileno (stdin), O_TEXT);
+ emacs_set_tty (STDIN_FILENO, &etty, 0);
+ set_binary_mode (STDIN_FILENO, O_TEXT);
}
}
@@ -630,8 +630,31 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
Qrear_nonsticky, Qt, Qnil);
Fput_text_property (make_number (BEG), make_number (PT),
Qfield, Qt, Qnil);
- Fadd_text_properties (make_number (BEG), make_number (PT),
- Vminibuffer_prompt_properties, Qnil);
+ if (CONSP (Vminibuffer_prompt_properties))
+ {
+ /* We want to apply all properties from
+ `minibuffer-prompt-properties' to the region normally,
+ but if the `face' property is present, add that
+ property to the end of the face properties to avoid
+ overwriting faces. */
+ Lisp_Object list = Vminibuffer_prompt_properties;
+ while (CONSP (list))
+ {
+ Lisp_Object key = XCAR (list);
+ list = XCDR (list);
+ if (CONSP (list))
+ {
+ Lisp_Object val = XCAR (list);
+ list = XCDR (list);
+ if (EQ (key, Qface))
+ Fadd_face_text_property (make_number (BEG),
+ make_number (PT), val, Qt, Qnil);
+ else
+ Fput_text_property (make_number (BEG), make_number (PT),
+ key, val, Qnil);
+ }
+ }
+ }
}
unbind_to (count1, Qnil);
}
@@ -742,27 +765,25 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
}
/* Return a buffer to be used as the minibuffer at depth `depth'.
- depth = 0 is the lowest allowed argument, and that is the value
- used for nonrecursive minibuffer invocations. */
+ depth = 0 is the lowest allowed argument, and that is the value
+ used for nonrecursive minibuffer invocations. */
Lisp_Object
get_minibuffer (EMACS_INT depth)
{
- Lisp_Object tail, num, buf;
- char name[sizeof " *Minibuf-*" + INT_STRLEN_BOUND (EMACS_INT)];
-
- XSETFASTINT (num, depth);
- tail = Fnthcdr (num, Vminibuffer_list);
+ Lisp_Object tail = Fnthcdr (make_number (depth), Vminibuffer_list);
if (NILP (tail))
{
tail = list1 (Qnil);
Vminibuffer_list = nconc2 (Vminibuffer_list, tail);
}
- buf = Fcar (tail);
+ Lisp_Object buf = Fcar (tail);
if (NILP (buf) || !BUFFER_LIVE_P (XBUFFER (buf)))
{
- buf = Fget_buffer_create
- (make_formatted_string (name, " *Minibuf-%"pI"d*", depth));
+ static char const name_fmt[] = " *Minibuf-%"pI"d*";
+ char name[sizeof name_fmt + INT_STRLEN_BOUND (EMACS_INT)];
+ AUTO_STRING_WITH_LEN (lname, name, sprintf (name, name_fmt, depth));
+ buf = Fget_buffer_create (lname);
/* Although the buffer's name starts with a space, undo should be
enabled in it. */
@@ -1665,6 +1686,8 @@ the values STRING, PREDICATE and `lambda'. */)
tem = Fassoc_string (string, collection, completion_ignore_case ? Qt : Qnil);
if (NILP (tem))
return Qnil;
+ else if (CONSP (tem))
+ tem = XCAR (tem);
}
else if (VECTORP (collection))
{
diff --git a/src/msdos.c b/src/msdos.c
index 62411ea2f6d..74109ae1bbd 100644
--- a/src/msdos.c
+++ b/src/msdos.c
@@ -795,8 +795,8 @@ static void
IT_set_face (int face)
{
struct frame *sf = SELECTED_FRAME ();
- struct face *fp = FACE_FROM_ID (sf, face);
- struct face *dfp = FACE_FROM_ID (sf, DEFAULT_FACE_ID);
+ struct face *fp = FACE_FROM_ID_OR_NULL (sf, face);
+ struct face *dfp = FACE_FROM_ID_OR_NULL (sf, DEFAULT_FACE_ID);
unsigned long fg, bg, dflt_fg, dflt_bg;
struct tty_display_info *tty = FRAME_TTY (sf);
@@ -1076,7 +1076,7 @@ IT_clear_screen (struct frame *f)
any valid faces and will abort. Instead, use the initial screen
colors; that should mimic what a Unix tty does, which simply clears
the screen with whatever default colors are in use. */
- if (FACE_FROM_ID (SELECTED_FRAME (), DEFAULT_FACE_ID) == NULL)
+ if (FACE_FROM_ID_OR_NULL (SELECTED_FRAME (), DEFAULT_FACE_ID) == NULL)
ScreenAttrib = (initial_screen_colors[0] << 4) | initial_screen_colors[1];
else
IT_set_face (0);
@@ -1791,7 +1791,7 @@ internal_terminal_init (void)
}
Vinitial_window_system = Qpc;
- Vwindow_system_version = make_number (25); /* RE Emacs version */
+ Vwindow_system_version = make_number (26); /* RE Emacs version */
tty->terminal->type = output_msdos_raw;
/* If Emacs was dumped on DOS/V machine, forget the stale VRAM
diff --git a/src/nsfns.m b/src/nsfns.m
index 82bb84a147a..cfaaf53cbc6 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -52,12 +52,7 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
#ifdef HAVE_NS
-extern NSArray *ns_send_types, *ns_return_types, *ns_drag_types;
-
-EmacsTooltip *ns_tooltip = nil;
-
-/* Need forward declaration here to preserve organizational integrity of file */
-Lisp_Object Fx_open_connection (Lisp_Object, Lisp_Object, Lisp_Object);
+static EmacsTooltip *ns_tooltip = nil;
/* Static variables to handle applescript execution. */
static Lisp_Object as_script, *as_result;
@@ -65,6 +60,8 @@ static int as_status;
static ptrdiff_t image_cache_refcount;
+static struct ns_display_info *ns_display_info_for_name (Lisp_Object);
+static void ns_set_name_as_filename (struct frame *);
/* ==========================================================================
@@ -132,7 +129,7 @@ ns_get_window (Lisp_Object maybeFrame)
/* Return the X display structure for the display named NAME.
Open a new connection if necessary. */
-struct ns_display_info *
+static struct ns_display_info *
ns_display_info_for_name (Lisp_Object name)
{
struct ns_display_info *dpyinfo;
@@ -523,7 +520,7 @@ x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
}
-void
+static void
ns_set_name_as_filename (struct frame *f)
{
NSView *view;
@@ -622,7 +619,7 @@ ns_set_doc_edited (void)
}
-void
+static void
x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
{
int nlines;
@@ -652,7 +649,7 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
/* toolbar support */
-void
+static void
x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
{
/* Currently, when the tool bar change state, the frame is resized.
@@ -720,15 +717,15 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
}
-void
+static void
x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
int old_width = FRAME_INTERNAL_BORDER_WIDTH (f);
CHECK_TYPE_RANGED_INTEGER (int, arg);
- FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
+ f->internal_border_width = XINT (arg);
if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
- FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
+ f->internal_border_width = 0;
if (FRAME_INTERNAL_BORDER_WIDTH (f) == old_width)
return;
@@ -850,40 +847,6 @@ x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
[view setMiniwindowImage: setMini];
}
-
-/* TODO: move to nsterm? */
-int
-ns_lisp_to_cursor_type (Lisp_Object arg)
-{
- char *str;
- if (XTYPE (arg) == Lisp_String)
- str = SSDATA (arg);
- else if (XTYPE (arg) == Lisp_Symbol)
- str = SSDATA (SYMBOL_NAME (arg));
- else return -1;
- if (!strcmp (str, "box")) return FILLED_BOX_CURSOR;
- if (!strcmp (str, "hollow")) return HOLLOW_BOX_CURSOR;
- if (!strcmp (str, "hbar")) return HBAR_CURSOR;
- if (!strcmp (str, "bar")) return BAR_CURSOR;
- if (!strcmp (str, "no")) return NO_CURSOR;
- return -1;
-}
-
-
-Lisp_Object
-ns_cursor_type_to_lisp (int arg)
-{
- switch (arg)
- {
- case FILLED_BOX_CURSOR: return Qbox;
- case HOLLOW_BOX_CURSOR: return Qhollow;
- case HBAR_CURSOR: return Qhbar;
- case BAR_CURSOR: return Qbar;
- case NO_CURSOR:
- default: return intern ("no");
- }
-}
-
/* This is the same as the xfns.c definition. */
static void
x_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
@@ -983,8 +946,8 @@ frame_parm_handler ns_frame_parm_handlers[] =
x_set_icon_name,
x_set_icon_type,
x_set_internal_border_width, /* generic OK */
- 0, /* x_set_right_divider_width */
- 0, /* x_set_bottom_divider_width */
+ x_set_right_divider_width,
+ x_set_bottom_divider_width,
x_set_menu_bar_lines,
x_set_mouse_color,
x_explicitly_set_name,
@@ -1008,6 +971,7 @@ frame_parm_handler ns_frame_parm_handlers[] =
x_set_alpha,
0, /* x_set_sticky */
0, /* x_set_tool_bar_position */
+ 0, /* x_set_inhibit_double_buffering */
};
@@ -1582,7 +1546,7 @@ Optional arg DIR_ONLY_P, if non-nil, means choose only directories. */)
The file dialog may pop up a confirm dialog after Ok has been pressed,
so we can not simply pop down on the Ok/Cancel press.
*/
- nxev = [NSEvent otherEventWithType: NSApplicationDefined
+ nxev = [NSEvent otherEventWithType: NSEventTypeApplicationDefined
location: NSMakePoint (0, 0)
modifierFlags: 0
timestamp: 0
@@ -2193,7 +2157,7 @@ In case the execution fails, an error is signaled. */)
errors aren't returned and executeAndReturnError hangs forever.
Post an event that runs applescript and then start the event loop.
The event loop is exited when the script is done. */
- nxev = [NSEvent otherEventWithType: NSApplicationDefined
+ nxev = [NSEvent otherEventWithType: NSEventTypeApplicationDefined
location: NSMakePoint (0, 0)
modifierFlags: 0
timestamp: 0
@@ -2273,9 +2237,10 @@ x_get_string_resource (XrmDatabase rdb, const char *name, const char *class)
return NULL;
res = ns_get_defaults_value (toCheck);
- return (!res ? NULL :
- (!c_strncasecmp (res, "YES", 3) ? "true" :
- (!c_strncasecmp (res, "NO", 2) ? "false" : (char *) res)));
+ return (char *) (!res ? NULL
+ : !c_strncasecmp (res, "YES", 3) ? "true"
+ : !c_strncasecmp (res, "NO", 2) ? "false"
+ : res);
}
@@ -2987,7 +2952,7 @@ handlePanelKeys (NSSavePanel *panel, NSEvent *theEvent)
int i;
BOOL ret = NO;
- if ([theEvent type] != NSKeyDown) return NO;
+ if ([theEvent type] != NSEventTypeKeyDown) return NO;
s = [theEvent characters];
for (i = 0; i < [s length]; ++i)
@@ -3006,7 +2971,7 @@ handlePanelKeys (NSSavePanel *panel, NSEvent *theEvent)
/* Don't send command modified keys, as those are handled in the
performKeyEquivalent method of the super class.
*/
- if (! ([theEvent modifierFlags] & NSCommandKeyMask))
+ if (! ([theEvent modifierFlags] & NSEventModifierFlagCommand))
{
[panel sendEvent: theEvent];
ret = YES;
@@ -3023,7 +2988,7 @@ handlePanelKeys (NSSavePanel *panel, NSEvent *theEvent)
case 'c': // Copy
case 'v': // Paste
case 'a': // Select all
- if ([theEvent modifierFlags] & NSCommandKeyMask)
+ if ([theEvent modifierFlags] & NSEventModifierFlagCommand)
{
[NSApp sendAction:
(ch == 'x'
@@ -3039,7 +3004,7 @@ handlePanelKeys (NSSavePanel *panel, NSEvent *theEvent)
default:
// Send all control keys, as the text field supports C-a, C-f, C-e
// C-b and more.
- if ([theEvent modifierFlags] & NSControlKeyMask)
+ if ([theEvent modifierFlags] & NSEventModifierFlagControl)
{
[panel sendEvent: theEvent];
ret = YES;
diff --git a/src/nsfont.m b/src/nsfont.m
index 4f95ee3a1a8..389d0ed7aa4 100644
--- a/src/nsfont.m
+++ b/src/nsfont.m
@@ -45,9 +45,6 @@ Author: Adrian Robert (arobert@cogsci.ucsd.edu)
#define NSFONT_TRACE 0
#define LCD_SMOOTHING_MARGIN 2
-extern float ns_antialias_threshold;
-
-
/* font glyph and metrics caching functions, implemented at end */
static void ns_uni_to_glyphs (struct nsfont_info *font_info,
unsigned char block);
@@ -1071,7 +1068,8 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y,
face = s->face;
break;
case NS_DUMPGLYPH_MOUSEFACE:
- face = FACE_FROM_ID (s->f, MOUSE_HL_INFO (s->f)->mouse_face_face_id);
+ face = FACE_FROM_ID_OR_NULL (s->f,
+ MOUSE_HL_INFO (s->f)->mouse_face_face_id);
if (!face)
face = FACE_FROM_ID (s->f, MOUSE_FACE_ID);
break;
@@ -1515,7 +1513,10 @@ ns_dump_glyphstring (struct glyph_string *s)
s->nchars, s->x, s->y, s->left_overhang, s->right_overhang,
s->row->overlapping_p, s->background_filled_p);
for (i =0; i<s->nchars; i++)
- fprintf (stderr, "%c", s->first_glyph[i].u.ch);
+ {
+ int c = s->first_glyph[i].u.ch;
+ fprintf (stderr, "%c", c);
+ }
fprintf (stderr, "\n");
}
diff --git a/src/nsimage.m b/src/nsimage.m
index 66aecd4289d..32bcea76ccd 100644
--- a/src/nsimage.m
+++ b/src/nsimage.m
@@ -46,11 +46,11 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
========================================================================== */
void *
-ns_image_from_XBM (unsigned char *bits, int width, int height,
+ns_image_from_XBM (char *bits, int width, int height,
unsigned long fg, unsigned long bg)
{
NSTRACE ("ns_image_from_XBM");
- return [[EmacsImage alloc] initFromXBM: bits
+ return [[EmacsImage alloc] initFromXBM: (unsigned char *) bits
width: width height: height
fg: fg bg: bg];
}
diff --git a/src/nsmenu.m b/src/nsmenu.m
index f73c184dce7..3e9887acf5d 100644
--- a/src/nsmenu.m
+++ b/src/nsmenu.m
@@ -53,8 +53,7 @@ Carbon version by Yamamoto Mitsuharu. */
#endif
extern long context_menu_value;
-EmacsMenu *mainMenu, *svcsMenu, *dockMenu;
-
+EmacsMenu *svcsMenu;
/* Nonzero means a menu is currently active. */
static int popup_activated_flag;
@@ -136,12 +135,6 @@ ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu *submenu)
menu = [[EmacsMenu alloc] initWithTitle: ns_app_name];
needsSet = YES;
}
- else
- { /* close up anything on there */
- id attMenu = [menu attachedMenu];
- if (attMenu != nil)
- [attMenu close];
- }
#if NSMENUPROFILE
ftime (&tb);
@@ -610,7 +603,7 @@ x_activate_menubar (struct frame *f)
-(NSString *)parseKeyEquiv: (const char *)key
{
const char *tpos = key;
- keyEquivModMask = NSCommandKeyMask;
+ keyEquivModMask = NSEventModifierFlagCommand;
if (!key || !strlen (key))
return @"";
@@ -698,7 +691,6 @@ x_activate_menubar (struct frame *f)
widget_value *wv = (widget_value *)wvptr;
/* clear existing contents */
- [self setMenuChangedMessagesEnabled: NO];
[self clear];
/* add new contents */
@@ -722,7 +714,6 @@ x_activate_menubar (struct frame *f)
}
}
- [self setMenuChangedMessagesEnabled: YES];
#ifdef NS_IMPL_GNUSTEP
if ([[self window] isVisible])
[self sizeToFit];
@@ -754,7 +745,7 @@ x_activate_menubar (struct frame *f)
/* p = [view convertPoint:p fromView: nil]; */
p.y = NSHeight ([view frame]) - p.y;
e = [[view window] currentEvent];
- event = [NSEvent mouseEventWithType: NSRightMouseDown
+ event = [NSEvent mouseEventWithType: NSEventTypeRightMouseDown
location: p
modifierFlags: 0
timestamp: [e timestamp]
@@ -1426,29 +1417,19 @@ update_frame_tool_bar (struct frame *f)
========================================================================== */
-struct Popdown_data
-{
- NSAutoreleasePool *pool;
- EmacsDialogPanel *dialog;
-};
-
static void
pop_down_menu (void *arg)
{
- struct Popdown_data *unwind_data = arg;
+ EmacsDialogPanel *panel = arg;
- block_input ();
if (popup_activated_flag)
{
- EmacsDialogPanel *panel = unwind_data->dialog;
+ block_input ();
popup_activated_flag = 0;
[panel close];
- [unwind_data->pool release];
[[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow];
+ unblock_input ();
}
-
- xfree (unwind_data);
- unblock_input ();
}
@@ -1459,7 +1440,6 @@ ns_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents)
Lisp_Object tem, title;
NSPoint p;
BOOL isQ;
- NSAutoreleasePool *pool;
NSTRACE ("ns_popup_dialog");
@@ -1479,18 +1459,13 @@ ns_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents)
contents = list2 (title, Fcons (build_string ("Ok"), Qt));
block_input ();
- pool = [[NSAutoreleasePool alloc] init];
dialog = [[EmacsDialogPanel alloc] initFromContents: contents
isQuestion: isQ];
{
ptrdiff_t specpdl_count = SPECPDL_INDEX ();
- struct Popdown_data *unwind_data = xmalloc (sizeof (*unwind_data));
-
- unwind_data->pool = pool;
- unwind_data->dialog = dialog;
- record_unwind_protect_ptr (pop_down_menu, unwind_data);
+ 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 */
@@ -1556,7 +1531,7 @@ ns_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents)
[img autorelease];
[imgView autorelease];
- aStyle = NSTitledWindowMask|NSClosableWindowMask|NSUtilityWindowMask;
+ aStyle = NSWindowStyleMaskTitled|NSWindowStyleMaskClosable|NSUtilityWindowMask;
flag = YES;
rows = 0;
cols = 1;
@@ -1814,7 +1789,7 @@ ns_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents)
- (void)timeout_handler: (NSTimer *)timedEntry
{
- NSEvent *nxev = [NSEvent otherEventWithType: NSApplicationDefined
+ NSEvent *nxev = [NSEvent otherEventWithType: NSEventTypeApplicationDefined
location: NSMakePoint (0, 0)
modifierFlags: 0
timestamp: 0
@@ -1865,7 +1840,7 @@ ns_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents)
if (EQ (ret, Qundefined) && window_closed)
/* Make close button pressed equivalent to C-g. */
- Fsignal (Qquit, Qnil);
+ quit ();
return ret;
}
diff --git a/src/nsterm.h b/src/nsterm.h
index 4b246bd3d0f..35c6e1a4cbc 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -39,6 +39,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifndef MAC_OS_X_VERSION_10_9
#define MAC_OS_X_VERSION_10_9 1090
#endif
+#ifndef MAC_OS_X_VERSION_10_12
+#define MAC_OS_X_VERSION_10_12 101200
+#endif
#if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_7
#define HAVE_NATIVE_FS
@@ -676,11 +679,13 @@ char const * nstrace_fullscreen_type_name (int);
/* offset to the bottom of knob of last mouse down */
CGFloat last_mouse_offset;
float min_portion;
- int pixel_height;
+ int pixel_length;
enum scroll_bar_part last_hit_part;
BOOL condemned;
+ BOOL horizontal;
+
/* optimize against excessive positioning calls generated by emacs */
int em_position;
int em_portion;
@@ -726,7 +731,7 @@ char const * nstrace_fullscreen_type_name (int);
extern NSArray *ns_send_types, *ns_return_types;
extern NSString *ns_app_name;
-extern EmacsMenu *mainMenu, *svcsMenu, *dockMenu;
+extern EmacsMenu *svcsMenu;
/* Apple removed the declaration, but kept the implementation */
#if defined (NS_IMPL_COCOA)
@@ -919,8 +924,6 @@ struct ns_display_info
/* This is a chain of structures for all the NS displays currently in use. */
extern struct ns_display_info *x_display_list;
-extern struct ns_display_info *ns_display_info_for_name (Lisp_Object name);
-
struct ns_output
{
#ifdef __OBJC__
@@ -1012,7 +1015,7 @@ struct x_output
#define FRAME_NS_TITLEBAR_HEIGHT(f) ((f)->output_data.ns->titlebar_height)
#define FRAME_TOOLBAR_HEIGHT(f) ((f)->output_data.ns->toolbar_height)
-#define FRAME_DEFAULT_FACE(f) FACE_FROM_ID (f, DEFAULT_FACE_ID)
+#define FRAME_DEFAULT_FACE(f) FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID)
#define FRAME_NS_VIEW(f) ((f)->output_data.ns->view)
#define FRAME_CURSOR_COLOR(f) ((f)->output_data.ns->cursor_color)
@@ -1094,7 +1097,7 @@ extern void nsfont_make_fontset_for_font (Lisp_Object name,
/* In nsfont, for debugging */
struct glyph_string;
-void ns_dump_glyphstring (struct glyph_string *s);
+void ns_dump_glyphstring (struct glyph_string *s) EXTERNALLY_VISIBLE;
/* Implemented in nsterm, published in or needed from nsfns. */
extern Lisp_Object ns_list_fonts (struct frame *f, Lisp_Object pattern,
@@ -1111,9 +1114,6 @@ extern void ns_string_to_pasteboard (id pb, Lisp_Object str);
extern Lisp_Object ns_get_local_selection (Lisp_Object selection_name,
Lisp_Object target_type);
extern void nxatoms_of_nsselect (void);
-extern int ns_lisp_to_cursor_type (Lisp_Object arg);
-extern Lisp_Object ns_cursor_type_to_lisp (int arg);
-extern void ns_set_name_as_filename (struct frame *f);
extern void ns_set_doc_edited (void);
extern bool
@@ -1125,11 +1125,9 @@ extern void
ns_query_color (void *col, XColor *color_def, int setPixel);
#ifdef __OBJC__
-extern Lisp_Object ns_color_to_lisp (NSColor *col);
extern int ns_lisp_to_color (Lisp_Object color, NSColor **col);
extern NSColor *ns_lookup_indexed_color (unsigned long idx, struct frame *f);
extern unsigned long ns_index_color (NSColor *color, struct frame *f);
-extern void ns_free_indexed_color (unsigned long idx, struct frame *f);
extern const char *ns_get_pending_menu_title (void);
extern void ns_check_menu_open (NSMenu *menu);
extern void ns_check_pending_open_menu (void);
@@ -1147,8 +1145,6 @@ extern void ns_init_locale (void);
/* in nsmenu */
extern void update_frame_tool_bar (struct frame *f);
extern void free_frame_tool_bar (struct frame *f);
-extern void find_and_call_menu_selection (struct frame *f,
- int menu_bar_items_used, Lisp_Object vector, void *client_data);
extern Lisp_Object find_and_return_menu_selection (struct frame *f,
bool keymaps,
void *client_data);
@@ -1171,7 +1167,7 @@ extern void syms_of_nsselect (void);
/* From nsimage.m, needed in image.c */
struct image;
-extern void *ns_image_from_XBM (unsigned char *bits, int width, int height,
+extern void *ns_image_from_XBM (char *bits, int width, int height,
unsigned long fg, unsigned long bg);
extern void *ns_image_for_XPM (int width, int height, int depth);
extern void *ns_image_from_file (Lisp_Object file);
@@ -1187,6 +1183,7 @@ extern int x_display_pixel_height (struct ns_display_info *);
extern int x_display_pixel_width (struct ns_display_info *);
/* This in nsterm.m */
+extern float ns_antialias_threshold;
extern void x_destroy_window (struct frame *f);
extern int ns_select (int nfds, fd_set *readfds, fd_set *writefds,
fd_set *exceptfds, struct timespec const *timeout,
@@ -1194,14 +1191,11 @@ extern int ns_select (int nfds, fd_set *readfds, fd_set *writefds,
extern unsigned long ns_get_rgb_color (struct frame *f,
float r, float g, float b, float a);
-extern void ns_init_events ();
-extern void ns_finish_events ();
+struct input_event;
+extern void ns_init_events (struct input_event *);
+extern void ns_finish_events (void);
#ifdef __OBJC__
-/* From nsterm.m, needed in nsfont.m. */
-extern void
-ns_draw_text_decoration (struct glyph_string *s, struct face *face,
- NSColor *defaultCol, CGFloat width, CGFloat x);
/* Needed in nsfns.m. */
extern void
ns_set_represented_filename (NSString* fstr, struct frame *f);
@@ -1231,4 +1225,42 @@ extern char gnustep_base_version[]; /* version tracking */
? (min) : (((x)>(max)) ? (max) : (x)))
#define SCREENMAXBOUND(x) (IN_BOUND (-SCREENMAX, x, SCREENMAX))
+/* macOS 10.12 deprecates a bunch of constants. */
+#if !defined (NS_IMPL_COCOA) || \
+ MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_12
+#define NSEventModifierFlagCommand NSCommandKeyMask
+#define NSEventModifierFlagControl NSControlKeyMask
+#define NSEventModifierFlagHelp NSHelpKeyMask
+#define NSEventModifierFlagNumericPad NSNumericPadKeyMask
+#define NSEventModifierFlagOption NSAlternateKeyMask
+#define NSEventModifierFlagShift NSShiftKeyMask
+#define NSCompositingOperationSourceOver NSCompositeSourceOver
+#define NSEventMaskApplicationDefined NSApplicationDefinedMask
+#define NSEventTypeApplicationDefined NSApplicationDefined
+#define NSEventTypeCursorUpdate NSCursorUpdate
+#define NSEventTypeMouseMoved NSMouseMoved
+#define NSEventTypeLeftMouseDown NSLeftMouseDown
+#define NSEventTypeRightMouseDown NSRightMouseDown
+#define NSEventTypeOtherMouseDown NSOtherMouseDown
+#define NSEventTypeLeftMouseUp NSLeftMouseUp
+#define NSEventTypeRightMouseUp NSRightMouseUp
+#define NSEventTypeOtherMouseUp NSOtherMouseUp
+#define NSEventTypeLeftMouseDragged NSLeftMouseDragged
+#define NSEventTypeRightMouseDragged NSRightMouseDragged
+#define NSEventTypeOtherMouseDragged NSOtherMouseDragged
+#define NSEventTypeScrollWheel NSScrollWheel
+#define NSEventTypeKeyDown NSKeyDown
+#define NSEventTypeKeyUp NSKeyUp
+#define NSEventTypeFlagsChanged NSFlagsChanged
+#define NSEventMaskAny NSAnyEventMask
+#define NSWindowStyleMaskBorderless NSBorderlessWindowMask
+#define NSWindowStyleMaskClosable NSClosableWindowMask
+#define NSWindowStyleMaskFullScreen NSFullScreenWindowMask
+#define NSWindowStyleMaskMiniaturizable NSMiniaturizableWindowMask
+#define NSWindowStyleMaskResizable NSResizableWindowMask
+#define NSWindowStyleMaskTitled NSTitledWindowMask
+#define NSAlertStyleCritical NSCriticalAlertStyle
+#define NSControlSizeRegular NSRegularControlSize
+#endif
+
#endif /* HAVE_NS */
diff --git a/src/nsterm.m b/src/nsterm.m
index 4f99a13c44e..7e6ec85abf1 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -68,9 +68,10 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
#include "macfont.h"
#endif
-
-extern NSString *NSMenuDidBeginTrackingNotification;
-
+static EmacsMenu *dockMenu;
+#ifdef NS_IMPL_COCOA
+static EmacsMenu *mainMenu;
+#endif
/* ==========================================================================
@@ -230,22 +231,22 @@ static unsigned convert_ns_to_X_keysym[] =
NSNewlineCharacter, 0x0D,
NSEnterCharacter, 0x8D,
- 0x41|NSNumericPadKeyMask, 0xAE, /* KP_Decimal */
- 0x43|NSNumericPadKeyMask, 0xAA, /* KP_Multiply */
- 0x45|NSNumericPadKeyMask, 0xAB, /* KP_Add */
- 0x4B|NSNumericPadKeyMask, 0xAF, /* KP_Divide */
- 0x4E|NSNumericPadKeyMask, 0xAD, /* KP_Subtract */
- 0x51|NSNumericPadKeyMask, 0xBD, /* KP_Equal */
- 0x52|NSNumericPadKeyMask, 0xB0, /* KP_0 */
- 0x53|NSNumericPadKeyMask, 0xB1, /* KP_1 */
- 0x54|NSNumericPadKeyMask, 0xB2, /* KP_2 */
- 0x55|NSNumericPadKeyMask, 0xB3, /* KP_3 */
- 0x56|NSNumericPadKeyMask, 0xB4, /* KP_4 */
- 0x57|NSNumericPadKeyMask, 0xB5, /* KP_5 */
- 0x58|NSNumericPadKeyMask, 0xB6, /* KP_6 */
- 0x59|NSNumericPadKeyMask, 0xB7, /* KP_7 */
- 0x5B|NSNumericPadKeyMask, 0xB8, /* KP_8 */
- 0x5C|NSNumericPadKeyMask, 0xB9, /* KP_9 */
+ 0x41|NSEventModifierFlagNumericPad, 0xAE, /* KP_Decimal */
+ 0x43|NSEventModifierFlagNumericPad, 0xAA, /* KP_Multiply */
+ 0x45|NSEventModifierFlagNumericPad, 0xAB, /* KP_Add */
+ 0x4B|NSEventModifierFlagNumericPad, 0xAF, /* KP_Divide */
+ 0x4E|NSEventModifierFlagNumericPad, 0xAD, /* KP_Subtract */
+ 0x51|NSEventModifierFlagNumericPad, 0xBD, /* KP_Equal */
+ 0x52|NSEventModifierFlagNumericPad, 0xB0, /* KP_0 */
+ 0x53|NSEventModifierFlagNumericPad, 0xB1, /* KP_1 */
+ 0x54|NSEventModifierFlagNumericPad, 0xB2, /* KP_2 */
+ 0x55|NSEventModifierFlagNumericPad, 0xB3, /* KP_3 */
+ 0x56|NSEventModifierFlagNumericPad, 0xB4, /* KP_4 */
+ 0x57|NSEventModifierFlagNumericPad, 0xB5, /* KP_5 */
+ 0x58|NSEventModifierFlagNumericPad, 0xB6, /* KP_6 */
+ 0x59|NSEventModifierFlagNumericPad, 0xB7, /* KP_7 */
+ 0x5B|NSEventModifierFlagNumericPad, 0xB8, /* KP_8 */
+ 0x5C|NSEventModifierFlagNumericPad, 0xB9, /* KP_9 */
0x1B, 0x1B /* escape */
};
@@ -255,7 +256,8 @@ static unsigned convert_ns_to_X_keysym[] =
no way to control this behavior. */
float ns_antialias_threshold;
-NSArray *ns_send_types =0, *ns_return_types =0, *ns_drag_types =0;
+NSArray *ns_send_types = 0, *ns_return_types = 0;
+static NSArray *ns_drag_types = 0;
NSString *ns_app_name = @"Emacs"; /* default changed later */
/* Display variables */
@@ -333,28 +335,28 @@ static CGPoint menu_mouse_point;
/* Convert modifiers in a NeXTstep event to emacs style modifiers. */
#define NS_FUNCTION_KEY_MASK 0x800000
-#define NSLeftControlKeyMask (0x000001 | NSControlKeyMask)
-#define NSRightControlKeyMask (0x002000 | NSControlKeyMask)
-#define NSLeftCommandKeyMask (0x000008 | NSCommandKeyMask)
-#define NSRightCommandKeyMask (0x000010 | NSCommandKeyMask)
-#define NSLeftAlternateKeyMask (0x000020 | NSAlternateKeyMask)
-#define NSRightAlternateKeyMask (0x000040 | NSAlternateKeyMask)
+#define NSLeftControlKeyMask (0x000001 | NSEventModifierFlagControl)
+#define NSRightControlKeyMask (0x002000 | NSEventModifierFlagControl)
+#define NSLeftCommandKeyMask (0x000008 | NSEventModifierFlagCommand)
+#define NSRightCommandKeyMask (0x000010 | NSEventModifierFlagCommand)
+#define NSLeftAlternateKeyMask (0x000020 | NSEventModifierFlagOption)
+#define NSRightAlternateKeyMask (0x000040 | NSEventModifierFlagOption)
#define EV_MODIFIERS2(flags) \
- (((flags & NSHelpKeyMask) ? \
+ (((flags & NSEventModifierFlagHelp) ? \
hyper_modifier : 0) \
| (!EQ (ns_right_alternate_modifier, Qleft) && \
((flags & NSRightAlternateKeyMask) \
== NSRightAlternateKeyMask) ? \
parse_solitary_modifier (ns_right_alternate_modifier) : 0) \
- | ((flags & NSAlternateKeyMask) ? \
+ | ((flags & NSEventModifierFlagOption) ? \
parse_solitary_modifier (ns_alternate_modifier) : 0) \
- | ((flags & NSShiftKeyMask) ? \
+ | ((flags & NSEventModifierFlagShift) ? \
shift_modifier : 0) \
| (!EQ (ns_right_control_modifier, Qleft) && \
((flags & NSRightControlKeyMask) \
== NSRightControlKeyMask) ? \
parse_solitary_modifier (ns_right_control_modifier) : 0) \
- | ((flags & NSControlKeyMask) ? \
+ | ((flags & NSEventModifierFlagControl) ? \
parse_solitary_modifier (ns_control_modifier) : 0) \
| ((flags & NS_FUNCTION_KEY_MASK) ? \
parse_solitary_modifier (ns_function_modifier) : 0) \
@@ -362,24 +364,24 @@ static CGPoint menu_mouse_point;
((flags & NSRightCommandKeyMask) \
== NSRightCommandKeyMask) ? \
parse_solitary_modifier (ns_right_command_modifier) : 0) \
- | ((flags & NSCommandKeyMask) ? \
+ | ((flags & NSEventModifierFlagCommand) ? \
parse_solitary_modifier (ns_command_modifier):0))
#define EV_MODIFIERS(e) EV_MODIFIERS2 ([e modifierFlags])
#define EV_UDMODIFIERS(e) \
- ((([e type] == NSLeftMouseDown) ? down_modifier : 0) \
- | (([e type] == NSRightMouseDown) ? down_modifier : 0) \
- | (([e type] == NSOtherMouseDown) ? down_modifier : 0) \
- | (([e type] == NSLeftMouseDragged) ? down_modifier : 0) \
- | (([e type] == NSRightMouseDragged) ? down_modifier : 0) \
- | (([e type] == NSOtherMouseDragged) ? down_modifier : 0) \
- | (([e type] == NSLeftMouseUp) ? up_modifier : 0) \
- | (([e type] == NSRightMouseUp) ? up_modifier : 0) \
- | (([e type] == NSOtherMouseUp) ? up_modifier : 0))
+ ((([e type] == NSEventTypeLeftMouseDown) ? down_modifier : 0) \
+ | (([e type] == NSEventTypeRightMouseDown) ? down_modifier : 0) \
+ | (([e type] == NSEventTypeOtherMouseDown) ? down_modifier : 0) \
+ | (([e type] == NSEventTypeLeftMouseDragged) ? down_modifier : 0) \
+ | (([e type] == NSEventTypeRightMouseDragged) ? down_modifier : 0) \
+ | (([e type] == NSEventTypeOtherMouseDragged) ? down_modifier : 0) \
+ | (([e type] == NSEventTypeLeftMouseUp) ? up_modifier : 0) \
+ | (([e type] == NSEventTypeRightMouseUp) ? up_modifier : 0) \
+ | (([e type] == NSEventTypeOtherMouseUp) ? up_modifier : 0))
#define EV_BUTTON(e) \
- ((([e type] == NSLeftMouseDown) || ([e type] == NSLeftMouseUp)) ? 0 : \
- (([e type] == NSRightMouseDown) || ([e type] == NSRightMouseUp)) ? 2 : \
+ ((([e type] == NSEventTypeLeftMouseDown) || ([e type] == NSEventTypeLeftMouseUp)) ? 0 : \
+ (([e type] == NSEventTypeRightMouseDown) || ([e type] == NSEventTypeRightMouseUp)) ? 2 : \
[e buttonNumber] - 1)
/* Convert the time field to a timestamp in milliseconds. */
@@ -413,7 +415,6 @@ static CGPoint menu_mouse_point;
/* TODO: get rid of need for these forward declarations */
static void ns_condemn_scroll_bars (struct frame *f);
static void ns_judge_scroll_bars (struct frame *f);
-void x_set_frame_alpha (struct frame *f);
/* ==========================================================================
@@ -437,7 +438,7 @@ ns_init_events (struct input_event* ev)
}
void
-ns_finish_events ()
+ns_finish_events (void)
{
emacs_event = NULL;
}
@@ -1423,7 +1424,8 @@ ns_ring_bell (struct frame *f)
}
-static void hide_bell ()
+static void
+hide_bell (void)
/* --------------------------------------------------------------------------
Ensure the bell is hidden.
-------------------------------------------------------------------------- */
@@ -1806,23 +1808,6 @@ x_set_window_size (struct frame *f,
[window setFrame: wr display: YES];
- /* This is a trick to compensate for Emacs' managing the scrollbar area
- as a fixed number of standard character columns. Instead of leaving
- blank space for the extra, we chopped it off above. Now for
- left-hand scrollbars, we shift all rendering to the left by the
- difference between the real width and Emacs' imagined one. For
- right-hand bars, don't worry about it since the extra is never used.
- (Obviously doesn't work for vertically split windows tho..) */
- {
- NSPoint origin = FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f)
- ? NSMakePoint (FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f)
- - NS_SCROLL_BAR_WIDTH (f), 0)
- : NSMakePoint (0, 0);
-
- [view setFrame: NSMakeRect (0, 0, pixelwidth, pixelheight)];
- [view setBoundsOrigin: origin];
- }
-
[view updateFrameSize: NO];
unblock_input ();
}
@@ -1914,37 +1899,6 @@ ns_index_color (NSColor *color, struct frame *f)
}
-void
-ns_free_indexed_color (unsigned long idx, struct frame *f)
-{
- struct ns_color_table *color_table;
- NSColor *color;
- NSNumber *index;
-
- if (!f)
- return;
-
- color_table = FRAME_DISPLAY_INFO (f)->color_table;
-
- if (idx <= 0 || idx >= color_table->size) {
- message1 ("ns_free_indexed_color: Color index out of range.\n");
- return;
- }
-
- index = [NSNumber numberWithUnsignedInt: idx];
- if ([color_table->empty_indices containsObject: index]) {
- message1 ("ns_free_indexed_color: attempt to free already freed color.\n");
- return;
- }
-
- color = color_table->colors[idx];
- [color release];
- color_table->colors[idx] = nil;
- [color_table->empty_indices addObject: index];
-/*fprintf(stderr, "color_table: FREED %d\n",idx);*/
-}
-
-
static int
ns_get_color (const char *name, NSColor **col)
/* --------------------------------------------------------------------------
@@ -2026,7 +1980,7 @@ ns_get_color (const char *name, NSColor **col)
if (hex[0])
{
- int rr, gg, bb;
+ unsigned int rr, gg, bb;
float fscale = scaling == 4 ? 65535.0 : (scaling == 2 ? 255.0 : 15.0);
if (sscanf (hex, "%x/%x/%x", &rr, &gg, &bb))
{
@@ -2091,46 +2045,6 @@ ns_lisp_to_color (Lisp_Object color, NSColor **col)
}
-Lisp_Object
-ns_color_to_lisp (NSColor *col)
-/* --------------------------------------------------------------------------
- Convert a color to a lisp string with the RGB equivalent
- -------------------------------------------------------------------------- */
-{
- EmacsCGFloat red, green, blue, alpha, gray;
- char buf[1024];
- const char *str;
- NSTRACE ("ns_color_to_lisp");
-
- block_input ();
- if ([[col colorSpaceName] isEqualToString: NSNamedColorSpace])
-
- if ((str =[[col colorNameComponent] UTF8String]))
- {
- unblock_input ();
- return build_string ((char *)str);
- }
-
- [[col colorUsingDefaultColorSpace]
- getRed: &red green: &green blue: &blue alpha: &alpha];
- if (red == green && red == blue)
- {
- [[col colorUsingColorSpaceName: NSCalibratedWhiteColorSpace]
- getWhite: &gray alpha: &alpha];
- snprintf (buf, sizeof (buf), "#%2.2lx%2.2lx%2.2lx",
- lrint (gray * 0xff), lrint (gray * 0xff), lrint (gray * 0xff));
- unblock_input ();
- return build_string (buf);
- }
-
- snprintf (buf, sizeof (buf), "#%2.2lx%2.2lx%2.2lx",
- lrint (red*0xff), lrint (green*0xff), lrint (blue*0xff));
-
- unblock_input ();
- return build_string (buf);
-}
-
-
void
ns_query_color(void *col, XColor *color_def, int setPixel)
/* --------------------------------------------------------------------------
@@ -2479,7 +2393,8 @@ ns_clear_frame (struct frame *f)
block_input ();
ns_focus (f, &r, 1);
- [ns_lookup_indexed_color (NS_FACE_BACKGROUND (FRAME_DEFAULT_FACE (f)), f) set];
+ [ns_lookup_indexed_color (NS_FACE_BACKGROUND
+ (FACE_FROM_ID (f, DEFAULT_FACE_ID)), f) set];
NSRectFill (r);
ns_unfocus (f);
@@ -2804,7 +2719,7 @@ ns_draw_fringe_bitmap (struct window *w, struct glyph_row *row,
[img drawInRect: r
fromRect: fromRect
- operation: NSCompositeSourceOver
+ operation: NSCompositingOperationSourceOver
fraction: 1.0
respectFlipped: YES
hints: nil];
@@ -2812,7 +2727,7 @@ ns_draw_fringe_bitmap (struct window *w, struct glyph_row *row,
{
NSPoint pt = r.origin;
pt.y += p->h;
- [img compositeToPoint: pt operation: NSCompositeSourceOver];
+ [img compositeToPoint: pt operation: NSCompositingOperationSourceOver];
}
#endif
}
@@ -2878,7 +2793,10 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row,
{
if (cursor_width < 1)
cursor_width = max (FRAME_CURSOR_WIDTH (f), 1);
- w->phys_cursor_width = cursor_width;
+
+ /* The bar cursor should never be wider than the glyph. */
+ if (cursor_width < w->phys_cursor_width)
+ w->phys_cursor_width = cursor_width;
}
/* If we have an HBAR, "cursor_width" MAY specify height. */
else if (cursor_type == HBAR_CURSOR)
@@ -2895,12 +2813,11 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row,
r.size.height = h;
r.size.width = w->phys_cursor_width;
- /* TODO: only needed in rare cases with last-resort font in HELLO..
- should we do this more efficiently? */
- ns_clip_to_row (w, glyph_row, ANY_AREA, NO); /* do ns_focus(f, &r, 1); if remove */
+ /* Prevent the cursor from being drawn outside the text area. */
+ ns_clip_to_row (w, glyph_row, TEXT_AREA, NO); /* do ns_focus(f, &r, 1); if remove */
- face = FACE_FROM_ID (f, phys_cursor_glyph->face_id);
+ face = FACE_FROM_ID_OR_NULL (f, phys_cursor_glyph->face_id);
if (face && NS_FACE_BACKGROUND (face)
== ns_index_color (FRAME_CURSOR_COLOR (f), f))
{
@@ -2972,11 +2889,12 @@ ns_draw_vertical_window_border (struct window *w, int x, int y0, int y1)
NSTRACE ("ns_draw_vertical_window_border");
- face = FACE_FROM_ID (f, VERTICAL_BORDER_FACE_ID);
- if (face)
- [ns_lookup_indexed_color(face->foreground, f) set];
+ face = FACE_FROM_ID_OR_NULL (f, VERTICAL_BORDER_FACE_ID);
ns_focus (f, &r, 1);
+ if (face)
+ [ns_lookup_indexed_color(face->foreground, f) set];
+
NSRectFill(r);
ns_unfocus (f);
}
@@ -2994,11 +2912,12 @@ ns_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1)
NSTRACE ("ns_draw_window_divider");
- face = FACE_FROM_ID (f, WINDOW_DIVIDER_FACE_ID);
- if (face)
- [ns_lookup_indexed_color(face->foreground, f) set];
+ face = FACE_FROM_ID_OR_NULL (f, WINDOW_DIVIDER_FACE_ID);
ns_focus (f, &r, 1);
+ if (face)
+ [ns_lookup_indexed_color(face->foreground, f) set];
+
NSRectFill(r);
ns_unfocus (f);
}
@@ -3087,7 +3006,7 @@ ns_draw_underwave (struct glyph_string *s, EmacsCGFloat width, EmacsCGFloat x)
-void
+static void
ns_draw_text_decoration (struct glyph_string *s, struct face *face,
NSColor *defaultCol, CGFloat width, CGFloat x)
/* --------------------------------------------------------------------------
@@ -3327,7 +3246,8 @@ ns_dumpglyphs_box_or_relief (struct glyph_string *s)
if (s->hl == DRAW_MOUSE_FACE)
{
- face = FACE_FROM_ID (s->f, MOUSE_HL_INFO (s->f)->mouse_face_face_id);
+ face = FACE_FROM_ID_OR_NULL (s->f,
+ MOUSE_HL_INFO (s->f)->mouse_face_face_id);
if (!face)
face = FACE_FROM_ID (s->f, MOUSE_FACE_ID);
}
@@ -3394,8 +3314,9 @@ ns_maybe_dumpglyphs_background (struct glyph_string *s, char force_p)
struct face *face;
if (s->hl == DRAW_MOUSE_FACE)
{
- face = FACE_FROM_ID (s->f,
- MOUSE_HL_INFO (s->f)->mouse_face_face_id);
+ face
+ = FACE_FROM_ID_OR_NULL (s->f,
+ MOUSE_HL_INFO (s->f)->mouse_face_face_id);
if (!face)
face = FACE_FROM_ID (s->f, MOUSE_FACE_ID);
}
@@ -3461,7 +3382,8 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r)
with its background color), we must clear just the image area. */
if (s->hl == DRAW_MOUSE_FACE)
{
- face = FACE_FROM_ID (s->f, MOUSE_HL_INFO (s->f)->mouse_face_face_id);
+ face = FACE_FROM_ID_OR_NULL (s->f,
+ MOUSE_HL_INFO (s->f)->mouse_face_face_id);
if (!face)
face = FACE_FROM_ID (s->f, MOUSE_FACE_ID);
}
@@ -3488,17 +3410,18 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r)
{
#ifdef NS_IMPL_COCOA
NSRect dr = NSMakeRect (x, y, s->slice.width, s->slice.height);
- NSRect ir = NSMakeRect (s->slice.x, s->slice.y,
+ NSRect ir = NSMakeRect (s->slice.x,
+ s->img->height - s->slice.y - s->slice.height,
s->slice.width, s->slice.height);
[img drawInRect: dr
fromRect: ir
- operation: NSCompositeSourceOver
+ operation: NSCompositingOperationSourceOver
fraction: 1.0
respectFlipped: YES
hints: nil];
#else
[img compositeToPoint: NSMakePoint (x, y + s->slice.height)
- operation: NSCompositeSourceOver];
+ operation: NSCompositingOperationSourceOver];
#endif
}
@@ -3578,7 +3501,8 @@ ns_dumpglyphs_stretch (struct glyph_string *s)
if (s->hl == DRAW_MOUSE_FACE)
{
- face = FACE_FROM_ID (s->f, MOUSE_HL_INFO (s->f)->mouse_face_face_id);
+ face = FACE_FROM_ID_OR_NULL (s->f,
+ MOUSE_HL_INFO (s->f)->mouse_face_face_id);
if (!face)
face = FACE_FROM_ID (s->f, MOUSE_FACE_ID);
}
@@ -3656,6 +3580,32 @@ ns_dumpglyphs_stretch (struct glyph_string *s)
static void
+ns_draw_glyph_string_foreground (struct glyph_string *s)
+{
+ int x, flags;
+ struct font *font = s->font;
+
+ /* If first glyph of S has a left box line, start drawing the text
+ of S to the right of that box line. */
+ if (s->face && s->face->box != FACE_NO_BOX
+ && s->first_glyph->left_box_line_p)
+ x = s->x + eabs (s->face->box_line_width);
+ else
+ x = s->x;
+
+ flags = s->hl == DRAW_CURSOR ? NS_DUMPGLYPH_CURSOR :
+ (s->hl == DRAW_MOUSE_FACE ? NS_DUMPGLYPH_MOUSEFACE :
+ (s->for_overlaps ? NS_DUMPGLYPH_FOREGROUND :
+ NS_DUMPGLYPH_NORMAL));
+
+ font->driver->draw
+ (s, s->cmp_from, s->nchars, x, s->ybase,
+ (flags == NS_DUMPGLYPH_NORMAL && !s->background_filled_p)
+ || flags == NS_DUMPGLYPH_MOUSEFACE);
+}
+
+
+static void
ns_draw_composite_glyph_string_foreground (struct glyph_string *s)
{
int i, j, x;
@@ -3753,7 +3703,7 @@ ns_draw_glyph_string (struct glyph_string *s)
{
/* TODO (optimize): focus for box and contents draw */
NSRect r[2];
- int n, flags;
+ int n;
char box_drawn_p = 0;
struct font *font = s->face->font;
if (! font) font = FRAME_FONT (s->f);
@@ -3823,11 +3773,6 @@ ns_draw_glyph_string (struct glyph_string *s)
ns_maybe_dumpglyphs_background
(s, s->first_glyph->type == COMPOSITE_GLYPH);
- flags = s->hl == DRAW_CURSOR ? NS_DUMPGLYPH_CURSOR :
- (s->hl == DRAW_MOUSE_FACE ? NS_DUMPGLYPH_MOUSEFACE :
- (s->for_overlaps ? NS_DUMPGLYPH_FOREGROUND :
- NS_DUMPGLYPH_NORMAL));
-
if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR)
{
unsigned long tmp = NS_FACE_BACKGROUND (s->face);
@@ -3841,10 +3786,7 @@ ns_draw_glyph_string (struct glyph_string *s)
if (isComposite)
ns_draw_composite_glyph_string_foreground (s);
else
- font->driver->draw
- (s, s->cmp_from, s->nchars, s->x, s->ybase,
- (flags == NS_DUMPGLYPH_NORMAL && !s->background_filled_p)
- || flags == NS_DUMPGLYPH_MOUSEFACE);
+ ns_draw_glyph_string_foreground (s);
}
{
@@ -3940,7 +3882,7 @@ ns_send_appdefined (int value)
/* OS X 10.10.1 swallows the AppDefined event we are sending ourselves
in certain situations (rapid incoming events).
So check if we have one, if not add one. */
- NSEvent *appev = [NSApp nextEventMatchingMask:NSApplicationDefinedMask
+ NSEvent *appev = [NSApp nextEventMatchingMask:NSEventMaskApplicationDefined
untilDate:[NSDate distantPast]
inMode:NSDefaultRunLoopMode
dequeue:NO];
@@ -3963,7 +3905,7 @@ ns_send_appdefined (int value)
timed_entry = nil;
}
- nxev = [NSEvent otherEventWithType: NSApplicationDefined
+ nxev = [NSEvent otherEventWithType: NSEventTypeApplicationDefined
location: NSMakePoint (0, 0)
modifierFlags: 0
timestamp: 0
@@ -4091,6 +4033,9 @@ ns_read_socket (struct terminal *terminal, struct input_event *hold_quit)
NSTRACE_WHEN (NSTRACE_GROUP_EVENTS, "ns_read_socket");
+ if (apploopnr > 0)
+ return -1; /* Already within event loop. */
+
#ifdef HAVE_NATIVE_FS
check_native_fs ();
#endif
@@ -4175,6 +4120,9 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds,
NSTRACE_WHEN (NSTRACE_GROUP_EVENTS, "ns_select");
+ if (apploopnr > 0)
+ return -1; /* Already within event loop. */
+
#ifdef HAVE_NATIVE_FS
check_native_fs ();
#endif
@@ -4355,7 +4303,7 @@ ns_set_vertical_scroll_bar (struct window *window,
window_box (window, ANY_AREA, 0, &window_y, 0, &window_height);
top = window_y;
height = window_height;
- width = WINDOW_CONFIG_SCROLL_BAR_COLS (window) * FRAME_COLUMN_WIDTH (f);
+ width = NS_SCROLL_BAR_WIDTH (f);
left = WINDOW_SCROLL_BAR_AREA_X (window);
r = NSMakeRect (left, top, width, height);
@@ -4446,34 +4394,20 @@ ns_set_horizontal_scroll_bar (struct window *window,
NSTRACE ("ns_set_horizontal_scroll_bar");
/* Get dimensions. */
- window_box (window, ANY_AREA, 0, &window_x, &window_width, 0);
+ window_box (window, ANY_AREA, &window_x, 0, &window_width, 0);
left = window_x;
width = window_width;
- height = WINDOW_CONFIG_SCROLL_BAR_LINES (window) * FRAME_LINE_HEIGHT (f);
+ height = NS_SCROLL_BAR_HEIGHT (f);
top = WINDOW_SCROLL_BAR_AREA_Y (window);
r = NSMakeRect (left, top, width, height);
/* the parent view is flipped, so we need to flip y value */
v = [view frame];
- /* ??????? PXW/scrollbars !!!!!!!!!!!!!!!!!!!! */
r.origin.y = (v.size.height - r.size.height - r.origin.y);
XSETWINDOW (win, window);
block_input ();
- if (WINDOW_TOTAL_COLS (window) < 5)
- {
- if (!NILP (window->horizontal_scroll_bar))
- {
- bar = XNS_SCROLL_BAR (window->horizontal_scroll_bar);
- [bar removeFromSuperview];
- wset_horizontal_scroll_bar (window, Qnil);
- }
- ns_clear_frame_area (f, left, top, width, height);
- unblock_input ();
- return;
- }
-
if (NILP (window->horizontal_scroll_bar))
{
if (width > 0 && height > 0)
@@ -4488,16 +4422,22 @@ ns_set_horizontal_scroll_bar (struct window *window,
NSRect oldRect;
bar = XNS_SCROLL_BAR (window->horizontal_scroll_bar);
oldRect = [bar frame];
- r.size.width = oldRect.size.width;
if (FRAME_LIVE_P (f) && !NSEqualRects (oldRect, r))
{
- if (oldRect.origin.x != r.origin.x)
- ns_clear_frame_area (f, left, top, width, height);
+ if (oldRect.origin.y != r.origin.y)
+ ns_clear_frame_area (f, left, top, width, height);
[bar setFrame: r];
update_p = YES;
}
}
+ /* If there are both horizontal and vertical scroll-bars they leave
+ a square that belongs to neither. We need to clear it otherwise
+ it fills with junk. */
+ if (!NILP (window->vertical_scroll_bar))
+ ns_clear_frame_area (f, WINDOW_SCROLL_BAR_AREA_X (window), top,
+ NS_SCROLL_BAR_HEIGHT (f), height);
+
if (update_p)
[bar setPosition: position portion: portion whole: whole];
unblock_input ();
@@ -4535,13 +4475,15 @@ ns_redeem_scroll_bar (struct window *window)
{
id bar;
NSTRACE ("ns_redeem_scroll_bar");
- if (!NILP (window->vertical_scroll_bar))
+ if (!NILP (window->vertical_scroll_bar)
+ && WINDOW_HAS_VERTICAL_SCROLL_BAR (window))
{
bar = XNS_SCROLL_BAR (window->vertical_scroll_bar);
[bar reprieve];
}
- if (!NILP (window->horizontal_scroll_bar))
+ if (!NILP (window->horizontal_scroll_bar)
+ && WINDOW_HAS_HORIZONTAL_SCROLL_BAR (window))
{
bar = XNS_SCROLL_BAR (window->horizontal_scroll_bar);
[bar reprieve];
@@ -4985,7 +4927,7 @@ ns_term_init (Lisp_Object display_name)
action: @selector (hideOtherApplications:)
keyEquivalent: @"h"
atIndex: 7];
- [item setKeyEquivalentModifierMask: NSCommandKeyMask | NSAlternateKeyMask];
+ [item setKeyEquivalentModifierMask: NSEventModifierFlagCommand | NSEventModifierFlagOption];
[appMenu insertItem: [NSMenuItem separatorItem] atIndex: 8];
[appMenu insertItemWithTitle: @"Quit Emacs"
action: @selector (terminate:)
@@ -5129,7 +5071,7 @@ ns_term_shutdown (int sig)
pool = [[NSAutoreleasePool alloc] init];
NSEvent *event =
- [self nextEventMatchingMask:NSAnyEventMask
+ [self nextEventMatchingMask:NSEventMaskAny
untilDate:[NSDate distantFuture]
inMode:NSDefaultRunLoopMode
dequeue:YES];
@@ -5178,7 +5120,7 @@ ns_term_shutdown (int sig)
#ifdef NS_IMPL_GNUSTEP
// Keyboard events aren't propagated to file dialogs for some reason.
if ([NSApp modalWindow] != nil &&
- (type == NSKeyDown || type == NSKeyUp || type == NSFlagsChanged))
+ (type == NSEventTypeKeyDown || type == NSEventTypeKeyUp || type == NSEventTypeFlagsChanged))
{
[[NSApp modalWindow] sendEvent: theEvent];
return;
@@ -5202,7 +5144,7 @@ ns_term_shutdown (int sig)
represented_frame = NULL;
}
- if (type == NSApplicationDefined)
+ if (type == NSEventTypeApplicationDefined)
{
switch ([theEvent data2])
{
@@ -5219,13 +5161,13 @@ ns_term_shutdown (int sig)
}
}
- if (type == NSCursorUpdate && window == nil)
+ if (type == NSEventTypeCursorUpdate && window == nil)
{
fprintf (stderr, "Dropping external cursor update event.\n");
return;
}
- if (type == NSApplicationDefined)
+ if (type == NSEventTypeApplicationDefined)
{
/* Events posted by ns_send_appdefined interrupt the run loop here.
But, if a modal window is up, an appdefined can still come through,
@@ -5248,7 +5190,7 @@ ns_term_shutdown (int sig)
It is a mouse move in an auxiliary menu, i.e. on the top right on macOS,
such as Wifi, sound, date or similar.
This prevents "spooky" highlighting in the frame under the menu. */
- if (type == NSMouseMoved && [NSApp modalWindow] == nil)
+ if (type == NSEventTypeMouseMoved && [NSApp modalWindow] == nil)
{
struct ns_display_info *di;
BOOL has_focus = NO;
@@ -5403,7 +5345,7 @@ runAlertPanel(NSString *title,
== NSAlertDefaultReturn;
#else
NSAlert *alert = [[NSAlert alloc] init];
- [alert setAlertStyle: NSCriticalAlertStyle];
+ [alert setAlertStyle: NSAlertStyleCritical];
[alert setMessageText: msgFormat];
[alert addButtonWithTitle: defaultButton];
[alert addButtonWithTitle: alternateButton];
@@ -5423,15 +5365,11 @@ runAlertPanel(NSString *title,
if (NILP (ns_confirm_quit)) // || ns_shutdown_properly --> TO DO
return NSTerminateNow;
- ret = runAlertPanel(ns_app_name,
- @"Exit requested. Would you like to Save Buffers and Exit, or Cancel the request?",
- @"Save Buffers and Exit", @"Cancel");
+ ret = runAlertPanel(ns_app_name,
+ @"Exit requested. Would you like to Save Buffers and Exit, or Cancel the request?",
+ @"Save Buffers and Exit", @"Cancel");
- if (ret)
- return NSTerminateNow;
- else
- return NSTerminateCancel;
- return NSTerminateNow; /* just in case */
+ return ret ? NSTerminateNow : NSTerminateCancel;
}
static int
@@ -5712,7 +5650,7 @@ not_in_argv (NSString *arg)
- (void)changeFont: (id)sender
{
NSEvent *e = [[self window] currentEvent];
- struct face *face = FRAME_DEFAULT_FACE (emacsframe);
+ struct face *face = FACE_FROM_ID (emacsframe, DEFAULT_FACE_ID);
struct font *font = face->font;
id newFont;
CGFloat size;
@@ -5787,7 +5725,7 @@ not_in_argv (NSString *arg)
/* Rhapsody and macOS give up and down events for the arrow keys */
if (ns_fake_keydown == YES)
ns_fake_keydown = NO;
- else if ([theEvent type] != NSKeyDown)
+ else if ([theEvent type] != NSEventTypeKeyDown)
return;
if (!emacs_event)
@@ -5831,12 +5769,12 @@ not_in_argv (NSString *arg)
/* (Carbon way: [theEvent keyCode]) */
/* is it a "function key"? */
- /* Note: Sometimes a plain key will have the NSNumericPadKeyMask
+ /* Note: Sometimes a plain key will have the NSEventModifierFlagNumericPad
flag set (this is probably a bug in the OS).
*/
- if (code < 0x00ff && (flags&NSNumericPadKeyMask))
+ if (code < 0x00ff && (flags&NSEventModifierFlagNumericPad))
{
- fnKeysym = ns_convert_key ([theEvent keyCode] | NSNumericPadKeyMask);
+ fnKeysym = ns_convert_key ([theEvent keyCode] | NSEventModifierFlagNumericPad);
}
if (fnKeysym == 0)
{
@@ -5865,15 +5803,15 @@ not_in_argv (NSString *arg)
/* are there modifiers? */
emacs_event->modifiers = 0;
- if (flags & NSHelpKeyMask)
+ if (flags & NSEventModifierFlagHelp)
emacs_event->modifiers |= hyper_modifier;
- if (flags & NSShiftKeyMask)
+ if (flags & NSEventModifierFlagShift)
emacs_event->modifiers |= shift_modifier;
is_right_key = (flags & NSRightCommandKeyMask) == NSRightCommandKeyMask;
is_left_key = (flags & NSLeftCommandKeyMask) == NSLeftCommandKeyMask
- || (! is_right_key && (flags & NSCommandKeyMask) == NSCommandKeyMask);
+ || (! is_right_key && (flags & NSEventModifierFlagCommand) == NSEventModifierFlagCommand);
if (is_right_key)
emacs_event->modifiers |= parse_solitary_modifier
@@ -5894,7 +5832,7 @@ not_in_argv (NSString *arg)
{
/* XXX: the code we get will be unshifted, so if we have
a shift modifier, must convert ourselves */
- if (!(flags & NSShiftKeyMask))
+ if (!(flags & NSEventModifierFlagShift))
code = [[theEvent characters] characterAtIndex: 0];
#if 0
/* this is ugly and also requires linking w/Carbon framework
@@ -5909,7 +5847,7 @@ not_in_argv (NSString *arg)
UCKeyTranslate ((UCKeyboardLayout*)*uchrHandle,
[[theEvent characters] characterAtIndex: 0],
kUCKeyActionDisplay,
- (flags & ~NSCommandKeyMask) >> 8,
+ (flags & ~NSEventModifierFlagCommand) >> 8,
LMGetKbdType (), kUCKeyTranslateNoDeadKeysMask,
&dummy, 1, &dummy, &code);
code &= 0xFF;
@@ -5920,7 +5858,7 @@ not_in_argv (NSString *arg)
is_right_key = (flags & NSRightControlKeyMask) == NSRightControlKeyMask;
is_left_key = (flags & NSLeftControlKeyMask) == NSLeftControlKeyMask
- || (! is_right_key && (flags & NSControlKeyMask) == NSControlKeyMask);
+ || (! is_right_key && (flags & NSEventModifierFlagControl) == NSEventModifierFlagControl);
if (is_right_key)
emacs_event->modifiers |= parse_solitary_modifier
@@ -5943,7 +5881,7 @@ not_in_argv (NSString *arg)
== NSRightAlternateKeyMask;
is_left_key = (flags & NSLeftAlternateKeyMask) == NSLeftAlternateKeyMask
|| (! is_right_key
- && (flags & NSAlternateKeyMask) == NSAlternateKeyMask);
+ && (flags & NSEventModifierFlagOption) == NSEventModifierFlagOption);
if (is_right_key)
{
@@ -5982,7 +5920,7 @@ not_in_argv (NSString *arg)
if (NS_KEYLOG)
fprintf (stderr, "keyDown: code =%x\tfnKey =%x\tflags = %x\tmods = %x\n",
- code, fnKeysym, flags, emacs_event->modifiers);
+ (unsigned) code, fnKeysym, flags, emacs_event->modifiers);
/* if it was a function key or had modifiers, pass it directly to emacs */
if (fnKeysym || (emacs_event->modifiers
@@ -6031,7 +5969,7 @@ not_in_argv (NSString *arg)
NSTRACE ("[EmacsView keyUp:]");
if (floor (NSAppKitVersionNumber) <= 824 /*NSAppKitVersionNumber10_4*/ &&
- code == 0x30 && (flags & NSControlKeyMask) && !(flags & NSCommandKeyMask))
+ code == 0x30 && (flags & NSEventModifierFlagControl) && !(flags & NSEventModifierFlagCommand))
{
if (NS_KEYLOG)
fprintf (stderr, "keyUp: passed test");
@@ -6188,8 +6126,14 @@ not_in_argv (NSString *arg)
+FRAME_LINE_HEIGHT (emacsframe));
pt = [self convertPoint: pt toView: nil];
+#if !defined (NS_IMPL_COCOA) || \
+ MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_7
pt = [[self window] convertBaseToScreen: pt];
rect.origin = pt;
+#else
+ rect.origin = pt;
+ rect = [[self window] convertRectToScreen: rect];
+#endif
return rect;
}
@@ -6278,7 +6222,7 @@ not_in_argv (NSString *arg)
button clicks */
emacsframe->mouse_moved = 0;
- if ([theEvent type] == NSScrollWheel)
+ if ([theEvent type] == NSEventTypeScrollWheel)
{
CGFloat delta = [theEvent deltaY];
/* Mac notebooks send wheel events w/delta =0 when trackpad scrolling */
@@ -6833,12 +6777,12 @@ not_in_argv (NSString *arg)
win = [[EmacsWindow alloc]
initWithContentRect: r
- styleMask: (NSResizableWindowMask |
+ styleMask: (NSWindowStyleMaskResizable |
#if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_7
- NSTitledWindowMask |
+ NSWindowStyleMaskTitled |
#endif
- NSMiniaturizableWindowMask |
- NSClosableWindowMask)
+ NSWindowStyleMaskMiniaturizable |
+ NSWindowStyleMaskClosable)
backing: NSBackingStoreBuffered
defer: YES];
@@ -6914,7 +6858,8 @@ not_in_argv (NSString *arg)
[win makeFirstResponder: self];
col = ns_lookup_indexed_color (NS_FACE_BACKGROUND
- (FRAME_DEFAULT_FACE (emacsframe)), emacsframe);
+ (FACE_FROM_ID (emacsframe, DEFAULT_FACE_ID)),
+ emacsframe);
[win setBackgroundColor: col];
if ([col alphaComponent] != (EmacsCGFloat) 1.0)
[win setOpaque: NO];
@@ -7261,7 +7206,7 @@ not_in_argv (NSString *arg)
else
{
#ifdef HAVE_NATIVE_FS
- res = (([[self window] styleMask] & NSFullScreenWindowMask) != 0);
+ res = (([[self window] styleMask] & NSWindowStyleMaskFullScreen) != 0);
#else
res = NO;
#endif
@@ -7316,7 +7261,7 @@ not_in_argv (NSString *arg)
f = emacsframe;
wr = [w frame];
col = ns_lookup_indexed_color (NS_FACE_BACKGROUND
- (FRAME_DEFAULT_FACE (f)),
+ (FACE_FROM_ID (f, DEFAULT_FACE_ID)),
f);
if (fs_state != FULLSCREEN_BOTH)
@@ -7345,7 +7290,7 @@ not_in_argv (NSString *arg)
fw = [[EmacsFSWindow alloc]
initWithContentRect:[w contentRectForFrameRect:wr]
- styleMask:NSBorderlessWindowMask
+ styleMask:NSWindowStyleMaskBorderless
backing:NSBackingStoreBuffered
defer:YES
screen:screen];
@@ -7653,11 +7598,11 @@ not_in_argv (NSString *arg)
(op & 0xf) != 0xf)
{
if (op & NSDragOperationLink)
- modifiers |= NSControlKeyMask;
+ modifiers |= NSEventModifierFlagControl;
if (op & NSDragOperationCopy)
- modifiers |= NSAlternateKeyMask;
+ modifiers |= NSEventModifierFlagOption;
if (op & NSDragOperationGeneric)
- modifiers |= NSCommandKeyMask;
+ modifiers |= NSEventModifierFlagCommand;
}
modifiers = EV_MODIFIERS2 (modifiers);
@@ -8106,18 +8051,21 @@ not_in_argv (NSString *arg)
MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_7
r = [NSScroller scrollerWidth];
#else
- r = [NSScroller scrollerWidthForControlSize: NSRegularControlSize
+ r = [NSScroller scrollerWidthForControlSize: NSControlSizeRegular
scrollerStyle: NSScrollerStyleLegacy];
#endif
return r;
}
-
- initFrame: (NSRect )r window: (Lisp_Object)nwin
{
NSTRACE ("[EmacsScroller initFrame: window:]");
- r.size.width = [EmacsScroller scrollerWidth];
+ if (r.size.width > r.size.height)
+ horizontal = YES;
+ else
+ horizontal = NO;
+
[super initWithFrame: r/*NSMakeRect (0, 0, 0, 0)*/];
[self setContinuous: YES];
[self setEnabled: YES];
@@ -8133,9 +8081,12 @@ not_in_argv (NSString *arg)
window = XWINDOW (nwin);
condemned = NO;
- pixel_height = NSHeight (r);
- if (pixel_height == 0) pixel_height = 1;
- min_portion = 20 / pixel_height;
+ if (horizontal)
+ pixel_length = NSWidth (r);
+ else
+ pixel_length = NSHeight (r);
+ if (pixel_length == 0) pixel_length = 1;
+ min_portion = 20 / pixel_length;
frame = XFRAME (window->frame);
if (FRAME_LIVE_P (frame))
@@ -8164,9 +8115,12 @@ not_in_argv (NSString *arg)
NSTRACE ("[EmacsScroller setFrame:]");
/* block_input (); */
- pixel_height = NSHeight (newRect);
- if (pixel_height == 0) pixel_height = 1;
- min_portion = 20 / pixel_height;
+ if (horizontal)
+ pixel_length = NSWidth (newRect);
+ else
+ pixel_length = NSHeight (newRect);
+ if (pixel_length == 0) pixel_length = 1;
+ min_portion = 20 / pixel_length;
[super setFrame: newRect];
/* unblock_input (); */
}
@@ -8176,7 +8130,12 @@ not_in_argv (NSString *arg)
{
NSTRACE ("[EmacsScroller dealloc]");
if (window)
- wset_vertical_scroll_bar (window, Qnil);
+ {
+ if (horizontal)
+ wset_horizontal_scroll_bar (window, Qnil);
+ else
+ wset_vertical_scroll_bar (window, Qnil);
+ }
window = 0;
[super dealloc];
}
@@ -8211,7 +8170,12 @@ not_in_argv (NSString *arg)
if (view != nil)
view->scrollbarsNeedingUpdate++;
if (window)
- wset_vertical_scroll_bar (window, Qnil);
+ {
+ if (horizontal)
+ wset_horizontal_scroll_bar (window, Qnil);
+ else
+ wset_vertical_scroll_bar (window, Qnil);
+ }
window = 0;
[self removeFromSuperview];
[self release];
@@ -8261,7 +8225,7 @@ not_in_argv (NSString *arg)
{
float pos;
CGFloat por;
- portion = max ((float)whole*min_portion/pixel_height, portion);
+ portion = max ((float)whole*min_portion/pixel_length, portion);
pos = (float)position / (whole - portion);
por = (CGFloat)portion/whole;
#ifdef NS_IMPL_COCOA
@@ -8291,10 +8255,20 @@ not_in_argv (NSString *arg)
XSETWINDOW (win, window);
emacs_event->frame_or_window = win;
emacs_event->timestamp = EV_TIMESTAMP (e);
- emacs_event->kind = SCROLL_BAR_CLICK_EVENT;
emacs_event->arg = Qnil;
- XSETINT (emacs_event->x, loc * pixel_height);
- XSETINT (emacs_event->y, pixel_height-20);
+
+ if (horizontal)
+ {
+ emacs_event->kind = HORIZONTAL_SCROLL_BAR_CLICK_EVENT;
+ XSETINT (emacs_event->x, em_whole * loc / pixel_length);
+ XSETINT (emacs_event->y, em_whole);
+ }
+ else
+ {
+ emacs_event->kind = SCROLL_BAR_CLICK_EVENT;
+ XSETINT (emacs_event->x, loc);
+ XSETINT (emacs_event->y, pixel_length-20);
+ }
if (q_event_ptr)
{
@@ -8349,7 +8323,7 @@ not_in_argv (NSString *arg)
NSRect sr, kr;
/* hitPart is only updated AFTER event is passed on */
NSScrollerPart part = [self testPart: [e locationInWindow]];
- CGFloat inc = 0.0, loc, kloc, pos;
+ CGFloat loc, kloc, pos UNINIT;
int edge = 0;
NSTRACE ("[EmacsScroller mouseDown:]");
@@ -8357,15 +8331,15 @@ not_in_argv (NSString *arg)
switch (part)
{
case NSScrollerDecrementPage:
- last_hit_part = scroll_bar_above_handle; inc = -1.0; break;
+ last_hit_part = horizontal ? scroll_bar_before_handle : scroll_bar_above_handle; break;
case NSScrollerIncrementPage:
- last_hit_part = scroll_bar_below_handle; inc = 1.0; break;
+ last_hit_part = horizontal ? scroll_bar_after_handle : scroll_bar_below_handle; break;
case NSScrollerDecrementLine:
- last_hit_part = scroll_bar_up_arrow; inc = -0.1; break;
+ last_hit_part = horizontal ? scroll_bar_left_arrow : scroll_bar_up_arrow; break;
case NSScrollerIncrementLine:
- last_hit_part = scroll_bar_down_arrow; inc = 0.1; break;
+ last_hit_part = horizontal ? scroll_bar_right_arrow : scroll_bar_down_arrow; break;
case NSScrollerKnob:
- last_hit_part = scroll_bar_handle; break;
+ last_hit_part = horizontal ? scroll_bar_horizontal_handle : scroll_bar_handle; break;
case NSScrollerKnobSlot: /* GNUstep-only */
last_hit_part = scroll_bar_move_ratio; break;
default: /* NSScrollerNoPart? */
@@ -8374,36 +8348,34 @@ not_in_argv (NSString *arg)
return;
}
- if (inc != 0.0)
- {
- pos = 0; /* ignored */
-
- /* set a timer to repeat, as we can't let superclass do this modally */
- scroll_repeat_entry
- = [[NSTimer scheduledTimerWithTimeInterval: SCROLL_BAR_FIRST_DELAY
- target: self
- selector: @selector (repeatScroll:)
- userInfo: 0
- repeats: YES]
- retain];
- }
- else
+ if (part == NSScrollerKnob || part == NSScrollerKnobSlot)
{
/* handle, or on GNUstep possibly slot */
NSEvent *fake_event;
+ int length;
/* compute float loc in slot and mouse offset on knob */
sr = [self convertRect: [self rectForPart: NSScrollerKnobSlot]
toView: nil];
- loc = NSHeight (sr) - ([e locationInWindow].y - NSMinY (sr));
+ if (horizontal)
+ {
+ length = NSWidth (sr);
+ loc = ([e locationInWindow].x - NSMinX (sr));
+ }
+ else
+ {
+ length = NSHeight (sr);
+ loc = length - ([e locationInWindow].y - NSMinY (sr));
+ }
+
if (loc <= 0.0)
{
loc = 0.0;
edge = -1;
}
- else if (loc >= NSHeight (sr))
+ else if (loc >= length)
{
- loc = NSHeight (sr);
+ loc = length;
edge = 1;
}
@@ -8413,20 +8385,19 @@ not_in_argv (NSString *arg)
{
kr = [self convertRect: [self rectForPart: NSScrollerKnob]
toView: nil];
- kloc = NSHeight (kr) - ([e locationInWindow].y - NSMinY (kr));
+ if (horizontal)
+ kloc = ([e locationInWindow].x - NSMinX (kr));
+ else
+ kloc = NSHeight (kr) - ([e locationInWindow].y - NSMinY (kr));
}
last_mouse_offset = kloc;
- /* if knob, tell emacs a location offset by knob pos
- (to indicate top of handle) */
- if (part == NSScrollerKnob)
- pos = (loc - last_mouse_offset) / NSHeight (sr);
- else
- /* else this is a slot click on GNUstep: go straight there */
- pos = loc / NSHeight (sr);
+ if (part != NSScrollerKnob)
+ /* this is a slot click on GNUstep: go straight there */
+ pos = loc;
/* send a fake mouse-up to super to preempt modal -trackKnob: mode */
- fake_event = [NSEvent mouseEventWithType: NSLeftMouseUp
+ fake_event = [NSEvent mouseEventWithType: NSEventTypeLeftMouseUp
location: [e locationInWindow]
modifierFlags: [e modifierFlags]
timestamp: [e timestamp]
@@ -8437,6 +8408,19 @@ not_in_argv (NSString *arg)
pressure: [e pressure]];
[super mouseUp: fake_event];
}
+ else
+ {
+ pos = 0; /* ignored */
+
+ /* set a timer to repeat, as we can't let superclass do this modally */
+ scroll_repeat_entry
+ = [[NSTimer scheduledTimerWithTimeInterval: SCROLL_BAR_FIRST_DELAY
+ target: self
+ selector: @selector (repeatScroll:)
+ userInfo: 0
+ repeats: YES]
+ retain];
+ }
if (part != NSScrollerKnob)
[self sendScrollEventAtLoc: pos fromEvent: e];
@@ -8448,23 +8432,34 @@ not_in_argv (NSString *arg)
{
NSRect sr;
double loc, pos;
+ int length;
NSTRACE ("[EmacsScroller mouseDragged:]");
sr = [self convertRect: [self rectForPart: NSScrollerKnobSlot]
toView: nil];
- loc = NSHeight (sr) - ([e locationInWindow].y - NSMinY (sr));
+
+ if (horizontal)
+ {
+ length = NSWidth (sr);
+ loc = ([e locationInWindow].x - NSMinX (sr));
+ }
+ else
+ {
+ length = NSHeight (sr);
+ loc = length - ([e locationInWindow].y - NSMinY (sr));
+ }
if (loc <= 0.0)
{
loc = 0.0;
}
- else if (loc >= NSHeight (sr) + last_mouse_offset)
+ else if (loc >= length + last_mouse_offset)
{
- loc = NSHeight (sr) + last_mouse_offset;
+ loc = length + last_mouse_offset;
}
- pos = (loc - last_mouse_offset) / NSHeight (sr);
+ pos = (loc - last_mouse_offset);
[self sendScrollEventAtLoc: pos fromEvent: e];
}
@@ -8674,14 +8669,16 @@ syms_of_nsterm (void)
DEFVAR_LISP ("ns-alternate-modifier", ns_alternate_modifier,
"This variable describes the behavior of the alternate or option key.\n\
-Set to control, meta, alt, super, or hyper means it is taken to be that key.\n\
+Set to the symbol control, meta, alt, super, or hyper means it is taken to be\n\
+that key.\n\
Set to none means that the alternate / option key is not interpreted by Emacs\n\
at all, allowing it to be used at a lower level for accented character entry.");
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\
-Set to control, meta, alt, super, or hyper means it is taken to be that key.\n\
+Set to the symbol control, meta, alt, super, or hyper means it is taken to be\n\
+that key.\n\
Set to left means be the same key as `ns-alternate-modifier'.\n\
Set to none means that the alternate / option key is not interpreted by Emacs\n\
at all, allowing it to be used at a lower level for accented character entry.");
@@ -8689,12 +8686,14 @@ at all, allowing it to be used at a lower level for accented character entry.");
DEFVAR_LISP ("ns-command-modifier", ns_command_modifier,
"This variable describes the behavior of the command key.\n\
-Set to control, meta, alt, super, or hyper means it is taken to be that key.");
+Set to the symbol control, meta, alt, super, or hyper means it is taken to be\n\
+that key.");
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\
-Set to control, meta, alt, super, or hyper means it is taken to be that key.\n\
+Set to the symbol control, meta, alt, super, or hyper means it is taken to be\n\
+that key.\n\
Set to left means be the same key as `ns-command-modifier'.\n\
Set to none means that the command / option key is not interpreted by Emacs\n\
at all, allowing it to be used at a lower level for accented character entry.");
@@ -8702,12 +8701,14 @@ at all, allowing it to be used at a lower level for accented character entry.");
DEFVAR_LISP ("ns-control-modifier", ns_control_modifier,
"This variable describes the behavior of the control key.\n\
-Set to control, meta, alt, super, or hyper means it is taken to be that key.");
+Set to the symbol control, meta, alt, super, or hyper means it is taken to be\n\
+that key.");
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\
-Set to control, meta, alt, super, or hyper means it is taken to be that key.\n\
+Set to the symbol control, meta, alt, super, or hyper means it is taken to be\n\
+that key.\n\
Set to left means be the same key as `ns-control-modifier'.\n\
Set to none means that the control / option key is not interpreted by Emacs\n\
at all, allowing it to be used at a lower level for accented character entry.");
@@ -8715,7 +8716,8 @@ at all, allowing it to be used at a lower level for accented character entry.");
DEFVAR_LISP ("ns-function-modifier", ns_function_modifier,
"This variable describes the behavior of the function key (on laptops).\n\
-Set to control, meta, alt, super, or hyper means it is taken to be that key.\n\
+Set to the symbol control, meta, alt, super, or hyper means it is taken to be\n\
+that key.\n\
Set to none means that the function key is not interpreted by Emacs at all,\n\
allowing it to be used at a lower level for accented character entry.");
ns_function_modifier = Qnone;
diff --git a/src/print.c b/src/print.c
index 2b53d7580b1..f3db6748d03 100644
--- a/src/print.c
+++ b/src/print.c
@@ -38,6 +38,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <float.h>
#include <ftoastr.h>
+#ifdef WINDOWSNT
+# include <sys/socket.h> /* for F_DUPFD_CLOEXEC */
+#endif
+
struct terminal;
/* Avoid actual stack overflow in print. */
@@ -199,7 +203,7 @@ print_unwind (Lisp_Object saved_text)
static void
printchar_to_stream (unsigned int ch, FILE *stream)
{
- Lisp_Object dv IF_LINT (= Qnil);
+ Lisp_Object dv UNINIT;
ptrdiff_t i = 0, n = 1;
Lisp_Object coding_system = Vlocale_coding_system;
bool encode_p = false;
@@ -660,8 +664,6 @@ A printed representation of an object is text which describes that object. */)
but we don't want to deactivate the mark just for that.
No need for specbind, since errors deactivate the mark. */
Lisp_Object save_deactivate_mark = Vdeactivate_mark;
- bool prev_abort_on_gc = abort_on_gc;
- abort_on_gc = true;
Lisp_Object printcharfun = Vprin1_to_string_buffer;
PRINTPREPARE;
@@ -683,7 +685,6 @@ A printed representation of an object is text which describes that object. */)
Vdeactivate_mark = save_deactivate_mark;
- abort_on_gc = prev_abort_on_gc;
return unbind_to (count, object);
}
@@ -775,15 +776,6 @@ debug_output_compilation_hack (bool x)
print_output_debug_flag = x;
}
-#if defined (GNU_LINUX)
-
-/* This functionality is not vitally important in general, so we rely on
- non-portable ability to use stderr as lvalue. */
-
-#define WITH_REDIRECT_DEBUGGING_OUTPUT 1
-
-static FILE *initial_stderr_stream = NULL;
-
DEFUN ("redirect-debugging-output", Fredirect_debugging_output, Sredirect_debugging_output,
1, 2,
"FDebug output file: \nP",
@@ -793,30 +785,38 @@ Optional arg APPEND non-nil (interactively, with prefix arg) means
append to existing target file. */)
(Lisp_Object file, Lisp_Object append)
{
- if (initial_stderr_stream != NULL)
- {
- block_input ();
- fclose (stderr);
- unblock_input ();
- }
- stderr = initial_stderr_stream;
- initial_stderr_stream = NULL;
+ /* If equal to STDERR_FILENO, stderr has not been duplicated and is OK as-is.
+ Otherwise, this is a close-on-exec duplicate of the original stderr. */
+ static int stderr_dup = STDERR_FILENO;
+ int fd = stderr_dup;
- if (STRINGP (file))
+ if (! NILP (file))
{
file = Fexpand_file_name (file, Qnil);
- initial_stderr_stream = stderr;
- stderr = emacs_fopen (SSDATA (file), NILP (append) ? "w" : "a");
- if (stderr == NULL)
+
+ if (stderr_dup == STDERR_FILENO)
{
- stderr = initial_stderr_stream;
- initial_stderr_stream = NULL;
- report_file_error ("Cannot open debugging output stream", file);
+ int n = fcntl (STDERR_FILENO, F_DUPFD_CLOEXEC, STDERR_FILENO + 1);
+ if (n < 0)
+ report_file_error ("dup", file);
+ stderr_dup = n;
}
+
+ fd = emacs_open (SSDATA (ENCODE_FILE (file)),
+ (O_WRONLY | O_CREAT
+ | (! NILP (append) ? O_APPEND : O_TRUNC)),
+ 0666);
+ if (fd < 0)
+ report_file_error ("Cannot open debugging output stream", file);
}
+
+ fflush (stderr);
+ if (dup2 (fd, STDERR_FILENO) < 0)
+ report_file_error ("dup2", file);
+ if (fd != stderr_dup)
+ emacs_close (fd);
return Qnil;
}
-#endif /* GNU_LINUX */
/* This is the interface for debugging printing. */
@@ -917,7 +917,7 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
else
{
Lisp_Object error_conditions = Fget (errname, Qerror_conditions);
- errmsg = Fget (errname, Qerror_message);
+ errmsg = Fsubstitute_command_keys (Fget (errname, Qerror_message));
file_error = Fmemq (Qfile_error, error_conditions);
}
@@ -936,7 +936,7 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
if (!STRINGP (errmsg))
write_string_1 ("peculiar error", stream);
else if (SCHARS (errmsg))
- Fprinc (Fsubstitute_command_keys (errmsg), stream);
+ Fprinc (errmsg, stream);
else
sep = NULL;
@@ -2305,9 +2305,7 @@ priorities. */);
defsubr (&Sprint);
defsubr (&Sterpri);
defsubr (&Swrite_char);
-#ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
defsubr (&Sredirect_debugging_output);
-#endif
DEFSYM (Qprint_escape_newlines, "print-escape-newlines");
DEFSYM (Qprint_escape_multibyte, "print-escape-multibyte");
diff --git a/src/process.c b/src/process.c
index e6ea2fbe8f7..d68c930dd6f 100644
--- a/src/process.c
+++ b/src/process.c
@@ -22,6 +22,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
+#include <stdlib.h>
#include <errno.h>
#include <sys/types.h> /* Some typedefs are used in sys/file.h. */
#include <sys/file.h>
@@ -39,6 +40,15 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <netinet/in.h>
#include <arpa/inet.h>
+#ifdef HAVE_SETRLIMIT
+# include <sys/resource.h>
+
+/* If NOFILE_LIMIT.rlim_cur is greater than FD_SETSIZE, then
+ NOFILE_LIMIT is the initial limit on the number of open files,
+ which should be restored in child processes. */
+static struct rlimit nofile_limit;
+#endif
+
/* Are local (unix) sockets supported? */
#if defined (HAVE_SYS_UN_H)
#if !defined (AF_LOCAL) && defined (AF_UNIX)
@@ -75,11 +85,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
# include <sys/stropts.h>
#endif
-#ifdef HAVE_RES_INIT
-#include <arpa/nameser.h>
-#include <resolv.h>
-#endif
-
#ifdef HAVE_UTIL_H
#include <util.h>
#endif
@@ -89,6 +94,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#endif
#include <c-ctype.h>
+#include <flexmember.h>
#include <sig2str.h>
#include <verify.h>
@@ -125,15 +131,20 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#endif
#endif
+#if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
+/* This is 0.1s in nanoseconds. */
+#define ASYNC_RETRY_NSEC 100000000
+#endif
+
#ifdef WINDOWSNT
extern int sys_select (int, fd_set *, fd_set *, fd_set *,
struct timespec *, void *);
#endif
-/* Work around GCC 4.7.0 bug with strict overflow checking; see
+/* Work around GCC 4.3.0 bug with strict overflow checking; see
<http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>.
This bug appears to be fixed in GCC 5.1, so don't work around it there. */
-#if __GNUC__ == 4 && __GNUC_MINOR__ >= 3
+#if GNUC_PREREQ (4, 3, 0) && ! GNUC_PREREQ (5, 1, 0)
# pragma GCC diagnostic ignored "-Wstrict-overflow"
#endif
@@ -150,6 +161,9 @@ bool inhibit_sentinels;
#ifndef SOCK_CLOEXEC
# define SOCK_CLOEXEC 0
#endif
+#ifndef SOCK_NONBLOCK
+# define SOCK_NONBLOCK 0
+#endif
/* True if ERRNUM represents an error where the system call would
block if a blocking variant were used. */
@@ -205,16 +219,6 @@ static EMACS_INT process_tick;
/* Number of events for which the user or sentinel has been notified. */
static EMACS_INT update_tick;
-/* Define NON_BLOCKING_CONNECT if we can support non-blocking connects.
- The code can be simplified by assuming NON_BLOCKING_CONNECT once
- Emacs starts assuming POSIX 1003.1-2001 or later. */
-
-#if (defined HAVE_SELECT \
- && (defined GNU_LINUX || defined HAVE_GETPEERNAME) \
- && (defined EWOULDBLOCK || defined EINPROGRESS))
-# define NON_BLOCKING_CONNECT
-#endif
-
/* Define DATAGRAM_SOCKETS if datagrams can be used safely on
this system. We need to read full packets, so we need a
"non-destructive" select. So we require either native select,
@@ -245,6 +249,7 @@ static int process_output_delay_count;
static bool process_output_skip;
+static void start_process_unwind (Lisp_Object);
static void create_process (Lisp_Object, char **, Lisp_Object);
#ifdef USABLE_SIGIO
static bool keyboard_bit_set (fd_set *);
@@ -252,11 +257,8 @@ static bool keyboard_bit_set (fd_set *);
static void deactivate_process (Lisp_Object);
static int status_notify (struct Lisp_Process *, struct Lisp_Process *);
static int read_process_output (Lisp_Object, int);
-static void handle_child_signal (int);
static void create_pty (Lisp_Object);
-
-static Lisp_Object get_process (register Lisp_Object name);
-static void exec_sentinel (Lisp_Object proc, Lisp_Object reason);
+static void exec_sentinel (Lisp_Object, Lisp_Object);
/* Mask of bits indicating the descriptors that we wait for input on. */
@@ -274,7 +276,6 @@ static fd_set non_process_wait_mask;
static fd_set write_mask;
-#ifdef NON_BLOCKING_CONNECT
/* Mask of bits indicating the descriptors that we wait for connect to
complete on. Once they complete, they are removed from this mask
and added to the input_wait_mask and non_keyboard_wait_mask. */
@@ -283,7 +284,6 @@ static fd_set connect_wait_mask;
/* Number of bits set in connect_wait_mask. */
static int num_pending_connects;
-#endif /* NON_BLOCKING_CONNECT */
/* The largest descriptor currently in use for a process object; -1 if none. */
static int max_process_desc;
@@ -291,8 +291,15 @@ static int max_process_desc;
/* The largest descriptor currently in use for input; -1 if none. */
static int max_input_desc;
+/* Set the external socket descriptor for Emacs to use when
+ `make-network-process' is called with a non-nil
+ `:use-external-socket' option. The value should be either -1, or
+ the file descriptor of a socket that is already bound. */
+static int external_sock_fd;
+
/* Indexed by descriptor, gives the process (if any) for that descriptor. */
static Lisp_Object chan_process[FD_SETSIZE];
+static void wait_for_socket_fds (Lisp_Object, char const *);
/* Alist of elements (NAME . PROCESS). */
static Lisp_Object Vprocess_alist;
@@ -313,7 +320,7 @@ static struct coding_system *proc_encode_coding_system[FD_SETSIZE];
/* Table of `partner address' for datagram sockets. */
static struct sockaddr_and_len {
struct sockaddr *sa;
- int len;
+ ptrdiff_t len;
} datagram_address[FD_SETSIZE];
#define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
#define DATAGRAM_CONN_P(proc) \
@@ -321,7 +328,6 @@ static struct sockaddr_and_len {
XPROCESS (proc)->infd >= 0 && \
datagram_address[XPROCESS (proc)->infd].sa != 0)
#else
-#define DATAGRAM_CHAN_P(chan) (0)
#define DATAGRAM_CONN_P(proc) (0)
#endif
@@ -393,11 +399,6 @@ pset_sentinel (struct Lisp_Process *p, Lisp_Object val)
p->sentinel = NILP (val) ? Qinternal_default_process_sentinel : val;
}
static void
-pset_status (struct Lisp_Process *p, Lisp_Object val)
-{
- p->status = val;
-}
-static void
pset_tty_name (struct Lisp_Process *p, Lisp_Object val)
{
p->tty_name = val;
@@ -541,25 +542,37 @@ status_convert (int w)
return Qrun;
}
+/* True if STATUS is that of a process attempting connection. */
+
+static bool
+connecting_status (Lisp_Object status)
+{
+ return CONSP (status) && EQ (XCAR (status), Qconnect);
+}
+
/* Given a status-list, extract the three pieces of information
and store them individually through the three pointers. */
static void
-decode_status (Lisp_Object l, Lisp_Object *symbol, int *code, bool *coredump)
+decode_status (Lisp_Object l, Lisp_Object *symbol, Lisp_Object *code,
+ bool *coredump)
{
Lisp_Object tem;
+ if (connecting_status (l))
+ l = XCAR (l);
+
if (SYMBOLP (l))
{
*symbol = l;
- *code = 0;
+ *code = make_number (0);
*coredump = 0;
}
else
{
*symbol = XCAR (l);
tem = XCDR (l);
- *code = XFASTINT (XCAR (tem));
+ *code = XCAR (tem);
tem = XCDR (tem);
*coredump = !NILP (tem);
}
@@ -571,8 +584,7 @@ static Lisp_Object
status_message (struct Lisp_Process *p)
{
Lisp_Object status = p->status;
- Lisp_Object symbol;
- int code;
+ Lisp_Object symbol, code;
bool coredump;
Lisp_Object string;
@@ -582,7 +594,7 @@ status_message (struct Lisp_Process *p)
{
char const *signame;
synchronize_system_messages_locale ();
- signame = strsignal (code);
+ signame = strsignal (XFASTINT (code));
if (signame == 0)
string = build_string ("unknown");
else
@@ -604,20 +616,20 @@ status_message (struct Lisp_Process *p)
else if (EQ (symbol, Qexit))
{
if (NETCONN1_P (p))
- return build_string (code == 0 ? "deleted\n" : "connection broken by remote peer\n");
- if (code == 0)
+ return build_string (XFASTINT (code) == 0
+ ? "deleted\n"
+ : "connection broken by remote peer\n");
+ if (XFASTINT (code) == 0)
return build_string ("finished\n");
AUTO_STRING (prefix, "exited abnormally with code ");
- string = Fnumber_to_string (make_number (code));
+ string = Fnumber_to_string (code);
AUTO_STRING (suffix, coredump ? " (core dumped)\n" : "\n");
return concat3 (prefix, string, suffix);
}
else if (EQ (symbol, Qfailed))
{
- AUTO_STRING (prefix, "failed with code ");
- string = Fnumber_to_string (make_number (code));
- AUTO_STRING (suffix, "\n");
- return concat3 (prefix, string, suffix);
+ AUTO_STRING (format, "failed with code %s\n");
+ return CALLN (Fformat, format, code);
}
else
return Fcopy_sequence (Fsymbol_name (symbol));
@@ -703,12 +715,7 @@ allocate_process (void)
static Lisp_Object
make_process (Lisp_Object name)
{
- register Lisp_Object val, tem, name1;
- register struct Lisp_Process *p;
- char suffix[sizeof "<>" + INT_STRLEN_BOUND (printmax_t)];
- printmax_t i;
-
- p = allocate_process ();
+ struct Lisp_Process *p = allocate_process ();
/* Initialize Lisp data. Note that allocate_process initializes all
Lisp data to nil, so do it only for slots which should not be nil. */
pset_status (p, Qrun);
@@ -718,26 +725,33 @@ make_process (Lisp_Object name)
non-Lisp data, so do it only for slots which should not be zero. */
p->infd = -1;
p->outfd = -1;
- for (i = 0; i < PROCESS_OPEN_FDS; i++)
+ for (int i = 0; i < PROCESS_OPEN_FDS; i++)
p->open_fd[i] = -1;
#ifdef HAVE_GNUTLS
- p->gnutls_initstage = GNUTLS_STAGE_EMPTY;
+ verify (GNUTLS_STAGE_EMPTY == 0);
+ eassert (p->gnutls_initstage == GNUTLS_STAGE_EMPTY);
+ eassert (NILP (p->gnutls_boot_parameters));
#endif
/* If name is already in use, modify it until it is unused. */
- name1 = name;
- for (i = 1; ; i++)
+ Lisp_Object name1 = name;
+ for (printmax_t i = 1; ; i++)
{
- tem = Fget_process (name1);
- if (NILP (tem)) break;
- name1 = concat2 (name, make_formatted_string (suffix, "<%"pMd">", i));
+ Lisp_Object tem = Fget_process (name1);
+ if (NILP (tem))
+ break;
+ char const suffix_fmt[] = "<%"pMd">";
+ char suffix[sizeof suffix_fmt + INT_STRLEN_BOUND (printmax_t)];
+ AUTO_STRING_WITH_LEN (lsuffix, suffix, sprintf (suffix, suffix_fmt, i));
+ name1 = concat2 (name, lsuffix);
}
name = name1;
pset_name (p, name);
pset_sentinel (p, Qinternal_default_process_sentinel);
pset_filter (p, Qinternal_default_process_filter);
+ Lisp_Object val;
XSETPROCESS (val, p);
Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
return val;
@@ -754,6 +768,19 @@ remove_process (register Lisp_Object proc)
deactivate_process (proc);
}
+#ifdef HAVE_GETADDRINFO_A
+static void
+free_dns_request (Lisp_Object proc)
+{
+ struct Lisp_Process *p = XPROCESS (proc);
+
+ if (p->dns_request->ar_result)
+ freeaddrinfo (p->dns_request->ar_result);
+ xfree (p->dns_request);
+ p->dns_request = NULL;
+}
+#endif
+
DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
doc: /* Return t if OBJECT is a process. */)
@@ -844,6 +871,25 @@ nil, indicating the current buffer's process. */)
process = get_process (process);
p = XPROCESS (process);
+#ifdef HAVE_GETADDRINFO_A
+ if (p->dns_request)
+ {
+ /* Cancel the request. Unless shutting down, wait until
+ completion. Free the request if completely canceled. */
+
+ bool canceled = gai_cancel (p->dns_request) != EAI_NOTCANCELED;
+ if (!canceled && !inhibit_sentinels)
+ {
+ struct gaicb const *req = p->dns_request;
+ while (gai_suspend (&req, 1, NULL) != 0)
+ continue;
+ canceled = true;
+ }
+ if (canceled)
+ free_dns_request (process);
+ }
+#endif
+
p->raw_status_new = 0;
if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
{
@@ -1020,6 +1066,23 @@ DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
return XPROCESS (process)->mark;
}
+static void
+set_process_filter_masks (struct Lisp_Process *p)
+{
+ if (EQ (p->filter, Qt) && !EQ (p->status, Qlisten))
+ {
+ FD_CLR (p->infd, &input_wait_mask);
+ FD_CLR (p->infd, &non_keyboard_wait_mask);
+ }
+ else if (EQ (p->filter, Qt)
+ /* Network or serial process not stopped: */
+ && !EQ (p->command, Qt))
+ {
+ FD_SET (p->infd, &input_wait_mask);
+ FD_SET (p->infd, &non_keyboard_wait_mask);
+ }
+}
+
DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
2, 2, 0,
doc: /* Give PROCESS the filter function FILTER; nil means default.
@@ -1036,12 +1099,10 @@ The string argument is normally a multibyte string, except:
- if `default-enable-multibyte-characters' is nil, it is a unibyte
string (the result of converting the decoded input multibyte
string to unibyte with `string-make-unibyte'). */)
- (register Lisp_Object process, Lisp_Object filter)
+ (Lisp_Object process, Lisp_Object filter)
{
- struct Lisp_Process *p;
-
CHECK_PROCESS (process);
- p = XPROCESS (process);
+ struct Lisp_Process *p = XPROCESS (process);
/* Don't signal an error if the process's input file descriptor
is closed. This could make debugging Lisp more difficult,
@@ -1054,23 +1115,11 @@ The string argument is normally a multibyte string, except:
if (NILP (filter))
filter = Qinternal_default_process_filter;
+ pset_filter (p, filter);
+
if (p->infd >= 0)
- {
- if (EQ (filter, Qt) && !EQ (p->status, Qlisten))
- {
- FD_CLR (p->infd, &input_wait_mask);
- FD_CLR (p->infd, &non_keyboard_wait_mask);
- }
- else if (EQ (p->filter, Qt)
- /* Network or serial process not stopped: */
- && !EQ (p->command, Qt))
- {
- FD_SET (p->infd, &input_wait_mask);
- FD_SET (p->infd, &non_keyboard_wait_mask);
- }
- }
+ set_process_filter_masks (p);
- pset_filter (p, filter);
if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
pset_childp (p, Fplist_put (p->childp, QCfilter, filter));
setup_process_coding_systems (process);
@@ -1131,7 +1180,8 @@ nil otherwise. */)
CHECK_RANGED_INTEGER (height, 0, USHRT_MAX);
CHECK_RANGED_INTEGER (width, 0, USHRT_MAX);
- if (XPROCESS (process)->infd < 0
+ if (NETCONN_P (process)
+ || XPROCESS (process)->infd < 0
|| (set_window_size (XPROCESS (process)->infd,
XINT (height), XINT (width))
< 0))
@@ -1199,8 +1249,10 @@ optional KEY arg. If KEY is nil, value is a cons cell of the form
connection; it is t for a pipe connection. If KEY is t, the complete
contact information for the connection is returned, else the specific
value for the keyword KEY is returned. See `make-network-process',
-\`make-serial-process', or `make-pipe-process' for the list of keywords. */)
- (register Lisp_Object process, Lisp_Object key)
+`make-serial-process', or `make pipe-process' for the list of keywords.
+If PROCESS is a non-blocking network process that hasn't been fully
+set up yet, this function will block until socket setup has completed. */)
+ (Lisp_Object process, Lisp_Object key)
{
Lisp_Object contact;
@@ -1208,6 +1260,10 @@ value for the keyword KEY is returned. See `make-network-process',
contact = XPROCESS (process)->childp;
#ifdef DATAGRAM_SOCKETS
+
+ if (NETCONN_P (process))
+ wait_for_socket_fds (process, "process-contact");
+
if (DATAGRAM_CONN_P (process)
&& (EQ (key, Qt) || EQ (key, QCremote)))
contact = Fplist_put (contact, QCremote,
@@ -1242,8 +1298,8 @@ DEFUN ("process-plist", Fprocess_plist, Sprocess_plist,
DEFUN ("set-process-plist", Fset_process_plist, Sset_process_plist,
2, 2, 0,
- doc: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
- (register Lisp_Object process, Lisp_Object plist)
+ doc: /* Replace the plist of PROCESS with PLIST. Return PLIST. */)
+ (Lisp_Object process, Lisp_Object plist)
{
CHECK_PROCESS (process);
CHECK_LIST (plist);
@@ -1283,7 +1339,7 @@ A 4 or 5 element vector represents an IPv4 address (with port number).
An 8 or 9 element vector represents an IPv6 address (with port number).
If optional second argument OMIT-PORT is non-nil, don't include a port
number in the string, even when present in ADDRESS.
-Returns nil if format of ADDRESS is invalid. */)
+Return nil if format of ADDRESS is invalid. */)
(Lisp_Object address, Lisp_Object omit_port)
{
if (NILP (address))
@@ -1360,8 +1416,6 @@ DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
/* Starting asynchronous inferior processes. */
-static void start_process_unwind (Lisp_Object proc);
-
DEFUN ("make-process", Fmake_process, Smake_process, 0, MANY, 0,
doc: /* Start a program in a subprocess. Return the process object for it.
@@ -1412,7 +1466,6 @@ 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 ();
- USE_SAFE_ALLOCA;
if (nargs == 0)
return Qnil;
@@ -1461,14 +1514,10 @@ usage: (make-process &rest ARGS) */)
}
proc = make_process (name);
- /* If an error occurs and we can't start the process, we want to
- remove it from the process list. This means that each error
- check in create_process doesn't need to call remove_process
- itself; it's all taken care of here. */
record_unwind_protect (start_process_unwind, proc);
pset_childp (XPROCESS (proc), Qt);
- pset_plist (XPROCESS (proc), Qnil);
+ eassert (NILP (XPROCESS (proc)->plist));
pset_type (XPROCESS (proc), Qreal);
pset_buffer (XPROCESS (proc), buffer);
pset_sentinel (XPROCESS (proc), Fplist_get (contact, QCsentinel));
@@ -1499,8 +1548,9 @@ usage: (make-process &rest ARGS) */)
#ifdef HAVE_GNUTLS
/* AKA GNUTLS_INITSTAGE(proc). */
- XPROCESS (proc)->gnutls_initstage = GNUTLS_STAGE_EMPTY;
- pset_gnutls_cred_type (XPROCESS (proc), Qnil);
+ verify (GNUTLS_STAGE_EMPTY == 0);
+ eassert (XPROCESS (proc)->gnutls_initstage == GNUTLS_STAGE_EMPTY);
+ eassert (NILP (XPROCESS (proc)->gnutls_cred_type));
#endif
XPROCESS (proc)->adaptive_read_buffering
@@ -1513,6 +1563,8 @@ usage: (make-process &rest ARGS) */)
BUF_ZV (XBUFFER (buffer)),
BUF_ZV_BYTE (XBUFFER (buffer)));
+ USE_SAFE_ALLOCA;
+
{
/* Decide coding systems for communicating with the process. Here
we don't setup the structure coding_system nor pay attention to
@@ -1590,7 +1642,7 @@ usage: (make-process &rest ARGS) */)
pset_decoding_buf (XPROCESS (proc), empty_unibyte_string);
- XPROCESS (proc)->decoding_carryover = 0;
+ eassert (XPROCESS (proc)->decoding_carryover == 0);
pset_encoding_buf (XPROCESS (proc), empty_unibyte_string);
XPROCESS (proc)->inherit_coding_system_flag
@@ -1671,18 +1723,11 @@ usage: (make-process &rest ARGS) */)
return unbind_to (count, proc);
}
-/* This function is the unwind_protect form for Fstart_process. If
- PROC doesn't have its pid set, then we know someone has signaled
- an error and the process wasn't started successfully, so we should
- remove it from the process list. */
+/* If PROC doesn't have its pid set, then an error was signaled and
+ the process wasn't started successfully, so remove it. */
static void
start_process_unwind (Lisp_Object proc)
{
- if (!PROCESSP (proc))
- emacs_abort ();
-
- /* Was PROC started successfully?
- -2 is used for a pty with no process, eg for gdb. */
if (XPROCESS (proc)->pid <= 0 && XPROCESS (proc)->pid != -2)
remove_process (proc);
}
@@ -1879,7 +1924,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
{
/* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
I can't test it since I don't have 4.3. */
- int j = emacs_open ("/dev/tty", O_RDWR, 0);
+ int j = emacs_open (DEV_TTY, O_RDWR, 0);
if (j >= 0)
{
ioctl (j, TIOCNOTTY, 0);
@@ -2140,7 +2185,7 @@ usage: (make-pipe-process &rest ARGS) */)
pset_type (p, Qpipe);
pset_sentinel (p, Fplist_get (contact, QCsentinel));
pset_filter (p, Fplist_get (contact, QCfilter));
- pset_log (p, Qnil);
+ eassert (NILP (p->log));
if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
p->kill_without_query = 1;
if (tem = Fplist_get (contact, QCstop), !NILP (tem))
@@ -2231,12 +2276,12 @@ usage: (make-pipe-process &rest ARGS) */)
The address family of sa is not included in the result. */
Lisp_Object
-conv_sockaddr_to_lisp (struct sockaddr *sa, int len)
+conv_sockaddr_to_lisp (struct sockaddr *sa, ptrdiff_t len)
{
Lisp_Object address;
- int i;
+ ptrdiff_t i;
unsigned char *cp;
- register struct Lisp_Vector *p;
+ struct Lisp_Vector *p;
/* Workaround for a bug in getsockname on BSD: Names bound to
sockets in the UNIX domain are inaccessible; getsockname returns
@@ -2308,13 +2353,23 @@ conv_sockaddr_to_lisp (struct sockaddr *sa, int len)
return address;
}
+/* Convert an internal struct addrinfo to a Lisp object. */
+
+static Lisp_Object
+conv_addrinfo_to_lisp (struct addrinfo *res)
+{
+ Lisp_Object protocol = make_number (res->ai_protocol);
+ eassert (XINT (protocol) == res->ai_protocol);
+ return Fcons (protocol, conv_sockaddr_to_lisp (res->ai_addr, res->ai_addrlen));
+}
+
/* Get family and required size for sockaddr structure to hold ADDRESS. */
-static int
+static ptrdiff_t
get_lisp_to_sockaddr_size (Lisp_Object address, int *familyp)
{
- register struct Lisp_Vector *p;
+ struct Lisp_Vector *p;
if (VECTORP (address))
{
@@ -2430,13 +2485,18 @@ conv_lisp_to_sockaddr (int family, Lisp_Object address, struct sockaddr *sa, int
#ifdef DATAGRAM_SOCKETS
DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address,
1, 1, 0,
- doc: /* Get the current datagram address associated with PROCESS. */)
+ doc: /* Get the current datagram address associated with PROCESS.
+If PROCESS is a non-blocking network process that hasn't been fully
+set up yet, this function will block until socket setup has completed. */)
(Lisp_Object process)
{
int channel;
CHECK_PROCESS (process);
+ if (NETCONN_P (process))
+ wait_for_socket_fds (process, "process-datagram-address");
+
if (!DATAGRAM_CONN_P (process))
return Qnil;
@@ -2448,14 +2508,21 @@ DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_
DEFUN ("set-process-datagram-address", Fset_process_datagram_address, Sset_process_datagram_address,
2, 2, 0,
doc: /* Set the datagram address for PROCESS to ADDRESS.
-Returns nil upon error setting address, ADDRESS otherwise. */)
+Return nil upon error setting address, ADDRESS otherwise.
+
+If PROCESS is a non-blocking network process that hasn't been fully
+set up yet, this function will block until socket setup has completed. */)
(Lisp_Object process, Lisp_Object address)
{
int channel;
- int family, len;
+ int family;
+ ptrdiff_t len;
CHECK_PROCESS (process);
+ if (NETCONN_P (process))
+ wait_for_socket_fds (process, "set-process-datagram-address");
+
if (!DATAGRAM_CONN_P (process))
return Qnil;
@@ -2511,7 +2578,7 @@ static const struct socket_options {
/* Set option OPT to value VAL on socket S.
- Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
+ Return (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
Signals an error if setting a known option fails.
*/
@@ -2613,7 +2680,10 @@ DEFUN ("set-network-process-option",
doc: /* For network process PROCESS set option OPTION to value VALUE.
See `make-network-process' for a list of options and values.
If optional fourth arg NO-ERROR is non-nil, don't signal an error if
-OPTION is not a supported option, return nil instead; otherwise return t. */)
+OPTION is not a supported option, return nil instead; otherwise return t.
+
+If PROCESS is a non-blocking network process that hasn't been fully
+set up yet, this function will block until socket setup has completed. */)
(Lisp_Object process, Lisp_Object option, Lisp_Object value, Lisp_Object no_error)
{
int s;
@@ -2624,6 +2694,8 @@ OPTION is not a supported option, return nil instead; otherwise return t. */)
if (!NETCONN1_P (p))
error ("Process is not a network process");
+ wait_for_socket_fds (process, "set-network-process-option");
+
s = p->infd;
if (s < 0)
error ("Process is not running");
@@ -2852,7 +2924,7 @@ usage: (make-serial-process &rest ARGS) */)
pset_type (p, Qserial);
pset_sentinel (p, Fplist_get (contact, QCsentinel));
pset_filter (p, Fplist_get (contact, QCfilter));
- pset_log (p, Qnil);
+ eassert (NILP (p->log));
if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
p->kill_without_query = 1;
if (tem = Fplist_get (contact, QCstop), !NILP (tem))
@@ -2906,7 +2978,7 @@ usage: (make-serial-process &rest ARGS) */)
setup_process_coding_systems (proc);
pset_decoding_buf (p, empty_unibyte_string);
- p->decoding_carryover = 0;
+ eassert (p->decoding_carryover == 0);
pset_encoding_buf (p, empty_unibyte_string);
p->inherit_coding_system_flag
= !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
@@ -2918,6 +2990,484 @@ usage: (make-serial-process &rest ARGS) */)
return proc;
}
+static void
+set_network_socket_coding_system (Lisp_Object proc, Lisp_Object host,
+ Lisp_Object service, Lisp_Object name)
+{
+ Lisp_Object tem;
+ struct Lisp_Process *p = XPROCESS (proc);
+ Lisp_Object contact = p->childp;
+ Lisp_Object coding_systems = Qt;
+ Lisp_Object val;
+
+ tem = Fplist_member (contact, QCcoding);
+ if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
+ tem = Qnil; /* No error message (too late!). */
+
+ /* Setup coding systems for communicating with the network stream. */
+ /* Qt denotes we have not yet called Ffind_operation_coding_system. */
+
+ if (!NILP (tem))
+ {
+ val = XCAR (XCDR (tem));
+ if (CONSP (val))
+ val = XCAR (val);
+ }
+ else if (!NILP (Vcoding_system_for_read))
+ val = Vcoding_system_for_read;
+ else if ((!NILP (p->buffer)
+ && NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters)))
+ || (NILP (p->buffer)
+ && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
+ /* We dare not decode end-of-line format by setting VAL to
+ Qraw_text, because the existing Emacs Lisp libraries
+ assume that they receive bare code including a sequence of
+ CR LF. */
+ val = Qnil;
+ else
+ {
+ if (NILP (host) || NILP (service))
+ coding_systems = Qnil;
+ else
+ coding_systems = CALLN (Ffind_operation_coding_system,
+ Qopen_network_stream, name, p->buffer,
+ host, service);
+ if (CONSP (coding_systems))
+ val = XCAR (coding_systems);
+ else if (CONSP (Vdefault_process_coding_system))
+ val = XCAR (Vdefault_process_coding_system);
+ else
+ val = Qnil;
+ }
+ pset_decode_coding_system (p, val);
+
+ if (!NILP (tem))
+ {
+ val = XCAR (XCDR (tem));
+ if (CONSP (val))
+ val = XCDR (val);
+ }
+ else if (!NILP (Vcoding_system_for_write))
+ val = Vcoding_system_for_write;
+ else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
+ val = Qnil;
+ else
+ {
+ if (EQ (coding_systems, Qt))
+ {
+ if (NILP (host) || NILP (service))
+ coding_systems = Qnil;
+ else
+ coding_systems = CALLN (Ffind_operation_coding_system,
+ Qopen_network_stream, name, p->buffer,
+ host, service);
+ }
+ if (CONSP (coding_systems))
+ val = XCDR (coding_systems);
+ else if (CONSP (Vdefault_process_coding_system))
+ val = XCDR (Vdefault_process_coding_system);
+ else
+ val = Qnil;
+ }
+ pset_encode_coding_system (p, val);
+
+ pset_decoding_buf (p, empty_unibyte_string);
+ p->decoding_carryover = 0;
+ pset_encoding_buf (p, empty_unibyte_string);
+
+ p->inherit_coding_system_flag
+ = !(!NILP (tem) || NILP (p->buffer) || !inherit_process_coding_system);
+}
+
+#ifdef HAVE_GNUTLS
+static void
+finish_after_tls_connection (Lisp_Object proc)
+{
+ struct Lisp_Process *p = XPROCESS (proc);
+ Lisp_Object contact = p->childp;
+ Lisp_Object result = Qt;
+
+ if (!NILP (Ffboundp (Qnsm_verify_connection)))
+ result = call3 (Qnsm_verify_connection,
+ proc,
+ Fplist_get (contact, QChost),
+ Fplist_get (contact, QCservice));
+
+ if (NILP (result))
+ {
+ pset_status (p, list2 (Qfailed,
+ build_string ("The Network Security Manager stopped the connections")));
+ deactivate_process (proc);
+ }
+ else if (p->outfd < 0)
+ {
+ /* The counterparty may have closed the connection (especially
+ if the NSM promt above take a long time), so recheck the file
+ descriptor here. */
+ pset_status (p, Qfailed);
+ deactivate_process (proc);
+ }
+ else if (! FD_ISSET (p->outfd, &connect_wait_mask))
+ {
+ /* If we cleared the connection wait mask before we did the TLS
+ setup, then we have to say that the process is finally "open"
+ here. */
+ pset_status (p, Qrun);
+ /* Execute the sentinel here. If we had relied on status_notify
+ to do it later, it will read input from the process before
+ calling the sentinel. */
+ exec_sentinel (proc, build_string ("open\n"));
+ }
+}
+#endif
+
+static void
+connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
+ Lisp_Object use_external_socket_p)
+{
+ ptrdiff_t count = SPECPDL_INDEX ();
+ int s = -1, outch, inch;
+ int xerrno = 0;
+ int family;
+ struct sockaddr *sa = NULL;
+ int ret;
+ ptrdiff_t addrlen;
+ struct Lisp_Process *p = XPROCESS (proc);
+ Lisp_Object contact = p->childp;
+ int optbits = 0;
+ int socket_to_use = -1;
+
+ if (!NILP (use_external_socket_p))
+ {
+ socket_to_use = external_sock_fd;
+
+ /* Ensure we don't consume the external socket twice. */
+ external_sock_fd = -1;
+ }
+
+ /* Do this in case we never enter the while-loop below. */
+ s = -1;
+
+ while (!NILP (addrinfos))
+ {
+ Lisp_Object addrinfo = XCAR (addrinfos);
+ addrinfos = XCDR (addrinfos);
+ int protocol = XINT (XCAR (addrinfo));
+ Lisp_Object ip_address = XCDR (addrinfo);
+
+#ifdef WINDOWSNT
+ retry_connect:
+#endif
+
+ addrlen = get_lisp_to_sockaddr_size (ip_address, &family);
+ if (sa)
+ free (sa);
+ sa = xmalloc (addrlen);
+ conv_lisp_to_sockaddr (family, ip_address, sa, addrlen);
+
+ s = socket_to_use;
+ if (s < 0)
+ {
+ int socktype = p->socktype | SOCK_CLOEXEC;
+ if (p->is_non_blocking_client)
+ socktype |= SOCK_NONBLOCK;
+ s = socket (family, socktype, protocol);
+ if (s < 0)
+ {
+ xerrno = errno;
+ continue;
+ }
+ }
+
+ if (p->is_non_blocking_client && ! (SOCK_NONBLOCK && socket_to_use < 0))
+ {
+ ret = fcntl (s, F_SETFL, O_NONBLOCK);
+ if (ret < 0)
+ {
+ xerrno = errno;
+ emacs_close (s);
+ s = -1;
+ if (0 <= socket_to_use)
+ break;
+ continue;
+ }
+ }
+
+#ifdef DATAGRAM_SOCKETS
+ if (!p->is_server && p->socktype == SOCK_DGRAM)
+ break;
+#endif /* DATAGRAM_SOCKETS */
+
+ /* Make us close S if quit. */
+ record_unwind_protect_int (close_file_unwind, s);
+
+ /* Parse network options in the arg list. We simply ignore anything
+ which isn't a known option (including other keywords). An error
+ is signaled if setting a known option fails. */
+ {
+ Lisp_Object params = contact, key, val;
+
+ while (!NILP (params))
+ {
+ key = XCAR (params);
+ params = XCDR (params);
+ val = XCAR (params);
+ params = XCDR (params);
+ optbits |= set_socket_option (s, key, val);
+ }
+ }
+
+ if (p->is_server)
+ {
+ /* Configure as a server socket. */
+
+ /* SO_REUSEADDR = 1 is default for server sockets; must specify
+ explicit :reuseaddr key to override this. */
+#ifdef HAVE_LOCAL_SOCKETS
+ if (family != AF_LOCAL)
+#endif
+ if (!(optbits & (1 << OPIX_REUSEADDR)))
+ {
+ int optval = 1;
+ if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
+ report_file_error ("Cannot set reuse option on server socket", Qnil);
+ }
+
+ /* If passed a socket descriptor, it should be already bound. */
+ if (socket_to_use < 0 && bind (s, sa, addrlen) != 0)
+ report_file_error ("Cannot bind server socket", Qnil);
+
+#ifdef HAVE_GETSOCKNAME
+ if (p->port == 0)
+ {
+ struct sockaddr_in sa1;
+ socklen_t len1 = sizeof (sa1);
+ if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
+ {
+ Lisp_Object service;
+ service = make_number (ntohs (sa1.sin_port));
+ contact = Fplist_put (contact, QCservice, service);
+ /* Save the port number so that we can stash it in
+ the process object later. */
+ ((struct sockaddr_in *)sa)->sin_port = sa1.sin_port;
+ }
+ }
+#endif
+
+ if (p->socktype != SOCK_DGRAM && listen (s, p->backlog))
+ report_file_error ("Cannot listen on server socket", Qnil);
+
+ break;
+ }
+
+ immediate_quit = 1;
+ QUIT;
+
+ ret = connect (s, sa, addrlen);
+ xerrno = errno;
+
+ if (ret == 0 || xerrno == EISCONN)
+ {
+ /* The unwind-protect will be discarded afterwards.
+ Likewise for immediate_quit. */
+ break;
+ }
+
+ if (p->is_non_blocking_client && xerrno == EINPROGRESS)
+ break;
+
+#ifndef WINDOWSNT
+ if (xerrno == EINTR)
+ {
+ /* Unlike most other syscalls connect() cannot be called
+ again. (That would return EALREADY.) The proper way to
+ wait for completion is pselect(). */
+ int sc;
+ socklen_t len;
+ fd_set fdset;
+ retry_select:
+ FD_ZERO (&fdset);
+ FD_SET (s, &fdset);
+ QUIT;
+ sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL);
+ if (sc == -1)
+ {
+ if (errno == EINTR)
+ goto retry_select;
+ else
+ report_file_error ("Failed select", Qnil);
+ }
+ eassert (sc > 0);
+
+ len = sizeof xerrno;
+ eassert (FD_ISSET (s, &fdset));
+ if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) < 0)
+ report_file_error ("Failed getsockopt", Qnil);
+ if (xerrno == 0)
+ break;
+ if (NILP (addrinfos))
+ report_file_errno ("Failed connect", Qnil, xerrno);
+ }
+#endif /* !WINDOWSNT */
+
+ immediate_quit = 0;
+
+ /* Discard the unwind protect closing S. */
+ specpdl_ptr = specpdl + count;
+ emacs_close (s);
+ s = -1;
+ if (0 <= socket_to_use)
+ break;
+
+#ifdef WINDOWSNT
+ if (xerrno == EINTR)
+ goto retry_connect;
+#endif
+ }
+
+ if (s >= 0)
+ {
+#ifdef DATAGRAM_SOCKETS
+ if (p->socktype == SOCK_DGRAM)
+ {
+ if (datagram_address[s].sa)
+ emacs_abort ();
+
+ datagram_address[s].sa = xmalloc (addrlen);
+ datagram_address[s].len = addrlen;
+ if (p->is_server)
+ {
+ Lisp_Object remote;
+ memset (datagram_address[s].sa, 0, addrlen);
+ if (remote = Fplist_get (contact, QCremote), !NILP (remote))
+ {
+ int rfamily;
+ ptrdiff_t rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
+ if (rlen != 0 && rfamily == family
+ && rlen == addrlen)
+ conv_lisp_to_sockaddr (rfamily, remote,
+ datagram_address[s].sa, rlen);
+ }
+ }
+ else
+ memcpy (datagram_address[s].sa, sa, addrlen);
+ }
+#endif
+
+ contact = Fplist_put (contact, p->is_server? QClocal: QCremote,
+ conv_sockaddr_to_lisp (sa, addrlen));
+#ifdef HAVE_GETSOCKNAME
+ if (!p->is_server)
+ {
+ struct sockaddr_in sa1;
+ socklen_t len1 = sizeof (sa1);
+ if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
+ contact = Fplist_put (contact, QClocal,
+ conv_sockaddr_to_lisp ((struct sockaddr *)&sa1, len1));
+ }
+#endif
+ }
+
+ immediate_quit = 0;
+
+ if (s < 0)
+ {
+ /* If non-blocking got this far - and failed - assume non-blocking is
+ not supported after all. This is probably a wrong assumption, but
+ the normal blocking calls to open-network-stream handles this error
+ better. */
+ if (p->is_non_blocking_client)
+ return;
+
+ report_file_errno ((p->is_server
+ ? "make server process failed"
+ : "make client process failed"),
+ contact, xerrno);
+ }
+
+ inch = s;
+ outch = s;
+
+ chan_process[inch] = proc;
+
+ fcntl (inch, F_SETFL, O_NONBLOCK);
+
+ p = XPROCESS (proc);
+ p->open_fd[SUBPROCESS_STDIN] = inch;
+ p->infd = inch;
+ p->outfd = outch;
+
+ /* Discard the unwind protect for closing S, if any. */
+ specpdl_ptr = specpdl + count;
+
+ if (p->is_server && p->socktype != SOCK_DGRAM)
+ pset_status (p, Qlisten);
+
+ /* Make the process marker point into the process buffer (if any). */
+ if (BUFFERP (p->buffer))
+ set_marker_both (p->mark, p->buffer,
+ BUF_ZV (XBUFFER (p->buffer)),
+ BUF_ZV_BYTE (XBUFFER (p->buffer)));
+
+ if (p->is_non_blocking_client)
+ {
+ /* We may get here if connect did succeed immediately. However,
+ in that case, we still need to signal this like a non-blocking
+ connection. */
+ if (! (connecting_status (p->status)
+ && EQ (XCDR (p->status), addrinfos)))
+ pset_status (p, Fcons (Qconnect, addrinfos));
+ if (!FD_ISSET (inch, &connect_wait_mask))
+ {
+ FD_SET (inch, &connect_wait_mask);
+ FD_SET (inch, &write_mask);
+ num_pending_connects++;
+ }
+ }
+ else
+ /* A server may have a client filter setting of Qt, but it must
+ still listen for incoming connects unless it is stopped. */
+ if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt))
+ || (EQ (p->status, Qlisten) && NILP (p->command)))
+ {
+ FD_SET (inch, &input_wait_mask);
+ FD_SET (inch, &non_keyboard_wait_mask);
+ }
+
+ if (inch > max_process_desc)
+ max_process_desc = inch;
+
+ /* Set up the masks based on the process filter. */
+ set_process_filter_masks (p);
+
+ setup_process_coding_systems (proc);
+
+#ifdef HAVE_GNUTLS
+ /* Continue the asynchronous connection. */
+ if (!NILP (p->gnutls_boot_parameters))
+ {
+ Lisp_Object boot, params = p->gnutls_boot_parameters;
+
+ boot = Fgnutls_boot (proc, XCAR (params), XCDR (params));
+ p->gnutls_boot_parameters = Qnil;
+
+ if (p->gnutls_initstage == GNUTLS_STAGE_READY)
+ /* Run sentinels, etc. */
+ finish_after_tls_connection (proc);
+ else if (p->gnutls_initstage != GNUTLS_STAGE_HANDSHAKE_TRIED)
+ {
+ deactivate_process (proc);
+ if (NILP (boot))
+ pset_status (p, list2 (Qfailed,
+ build_string ("TLS negotiation failed")));
+ else
+ pset_status (p, list2 (Qfailed, boot));
+ }
+ }
+#endif
+
+}
+
/* Create a network stream/datagram client/server process. Treated
exactly like a normal process when reading and writing. Primary
differences are in status display and process deletion. A network
@@ -2953,9 +3503,8 @@ host, and only clients connecting to that address will be accepted.
:service SERVICE -- SERVICE is name of the service desired, or an
integer specifying a port number to connect to. If SERVICE is t,
-a random port number is selected for the server. (If Emacs was
-compiled with getaddrinfo, a port number can also be specified as a
-string, e.g. "80", as well as an integer. This is not portable.)
+a random port number is selected for the server. A port number can
+be specified as an integer string, e.g., "80", as well as an integer.
:type TYPE -- TYPE is the type of connection. The default (nil) is a
stream type connection, `datagram' creates a datagram type connection,
@@ -2996,11 +3545,12 @@ system used for both reading and writing for this process. If CODING
is a cons (DECODING . ENCODING), DECODING is used for reading, and
ENCODING is used for writing.
-:nowait BOOL -- If BOOL is non-nil for a stream type client process,
-return without waiting for the connection to complete; instead, the
-sentinel function will be called with second arg matching "open" (if
-successful) or "failed" when the connect completes. Default is to use
-a blocking connect (i.e. wait) for stream type connections.
+:nowait BOOL -- If NOWAIT is non-nil for a stream type client
+process, return without waiting for the connection to complete;
+instead, the sentinel function will be called with second arg matching
+"open" (if successful) or "failed" when the connect completes.
+Default is to use a blocking connect (i.e. wait) for stream type
+connections.
:noquery BOOL -- Query the user unless BOOL is non-nil, and process is
running when Emacs is exited.
@@ -3028,6 +3578,12 @@ and MESSAGE is a string.
:plist PLIST -- Install PLIST as the new process's initial plist.
+:tls-parameters LIST -- is a list that should be supplied if you're
+opening a TLS connection. The first element is the TLS type (either
+`gnutls-x509pki' or `gnutls-anon'), and the remaining elements should
+be a keyword list accepted by gnutls-boot (as returned by
+`gnutls-boot-parameters').
+
:server QLEN -- if QLEN is non-nil, create a server process for the
specified FAMILY, SERVICE, and connection type (stream or datagram).
If QLEN is an integer, it is used as the max. length of the server's
@@ -3046,6 +3602,11 @@ The following network options can be specified for this connection:
(this is allowed by default for a server process).
:bindtodevice NAME -- bind to interface NAME. Using this may require
special privileges on some systems.
+:use-external-socket BOOL -- Use any pre-allocated sockets that have
+ been passed to Emacs. If Emacs wasn't
+ passed a socket, this option is silently
+ ignored.
+
Consult the relevant system programmer's manual pages for more
information on using these options.
@@ -3081,41 +3642,24 @@ usage: (make-network-process &rest ARGS) */)
Lisp_Object proc;
Lisp_Object contact;
struct Lisp_Process *p;
-#ifdef HAVE_GETADDRINFO
- struct addrinfo ai, *res, *lres;
- struct addrinfo hints;
const char *portstring;
- char portbuf[128];
-#else /* HAVE_GETADDRINFO */
- struct _emacs_addrinfo
- {
- int ai_family;
- int ai_socktype;
- int ai_protocol;
- int ai_addrlen;
- struct sockaddr *ai_addr;
- struct _emacs_addrinfo *ai_next;
- } ai, *res, *lres;
-#endif /* HAVE_GETADDRINFO */
- struct sockaddr_in address_in;
+ ptrdiff_t portstringlen ATTRIBUTE_UNUSED;
+ char portbuf[INT_BUFSIZE_BOUND (EMACS_INT)];
#ifdef HAVE_LOCAL_SOCKETS
struct sockaddr_un address_un;
#endif
- int port;
- int ret = 0;
- int xerrno = 0;
- int s = -1, outch, inch;
- ptrdiff_t count = SPECPDL_INDEX ();
- ptrdiff_t count1;
- Lisp_Object colon_address; /* Either QClocal or QCremote. */
+ EMACS_INT port = 0;
Lisp_Object tem;
Lisp_Object name, buffer, host, service, address;
- Lisp_Object filter, sentinel;
- bool is_non_blocking_client = 0;
- bool is_server = 0;
- int backlog = 5;
+ Lisp_Object filter, sentinel, use_external_socket_p;
+ Lisp_Object addrinfos = Qnil;
int socktype;
int family = -1;
+ enum { any_protocol = 0 };
+#ifdef HAVE_GETADDRINFO_A
+ struct gaicb *dns_request = NULL;
+#endif
+ ptrdiff_t count = SPECPDL_INDEX ();
if (nargs == 0)
return Qnil;
@@ -3143,55 +3687,28 @@ usage: (make-network-process &rest ARGS) */)
else
error ("Unsupported connection type");
- /* :server BOOL */
- tem = Fplist_get (contact, QCserver);
- if (!NILP (tem))
- {
- /* Don't support network sockets when non-blocking mode is
- not available, since a blocked Emacs is not useful. */
- is_server = 1;
- if (TYPE_RANGED_INTEGERP (int, tem))
- backlog = XINT (tem);
- }
-
- /* Make colon_address an alias for :local (server) or :remote (client). */
- colon_address = is_server ? QClocal : QCremote;
-
- /* :nowait BOOL */
- if (!is_server && socktype != SOCK_DGRAM
- && (tem = Fplist_get (contact, QCnowait), !NILP (tem)))
- {
-#ifndef NON_BLOCKING_CONNECT
- error ("Non-blocking connect not supported");
-#else
- is_non_blocking_client = 1;
-#endif
- }
-
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);
CHECK_STRING (name);
- /* Initialize addrinfo structure in case we don't use getaddrinfo. */
- ai.ai_socktype = socktype;
- ai.ai_protocol = 0;
- ai.ai_next = NULL;
- res = &ai;
-
/* :local ADDRESS or :remote ADDRESS */
- address = Fplist_get (contact, colon_address);
+ tem = Fplist_get (contact, QCserver);
+ if (NILP (tem))
+ address = Fplist_get (contact, QCremote);
+ else
+ address = Fplist_get (contact, QClocal);
if (!NILP (address))
{
host = service = Qnil;
- if (!(ai.ai_addrlen = get_lisp_to_sockaddr_size (address, &family)))
+ if (!get_lisp_to_sockaddr_size (address, &family))
error ("Malformed :address");
- ai.ai_family = family;
- ai.ai_addr = alloca (ai.ai_addrlen);
- conv_lisp_to_sockaddr (family, address, ai.ai_addr, ai.ai_addrlen);
+
+ addrinfos = list1 (Fcons (make_number (any_protocol), address));
goto open_socket;
}
@@ -3199,7 +3716,7 @@ usage: (make-network-process &rest ARGS) */)
tem = Fplist_get (contact, QCfamily);
if (NILP (tem))
{
-#if defined (HAVE_GETADDRINFO) && defined (AF_INET6)
+#ifdef AF_INET6
family = AF_UNSPEC;
#else
family = AF_INET;
@@ -3220,14 +3737,21 @@ usage: (make-network-process &rest ARGS) */)
else
error ("Unknown address family");
- ai.ai_family = family;
-
/* :service SERVICE -- string, integer (port number), or t (random port). */
service = Fplist_get (contact, QCservice);
/* :host HOST -- hostname, ip address, or 'local for localhost. */
host = Fplist_get (contact, QChost);
- if (!NILP (host))
+ if (NILP (host))
+ {
+ /* The "connection" function gets it bind info from the address we're
+ given, so use this dummy address if nothing is specified. */
+#ifdef HAVE_LOCAL_SOCKETS
+ if (family != AF_LOCAL)
+#endif
+ host = build_string ("127.0.0.1");
+ }
+ else
{
if (EQ (host, Qlocal))
/* Depending on setup, "localhost" may map to different IPv4 and/or
@@ -3246,13 +3770,9 @@ usage: (make-network-process &rest ARGS) */)
host = Qnil;
}
CHECK_STRING (service);
- memset (&address_un, 0, sizeof address_un);
- address_un.sun_family = AF_LOCAL;
if (sizeof address_un.sun_path <= SBYTES (service))
error ("Service name too long");
- lispstpcpy (address_un.sun_path, service);
- ai.ai_addr = (struct sockaddr *) &address_un;
- ai.ai_addrlen = sizeof address_un;
+ addrinfos = list1 (Fcons (make_number (any_protocol), service));
goto open_socket;
}
#endif
@@ -3268,359 +3788,147 @@ usage: (make-network-process &rest ARGS) */)
}
#endif
-#ifdef HAVE_GETADDRINFO
- /* If we have a host, use getaddrinfo to resolve both host and service.
- Otherwise, use getservbyname to lookup the service. */
if (!NILP (host))
{
-
/* SERVICE can either be a string or int.
Convert to a C string for later use by getaddrinfo. */
if (EQ (service, Qt))
- portstring = "0";
+ {
+ portstring = "0";
+ portstringlen = 1;
+ }
else if (INTEGERP (service))
{
- sprintf (portbuf, "%"pI"d", XINT (service));
portstring = portbuf;
+ portstringlen = sprintf (portbuf, "%"pI"d", XINT (service));
}
else
{
CHECK_STRING (service);
portstring = SSDATA (service);
+ portstringlen = SBYTES (service);
}
+ }
- immediate_quit = 1;
- QUIT;
- memset (&hints, 0, sizeof (hints));
- hints.ai_flags = 0;
- hints.ai_family = family;
- hints.ai_socktype = socktype;
- hints.ai_protocol = 0;
-
-#ifdef HAVE_RES_INIT
- res_init ();
-#endif
-
- ret = getaddrinfo (SSDATA (host), portstring, &hints, &res);
+#ifdef HAVE_GETADDRINFO_A
+ if (!NILP (host) && !NILP (Fplist_get (contact, QCnowait)))
+ {
+ ptrdiff_t hostlen = SBYTES (host);
+ struct req
+ {
+ struct gaicb gaicb;
+ struct addrinfo hints;
+ char str[FLEXIBLE_ARRAY_MEMBER];
+ } *req = xmalloc (FLEXSIZEOF (struct req, str,
+ hostlen + 1 + portstringlen + 1));
+ dns_request = &req->gaicb;
+ dns_request->ar_name = req->str;
+ dns_request->ar_service = req->str + hostlen + 1;
+ dns_request->ar_request = &req->hints;
+ dns_request->ar_result = NULL;
+ memset (&req->hints, 0, sizeof req->hints);
+ req->hints.ai_family = family;
+ req->hints.ai_socktype = socktype;
+ strcpy (req->str, SSDATA (host));
+ strcpy (req->str + hostlen + 1, portstring);
+
+ int ret = getaddrinfo_a (GAI_NOWAIT, &dns_request, 1, NULL);
if (ret)
-#ifdef HAVE_GAI_STRERROR
- error ("%s/%s %s", SSDATA (host), portstring, gai_strerror (ret));
-#else
- error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
-#endif
- immediate_quit = 0;
+ error ("%s/%s getaddrinfo_a error %d", SSDATA (host), portstring, ret);
goto open_socket;
}
-#endif /* HAVE_GETADDRINFO */
-
- /* We end up here if getaddrinfo is not defined, or in case no hostname
- has been specified (e.g. for a local server process). */
-
- if (EQ (service, Qt))
- port = 0;
- else if (INTEGERP (service))
- port = htons ((unsigned short) XINT (service));
- else
- {
- struct servent *svc_info;
- CHECK_STRING (service);
- svc_info = getservbyname (SSDATA (service),
- (socktype == SOCK_DGRAM ? "udp" : "tcp"));
- if (svc_info == 0)
- error ("Unknown service: %s", SDATA (service));
- port = svc_info->s_port;
- }
+#endif /* HAVE_GETADDRINFO_A */
- memset (&address_in, 0, sizeof address_in);
- address_in.sin_family = family;
- address_in.sin_addr.s_addr = INADDR_ANY;
- address_in.sin_port = port;
+ /* If we have a host, use getaddrinfo to resolve both host and service.
+ Otherwise, use getservbyname to lookup the service. */
-#ifndef HAVE_GETADDRINFO
if (!NILP (host))
{
- struct hostent *host_info_ptr;
-
- /* gethostbyname may fail with TRY_AGAIN, but we don't honor that,
- as it may `hang' Emacs for a very long time. */
- immediate_quit = 1;
- QUIT;
-
-#ifdef HAVE_RES_INIT
- res_init ();
-#endif
-
- host_info_ptr = gethostbyname (SDATA (host));
- immediate_quit = 0;
-
- if (host_info_ptr)
- {
- memcpy (&address_in.sin_addr, host_info_ptr->h_addr,
- host_info_ptr->h_length);
- family = host_info_ptr->h_addrtype;
- address_in.sin_family = family;
- }
- else
- /* Attempt to interpret host as numeric inet address. */
- {
- unsigned long numeric_addr;
- numeric_addr = inet_addr (SSDATA (host));
- if (numeric_addr == -1)
- error ("Unknown host \"%s\"", SDATA (host));
-
- memcpy (&address_in.sin_addr, &numeric_addr,
- sizeof (address_in.sin_addr));
- }
-
- }
-#endif /* not HAVE_GETADDRINFO */
-
- ai.ai_family = family;
- ai.ai_addr = (struct sockaddr *) &address_in;
- ai.ai_addrlen = sizeof address_in;
-
- open_socket:
-
- /* Do this in case we never enter the for-loop below. */
- count1 = SPECPDL_INDEX ();
- s = -1;
-
- for (lres = res; lres; lres = lres->ai_next)
- {
- ptrdiff_t optn;
- int optbits;
-
-#ifdef WINDOWSNT
- retry_connect:
-#endif
-
- s = socket (lres->ai_family, lres->ai_socktype | SOCK_CLOEXEC,
- lres->ai_protocol);
- if (s < 0)
- {
- xerrno = errno;
- continue;
- }
-
-#ifdef DATAGRAM_SOCKETS
- if (!is_server && socktype == SOCK_DGRAM)
- break;
-#endif /* DATAGRAM_SOCKETS */
-
-#ifdef NON_BLOCKING_CONNECT
- if (is_non_blocking_client)
- {
- ret = fcntl (s, F_SETFL, O_NONBLOCK);
- if (ret < 0)
- {
- xerrno = errno;
- emacs_close (s);
- s = -1;
- continue;
- }
- }
-#endif
-
- /* Make us close S if quit. */
- record_unwind_protect_int (close_file_unwind, s);
-
- /* Parse network options in the arg list.
- We simply ignore anything which isn't a known option (including other keywords).
- An error is signaled if setting a known option fails. */
- for (optn = optbits = 0; optn < nargs - 1; optn += 2)
- optbits |= set_socket_option (s, args[optn], args[optn + 1]);
-
- if (is_server)
- {
- /* Configure as a server socket. */
-
- /* SO_REUSEADDR = 1 is default for server sockets; must specify
- explicit :reuseaddr key to override this. */
-#ifdef HAVE_LOCAL_SOCKETS
- if (family != AF_LOCAL)
-#endif
- if (!(optbits & (1 << OPIX_REUSEADDR)))
- {
- int optval = 1;
- if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
- report_file_error ("Cannot set reuse option on server socket", Qnil);
- }
-
- if (bind (s, lres->ai_addr, lres->ai_addrlen))
- report_file_error ("Cannot bind server socket", Qnil);
-
-#ifdef HAVE_GETSOCKNAME
- if (EQ (service, Qt))
- {
- struct sockaddr_in sa1;
- socklen_t len1 = sizeof (sa1);
- if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
- {
- ((struct sockaddr_in *)(lres->ai_addr))->sin_port = sa1.sin_port;
- service = make_number (ntohs (sa1.sin_port));
- contact = Fplist_put (contact, QCservice, service);
- }
- }
-#endif
-
- if (socktype != SOCK_DGRAM && listen (s, backlog))
- report_file_error ("Cannot listen on server socket", Qnil);
-
- break;
- }
+ struct addrinfo *res, *lres;
+ int ret;
immediate_quit = 1;
QUIT;
- ret = connect (s, lres->ai_addr, lres->ai_addrlen);
- xerrno = errno;
+ struct addrinfo hints;
+ memset (&hints, 0, sizeof hints);
+ hints.ai_family = family;
+ hints.ai_socktype = socktype;
- if (ret == 0 || xerrno == EISCONN)
+ ret = getaddrinfo (SSDATA (host), portstring, &hints, &res);
+ if (ret)
+#ifdef HAVE_GAI_STRERROR
{
- /* The unwind-protect will be discarded afterwards.
- Likewise for immediate_quit. */
- break;
+ synchronize_system_messages_locale ();
+ char const *str = gai_strerror (ret);
+ if (! NILP (Vlocale_coding_system))
+ str = SSDATA (code_convert_string_norecord
+ (build_string (str), Vlocale_coding_system, 0));
+ error ("%s/%s %s", SSDATA (host), portstring, str);
}
-
-#ifdef NON_BLOCKING_CONNECT
-#ifdef EINPROGRESS
- if (is_non_blocking_client && xerrno == EINPROGRESS)
- break;
#else
-#ifdef EWOULDBLOCK
- if (is_non_blocking_client && xerrno == EWOULDBLOCK)
- break;
-#endif
-#endif
+ error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
#endif
+ immediate_quit = 0;
-#ifndef WINDOWSNT
- if (xerrno == EINTR)
- {
- /* Unlike most other syscalls connect() cannot be called
- again. (That would return EALREADY.) The proper way to
- wait for completion is pselect(). */
- int sc;
- socklen_t len;
- fd_set fdset;
- retry_select:
- FD_ZERO (&fdset);
- FD_SET (s, &fdset);
- QUIT;
- sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL);
- if (sc == -1)
- {
- if (errno == EINTR)
- goto retry_select;
- else
- report_file_error ("Failed select", Qnil);
- }
- eassert (sc > 0);
-
- len = sizeof xerrno;
- eassert (FD_ISSET (s, &fdset));
- if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) < 0)
- report_file_error ("Failed getsockopt", Qnil);
- if (xerrno)
- report_file_errno ("Failed connect", Qnil, xerrno);
- break;
- }
-#endif /* !WINDOWSNT */
+ for (lres = res; lres; lres = lres->ai_next)
+ addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos);
- immediate_quit = 0;
+ addrinfos = Fnreverse (addrinfos);
- /* Discard the unwind protect closing S. */
- specpdl_ptr = specpdl + count1;
- emacs_close (s);
- s = -1;
+ freeaddrinfo (res);
-#ifdef WINDOWSNT
- if (xerrno == EINTR)
- goto retry_connect;
-#endif
+ goto open_socket;
}
- if (s >= 0)
+ /* No hostname has been specified (e.g., a local server process). */
+
+ if (EQ (service, Qt))
+ port = 0;
+ else if (INTEGERP (service))
+ port = XINT (service);
+ else
{
-#ifdef DATAGRAM_SOCKETS
- if (socktype == SOCK_DGRAM)
+ CHECK_STRING (service);
+
+ port = -1;
+ if (SBYTES (service) != 0)
{
- if (datagram_address[s].sa)
- emacs_abort ();
- datagram_address[s].sa = xmalloc (lres->ai_addrlen);
- datagram_address[s].len = lres->ai_addrlen;
- if (is_server)
+ /* Allow the service to be a string containing the port number,
+ because that's allowed if you have getaddrbyname. */
+ char *service_end;
+ long int lport = strtol (SSDATA (service), &service_end, 10);
+ if (service_end == SSDATA (service) + SBYTES (service))
+ port = lport;
+ else
{
- Lisp_Object remote;
- memset (datagram_address[s].sa, 0, lres->ai_addrlen);
- if (remote = Fplist_get (contact, QCremote), !NILP (remote))
- {
- int rfamily, rlen;
- rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
- if (rlen != 0 && rfamily == lres->ai_family
- && rlen == lres->ai_addrlen)
- conv_lisp_to_sockaddr (rfamily, remote,
- datagram_address[s].sa, rlen);
- }
+ struct servent *svc_info
+ = getservbyname (SSDATA (service),
+ socktype == SOCK_DGRAM ? "udp" : "tcp");
+ if (svc_info)
+ port = ntohs (svc_info->s_port);
}
- else
- memcpy (datagram_address[s].sa, lres->ai_addr, lres->ai_addrlen);
}
-#endif
- contact = Fplist_put (contact, colon_address,
- conv_sockaddr_to_lisp (lres->ai_addr, lres->ai_addrlen));
-#ifdef HAVE_GETSOCKNAME
- if (!is_server)
- {
- struct sockaddr_in sa1;
- socklen_t len1 = sizeof (sa1);
- if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
- contact = Fplist_put (contact, QClocal,
- conv_sockaddr_to_lisp ((struct sockaddr *)&sa1, len1));
- }
-#endif
}
- immediate_quit = 0;
-
-#ifdef HAVE_GETADDRINFO
- if (res != &ai)
+ if (! (0 <= port && port < 1 << 16))
{
- block_input ();
- freeaddrinfo (res);
- unblock_input ();
+ AUTO_STRING (unknown_service, "Unknown service: %s");
+ xsignal1 (Qerror, CALLN (Fformat, unknown_service, service));
}
-#endif
- if (s < 0)
- {
- /* If non-blocking got this far - and failed - assume non-blocking is
- not supported after all. This is probably a wrong assumption, but
- the normal blocking calls to open-network-stream handles this error
- better. */
- if (is_non_blocking_client)
- return Qnil;
-
- report_file_errno ((is_server
- ? "make server process failed"
- : "make client process failed"),
- contact, xerrno);
- }
-
- inch = s;
- outch = s;
+ open_socket:
if (!NILP (buffer))
buffer = Fget_buffer_create (buffer);
- proc = make_process (name);
- chan_process[inch] = proc;
-
- fcntl (inch, F_SETFL, O_NONBLOCK);
+ /* Unwind bind_polling_period. */
+ unbind_to (count, Qnil);
+ proc = make_process (name);
+ record_unwind_protect (remove_process, proc);
p = XPROCESS (proc);
-
pset_childp (p, contact);
pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
pset_type (p, Qnetwork);
@@ -3633,136 +3941,54 @@ usage: (make-network-process &rest ARGS) */)
p->kill_without_query = 1;
if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
pset_command (p, Qt);
- p->pid = 0;
-
- p->open_fd[SUBPROCESS_STDIN] = inch;
- p->infd = inch;
- p->outfd = outch;
-
- /* Discard the unwind protect for closing S, if any. */
- specpdl_ptr = specpdl + count1;
-
- /* Unwind bind_polling_period and request_sigio. */
- unbind_to (count, Qnil);
+ eassert (p->pid == 0);
+ p->backlog = 5;
+ eassert (! p->is_non_blocking_client);
+ eassert (! p->is_server);
+ p->port = port;
+ p->socktype = socktype;
+#ifdef HAVE_GETADDRINFO_A
+ eassert (! p->dns_request);
+#endif
+#ifdef HAVE_GNUTLS
+ tem = Fplist_get (contact, QCtls_parameters);
+ CHECK_LIST (tem);
+ p->gnutls_boot_parameters = tem;
+#endif
- if (is_server && socktype != SOCK_DGRAM)
- pset_status (p, Qlisten);
+ set_network_socket_coding_system (proc, host, service, name);
- /* Make the process marker point into the process buffer (if any). */
- if (BUFFERP (buffer))
- set_marker_both (p->mark, buffer,
- BUF_ZV (XBUFFER (buffer)),
- BUF_ZV_BYTE (XBUFFER (buffer)));
+ /* :server BOOL */
+ tem = Fplist_get (contact, QCserver);
+ if (!NILP (tem))
+ {
+ /* Don't support network sockets when non-blocking mode is
+ not available, since a blocked Emacs is not useful. */
+ p->is_server = true;
+ if (TYPE_RANGED_INTEGERP (int, tem))
+ p->backlog = XINT (tem);
+ }
-#ifdef NON_BLOCKING_CONNECT
- if (is_non_blocking_client)
+ /* :nowait BOOL */
+ if (!p->is_server && socktype != SOCK_DGRAM
+ && !NILP (Fplist_get (contact, QCnowait)))
+ p->is_non_blocking_client = true;
+
+ bool postpone_connection = false;
+#ifdef HAVE_GETADDRINFO_A
+ /* With async address resolution, the list of addresses is empty, so
+ postpone connecting to the server. */
+ if (!p->is_server && NILP (addrinfos))
{
- /* We may get here if connect did succeed immediately. However,
- in that case, we still need to signal this like a non-blocking
- connection. */
- pset_status (p, Qconnect);
- if (!FD_ISSET (inch, &connect_wait_mask))
- {
- FD_SET (inch, &connect_wait_mask);
- FD_SET (inch, &write_mask);
- num_pending_connects++;
- }
+ p->dns_request = dns_request;
+ p->status = list1 (Qconnect);
+ postpone_connection = true;
}
- else
#endif
- /* A server may have a client filter setting of Qt, but it must
- still listen for incoming connects unless it is stopped. */
- if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt))
- || (EQ (p->status, Qlisten) && NILP (p->command)))
- {
- FD_SET (inch, &input_wait_mask);
- FD_SET (inch, &non_keyboard_wait_mask);
- }
-
- if (inch > max_process_desc)
- max_process_desc = inch;
-
- tem = Fplist_member (contact, QCcoding);
- if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
- tem = Qnil; /* No error message (too late!). */
-
- {
- /* Setup coding systems for communicating with the network stream. */
- /* Qt denotes we have not yet called Ffind_operation_coding_system. */
- Lisp_Object coding_systems = Qt;
- Lisp_Object val;
-
- if (!NILP (tem))
- {
- val = XCAR (XCDR (tem));
- if (CONSP (val))
- val = XCAR (val);
- }
- else if (!NILP (Vcoding_system_for_read))
- val = Vcoding_system_for_read;
- else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
- || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
- /* We dare not decode end-of-line format by setting VAL to
- Qraw_text, because the existing Emacs Lisp libraries
- assume that they receive bare code including a sequence of
- CR LF. */
- val = Qnil;
- else
- {
- if (NILP (host) || NILP (service))
- coding_systems = Qnil;
- else
- coding_systems = CALLN (Ffind_operation_coding_system,
- Qopen_network_stream, name, buffer,
- host, service);
- if (CONSP (coding_systems))
- val = XCAR (coding_systems);
- else if (CONSP (Vdefault_process_coding_system))
- val = XCAR (Vdefault_process_coding_system);
- else
- val = Qnil;
- }
- pset_decode_coding_system (p, val);
-
- if (!NILP (tem))
- {
- val = XCAR (XCDR (tem));
- if (CONSP (val))
- val = XCDR (val);
- }
- else if (!NILP (Vcoding_system_for_write))
- val = Vcoding_system_for_write;
- else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
- val = Qnil;
- else
- {
- if (EQ (coding_systems, Qt))
- {
- if (NILP (host) || NILP (service))
- coding_systems = Qnil;
- else
- coding_systems = CALLN (Ffind_operation_coding_system,
- Qopen_network_stream, name, buffer,
- host, service);
- }
- if (CONSP (coding_systems))
- val = XCDR (coding_systems);
- else if (CONSP (Vdefault_process_coding_system))
- val = XCDR (Vdefault_process_coding_system);
- else
- val = Qnil;
- }
- pset_encode_coding_system (p, val);
- }
- setup_process_coding_systems (proc);
-
- pset_decoding_buf (p, empty_unibyte_string);
- p->decoding_carryover = 0;
- pset_encoding_buf (p, empty_unibyte_string);
-
- p->inherit_coding_system_flag
- = !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
+ if (! postpone_connection)
+ connect_network_socket (proc, addrinfos, use_external_socket_p);
+ specpdl_ptr = specpdl + count;
return proc;
}
@@ -4142,7 +4368,6 @@ deactivate_process (Lisp_Object proc)
chan_process[inchannel] = Qnil;
FD_CLR (inchannel, &input_wait_mask);
FD_CLR (inchannel, &non_keyboard_wait_mask);
-#ifdef NON_BLOCKING_CONNECT
if (FD_ISSET (inchannel, &connect_wait_mask))
{
FD_CLR (inchannel, &connect_wait_mask);
@@ -4150,7 +4375,6 @@ deactivate_process (Lisp_Object proc)
if (--num_pending_connects < 0)
emacs_abort ();
}
-#endif
if (inchannel == max_process_desc)
{
/* We just closed the highest-numbered process input descriptor,
@@ -4395,8 +4619,8 @@ server_accept_connection (Lisp_Object server, int channel)
pset_buffer (p, buffer);
pset_sentinel (p, ps->sentinel);
pset_filter (p, ps->filter);
- pset_command (p, Qnil);
- p->pid = 0;
+ eassert (NILP (p->command));
+ eassert (p->pid == 0);
/* Discard the unwind protect for closing S. */
specpdl_ptr = specpdl + count;
@@ -4426,7 +4650,7 @@ server_accept_connection (Lisp_Object server, int channel)
setup_process_coding_systems (proc);
pset_decoding_buf (p, empty_unibyte_string);
- p->decoding_carryover = 0;
+ eassert (p->decoding_carryover == 0);
pset_encoding_buf (p, empty_unibyte_string);
p->inherit_coding_system_flag
@@ -4446,6 +4670,87 @@ server_accept_connection (Lisp_Object server, int channel)
exec_sentinel (proc, concat3 (open_from, host_string, nl));
}
+#ifdef HAVE_GETADDRINFO_A
+static Lisp_Object
+check_for_dns (Lisp_Object proc)
+{
+ struct Lisp_Process *p = XPROCESS (proc);
+ Lisp_Object addrinfos = Qnil;
+
+ /* Sanity check. */
+ if (! p->dns_request)
+ return Qnil;
+
+ int ret = gai_error (p->dns_request);
+ if (ret == EAI_INPROGRESS)
+ return Qt;
+
+ /* We got a response. */
+ if (ret == 0)
+ {
+ struct addrinfo *res;
+
+ for (res = p->dns_request->ar_result; res; res = res->ai_next)
+ addrinfos = Fcons (conv_addrinfo_to_lisp (res), addrinfos);
+
+ addrinfos = Fnreverse (addrinfos);
+ }
+ /* The DNS lookup failed. */
+ else if (connecting_status (p->status))
+ {
+ deactivate_process (proc);
+ pset_status (p, (list2
+ (Qfailed,
+ concat3 (build_string ("Name lookup of "),
+ build_string (p->dns_request->ar_name),
+ build_string (" failed")))));
+ }
+
+ free_dns_request (proc);
+
+ /* This process should not already be connected (or killed). */
+ if (! connecting_status (p->status))
+ return Qnil;
+
+ return addrinfos;
+}
+
+#endif /* HAVE_GETADDRINFO_A */
+
+static void
+wait_for_socket_fds (Lisp_Object process, char const *name)
+{
+ while (XPROCESS (process)->infd < 0
+ && connecting_status (XPROCESS (process)->status))
+ {
+ add_to_log ("Waiting for socket from %s...", build_string (name));
+ wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
+ }
+}
+
+static void
+wait_while_connecting (Lisp_Object process)
+{
+ while (connecting_status (XPROCESS (process)->status))
+ {
+ add_to_log ("Waiting for connection...");
+ wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
+ }
+}
+
+static void
+wait_for_tls_negotiation (Lisp_Object process)
+{
+#ifdef HAVE_GNUTLS
+ while (XPROCESS (process)->gnutls_p
+ && XPROCESS (process)->gnutls_initstage != GNUTLS_STAGE_READY)
+ {
+ add_to_log ("Waiting for TLS...");
+ wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
+ }
+#endif
+}
+
/* This variable is different from waiting_for_input in keyboard.c.
It is used to communicate to a lisp process-filter/sentinel (via the
function Fwaiting_for_user_input_p below) whether Emacs was waiting
@@ -4524,6 +4829,9 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
struct timespec got_output_end_time = invalid_timespec ();
enum { MINIMUM = -1, TIMEOUT, INFINITY } wait;
int got_some_output = -1;
+#if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
+ bool retry_for_async;
+#endif
ptrdiff_t count = SPECPDL_INDEX ();
/* Close to the current time if known, an invalid timespec otherwise. */
@@ -4571,6 +4879,60 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
break;
+#if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
+ {
+ Lisp_Object process_list_head, aproc;
+ struct Lisp_Process *p;
+
+ retry_for_async = false;
+ FOR_EACH_PROCESS(process_list_head, aproc)
+ {
+ p = XPROCESS (aproc);
+
+ if (! wait_proc || p == wait_proc)
+ {
+#ifdef HAVE_GETADDRINFO_A
+ /* Check for pending DNS requests. */
+ if (p->dns_request)
+ {
+ Lisp_Object addrinfos = check_for_dns (aproc);
+ if (!NILP (addrinfos) && !EQ (addrinfos, Qt))
+ connect_network_socket (aproc, addrinfos, Qnil);
+ else
+ retry_for_async = true;
+ }
+#endif
+#ifdef HAVE_GNUTLS
+ /* Continue TLS negotiation. */
+ if (p->gnutls_initstage == GNUTLS_STAGE_HANDSHAKE_TRIED
+ && p->is_non_blocking_client)
+ {
+ gnutls_try_handshake (p);
+ p->gnutls_handshakes_tried++;
+
+ if (p->gnutls_initstage == GNUTLS_STAGE_READY)
+ {
+ gnutls_verify_boot (aproc, Qnil);
+ finish_after_tls_connection (aproc);
+ }
+ else
+ {
+ retry_for_async = true;
+ if (p->gnutls_handshakes_tried
+ > GNUTLS_EMACS_HANDSHAKES_LIMIT)
+ {
+ deactivate_process (aproc);
+ pset_status (p, list2 (Qfailed,
+ build_string ("TLS negotiation failed")));
+ }
+ }
+ }
+#endif
+ }
+ }
+ }
+#endif /* GETADDRINFO_A or GNUTLS */
+
/* Compute time from now till when time limit is up. */
/* Exit if already run out. */
if (wait == TIMEOUT)
@@ -4653,11 +5015,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
timeout = make_timespec (0, 0);
if ((pselect (max (max_process_desc, max_input_desc) + 1,
&Atemp,
-#ifdef NON_BLOCKING_CONNECT
(num_pending_connects > 0 ? &Ctemp : NULL),
-#else
- NULL,
-#endif
NULL, &timeout, NULL)
<= 0))
{
@@ -4675,7 +5033,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
update_status (wait_proc);
if (wait_proc
&& ! EQ (wait_proc->status, Qrun)
- && ! EQ (wait_proc->status, Qconnect))
+ && ! connecting_status (wait_proc->status))
{
bool read_some_bytes = false;
@@ -4825,6 +5183,15 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
if (timeout.tv_sec > 0 || timeout.tv_nsec > 0)
now = invalid_timespec ();
+#if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
+ if (retry_for_async
+ && (timeout.tv_sec > 0 || timeout.tv_nsec > ASYNC_RETRY_NSEC))
+ {
+ timeout.tv_sec = 0;
+ timeout.tv_nsec = ASYNC_RETRY_NSEC;
+ }
+#endif
+
#if defined (HAVE_NS)
nfds = ns_select
#elif defined (HAVE_GLIB)
@@ -5138,7 +5505,6 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
list2 (Qexit, make_number (256)));
}
}
-#ifdef NON_BLOCKING_CONNECT
if (FD_ISSET (channel, &Writeok)
&& FD_ISSET (channel, &connect_wait_mask))
{
@@ -5155,15 +5521,16 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
p = XPROCESS (proc);
-#ifdef GNU_LINUX
- /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
- So only use it on systems where it is known to work. */
+#ifndef WINDOWSNT
{
socklen_t xlen = sizeof (xerrno);
if (getsockopt (channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
xerrno = errno;
}
#else
+ /* On MS-Windows, getsockopt clears the error for the
+ entire process, which may not be the right thing; see
+ w32.c. Use getpeername instead. */
{
struct sockaddr pname;
socklen_t pnamelen = sizeof (pname);
@@ -5182,17 +5549,36 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
#endif
if (xerrno)
{
- p->tick = ++process_tick;
- pset_status (p, list2 (Qfailed, make_number (xerrno)));
+ Lisp_Object addrinfos
+ = connecting_status (p->status) ? XCDR (p->status) : Qnil;
+ if (!NILP (addrinfos))
+ XSETCDR (p->status, XCDR (addrinfos));
+ else
+ {
+ p->tick = ++process_tick;
+ pset_status (p, list2 (Qfailed, make_number (xerrno)));
+ }
deactivate_process (proc);
+ if (!NILP (addrinfos))
+ connect_network_socket (proc, addrinfos, Qnil);
}
else
{
- pset_status (p, Qrun);
- /* Execute the sentinel here. If we had relied on
- status_notify to do it later, it will read input
- from the process before calling the sentinel. */
- exec_sentinel (proc, build_string ("open\n"));
+#ifdef HAVE_GNUTLS
+ /* If we have an incompletely set up TLS connection,
+ then defer the sentinel signaling until
+ later. */
+ if (NILP (p->gnutls_boot_parameters)
+ && !p->gnutls_p)
+#endif
+ {
+ pset_status (p, Qrun);
+ /* Execute the sentinel here. If we had relied on
+ status_notify to do it later, it will read input
+ from the process before calling the sentinel. */
+ exec_sentinel (proc, build_string ("open\n"));
+ }
+
if (0 <= p->infd && !EQ (p->filter, Qt)
&& !EQ (p->command, Qt))
{
@@ -5201,7 +5587,6 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
}
}
}
-#endif /* NON_BLOCKING_CONNECT */
} /* End for each file descriptor. */
} /* End while exit conditions not met. */
@@ -5649,6 +6034,12 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len,
ssize_t rv;
struct coding_system *coding;
+ if (NETCONN_P (proc))
+ {
+ wait_while_connecting (proc);
+ wait_for_tls_negotiation (proc);
+ }
+
if (p->raw_status_new)
update_status (p);
if (! EQ (p->status, Qrun))
@@ -5862,7 +6253,10 @@ nil, indicating the current buffer's process.
Called from program, takes three arguments, PROCESS, START and END.
If the region is more than 500 characters long,
it is sent in several bunches. This may happen even for shorter regions.
-Output from processes can arrive in between bunches. */)
+Output from processes can arrive in between bunches.
+
+If PROCESS is a non-blocking network process that hasn't been fully
+set up yet, this function will block until socket setup has completed. */)
(Lisp_Object process, Lisp_Object start, Lisp_Object end)
{
Lisp_Object proc = get_process (process);
@@ -5876,6 +6270,9 @@ Output from processes can arrive in between bunches. */)
if (XINT (start) < GPT && XINT (end) > GPT)
move_gap_both (XINT (start), start_byte);
+ if (NETCONN_P (proc))
+ wait_while_connecting (proc);
+
send_process (proc, (char *) BYTE_POS_ADDR (start_byte),
end_byte - start_byte, Fcurrent_buffer ());
@@ -5889,12 +6286,14 @@ PROCESS may be a process, a buffer, the name of a process or buffer, or
nil, indicating the current buffer's process.
If STRING is more than 500 characters long,
it is sent in several bunches. This may happen even for shorter strings.
-Output from processes can arrive in between bunches. */)
+Output from processes can arrive in between bunches.
+
+If PROCESS is a non-blocking network process that hasn't been fully
+set up yet, this function will block until socket setup has completed. */)
(Lisp_Object process, Lisp_Object string)
{
- Lisp_Object proc;
CHECK_STRING (string);
- proc = get_process (process);
+ Lisp_Object proc = get_process (process);
send_process (proc, SSDATA (string),
SBYTES (string), string);
return Qnil;
@@ -5936,12 +6335,8 @@ process group. */)
{
/* Initialize in case ioctl doesn't exist or gives an error,
in a way that will cause returning t. */
- pid_t gid;
- Lisp_Object proc;
- struct Lisp_Process *p;
-
- proc = get_process (process);
- p = XPROCESS (proc);
+ Lisp_Object proc = get_process (process);
+ struct Lisp_Process *p = XPROCESS (proc);
if (!EQ (p->type, Qreal))
error ("Process %s is not a subprocess",
@@ -5950,7 +6345,7 @@ process group. */)
error ("Process %s is not active",
SDATA (p->name));
- gid = emacs_get_tty_pgrp (p);
+ pid_t gid = emacs_get_tty_pgrp (p);
if (gid == p->pid)
return Qnil;
@@ -6021,7 +6416,7 @@ process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group,
break;
case SIGTSTP:
-#if defined (VSWTCH) && !defined (PREFER_VSUSP)
+#ifdef VSWTCH
sig_char = &t.c_cc[VSWTCH];
#else
sig_char = &t.c_cc[VSUSP];
@@ -6309,10 +6704,15 @@ process has been transmitted to the serial port. */)
struct coding_system *coding = NULL;
int outfd;
- if (DATAGRAM_CONN_P (process))
+ proc = get_process (process);
+
+ if (NETCONN_P (proc))
+ wait_while_connecting (proc);
+
+ if (DATAGRAM_CONN_P (proc))
return process;
- proc = get_process (process);
+
outfd = XPROCESS (proc)->outfd;
if (outfd >= 0)
coding = proc_encode_coding_system[outfd];
@@ -6637,7 +7037,7 @@ status_notify (struct Lisp_Process *deleting_process,
/* If process is still active, read any output that remains. */
while (! EQ (p->filter, Qt)
- && ! EQ (p->status, Qconnect)
+ && ! connecting_status (p->status)
&& ! EQ (p->status, Qlisten)
/* Network or serial process not stopped: */
&& ! EQ (p->command, Qt)
@@ -6757,22 +7157,24 @@ DEFUN ("set-process-coding-system", Fset_process_coding_system,
Sset_process_coding_system, 1, 3, 0,
doc: /* Set coding systems of PROCESS to DECODING and ENCODING.
DECODING will be used to decode subprocess output and ENCODING to
-encode subprocess input. */)
- (register Lisp_Object process, Lisp_Object decoding, Lisp_Object encoding)
+encode subprocess input. */)
+ (Lisp_Object process, Lisp_Object decoding, Lisp_Object encoding)
{
- register struct Lisp_Process *p;
-
CHECK_PROCESS (process);
- p = XPROCESS (process);
- if (p->infd < 0)
- error ("Input file descriptor of %s closed", SDATA (p->name));
- if (p->outfd < 0)
- error ("Output file descriptor of %s closed", SDATA (p->name));
+
+ struct Lisp_Process *p = XPROCESS (process);
+
Fcheck_coding_system (decoding);
Fcheck_coding_system (encoding);
encoding = coding_inherit_eol_type (encoding, Qnil);
pset_decode_coding_system (p, decoding);
pset_encode_coding_system (p, encoding);
+
+ /* If the sockets haven't been set up yet, the final setup part of
+ this will be called asynchronously. */
+ if (p->infd < 0 || p->outfd < 0)
+ return Qnil;
+
setup_process_coding_systems (process);
return Qnil;
@@ -6797,13 +7199,18 @@ all character code conversion except for end-of-line conversion is
suppressed. */)
(Lisp_Object process, Lisp_Object flag)
{
- register struct Lisp_Process *p;
-
CHECK_PROCESS (process);
- p = XPROCESS (process);
+
+ struct Lisp_Process *p = XPROCESS (process);
if (NILP (flag))
pset_decode_coding_system
(p, raw_text_coding_system (p->decode_coding_system));
+
+ /* If the sockets haven't been set up yet, the final setup part of
+ this will be called asynchronously. */
+ if (p->infd < 0 || p->outfd < 0)
+ return Qnil;
+
setup_process_coding_systems (process);
return Qnil;
@@ -6814,14 +7221,11 @@ DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p,
doc: /* Return t if a multibyte string is given to PROCESS's filter.*/)
(Lisp_Object process)
{
- register struct Lisp_Process *p;
- struct coding_system *coding;
-
CHECK_PROCESS (process);
- p = XPROCESS (process);
+ struct Lisp_Process *p = XPROCESS (process);
if (p->infd < 0)
return Qnil;
- coding = proc_decode_coding_system[p->infd];
+ struct coding_system *coding = proc_decode_coding_system[p->infd];
return (CODING_FOR_UNIBYTE (coding) ? Qnil : Qt);
}
@@ -7371,14 +7775,25 @@ catch_child_signal (void)
}
#endif /* subprocesses */
+/* Limit the number of open files to the value it had at startup. */
+
+void
+restore_nofile_limit (void)
+{
+#ifdef HAVE_SETRLIMIT
+ if (FD_SETSIZE < nofile_limit.rlim_cur)
+ setrlimit (RLIMIT_NOFILE, &nofile_limit);
+#endif
+}
+
/* This is not called "init_process" because that is the name of a
Mach system call, so it would cause problems on Darwin systems. */
void
-init_process_emacs (void)
+init_process_emacs (int sockfd)
{
#ifdef subprocesses
- register int i;
+ int i;
inhibit_sentinels = 0;
@@ -7396,17 +7811,29 @@ init_process_emacs (void)
catch_child_signal ();
}
+#ifdef HAVE_SETRLIMIT
+ /* Don't allocate more than FD_SETSIZE file descriptors for Emacs itself. */
+ if (getrlimit (RLIMIT_NOFILE, &nofile_limit) != 0)
+ nofile_limit.rlim_cur = 0;
+ else if (FD_SETSIZE < nofile_limit.rlim_cur)
+ {
+ struct rlimit rlim = nofile_limit;
+ rlim.rlim_cur = FD_SETSIZE;
+ if (setrlimit (RLIMIT_NOFILE, &rlim) != 0)
+ nofile_limit.rlim_cur = 0;
+ }
+#endif
+
FD_ZERO (&input_wait_mask);
FD_ZERO (&non_keyboard_wait_mask);
FD_ZERO (&non_process_wait_mask);
FD_ZERO (&write_mask);
max_process_desc = max_input_desc = -1;
+ external_sock_fd = sockfd;
memset (fd_callback_info, 0, sizeof (fd_callback_info));
-#ifdef NON_BLOCKING_CONNECT
FD_ZERO (&connect_wait_mask);
num_pending_connects = 0;
-#endif
process_output_delay_count = 0;
process_output_skip = 0;
@@ -7501,6 +7928,9 @@ syms_of_process (void)
DEFSYM (QCserver, ":server");
DEFSYM (QCnowait, ":nowait");
DEFSYM (QCsentinel, ":sentinel");
+ DEFSYM (QCuse_external_socket, ":use-external-socket");
+ DEFSYM (QCtls_parameters, ":tls-parameters");
+ DEFSYM (Qnsm_verify_connection, "nsm-verify-connection");
DEFSYM (QClog, ":log");
DEFSYM (QCnoquery, ":noquery");
DEFSYM (QCstop, ":stop");
@@ -7650,9 +8080,7 @@ The variable takes effect when `start-process' is called. */);
#define ADD_SUBFEATURE(key, val) \
subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
-#ifdef NON_BLOCKING_CONNECT
ADD_SUBFEATURE (QCnowait, Qt);
-#endif
#ifdef DATAGRAM_SOCKETS
ADD_SUBFEATURE (QCtype, Qdatagram);
#endif
diff --git a/src/process.h b/src/process.h
index 2e743a3dc38..24c628231a0 100644
--- a/src/process.h
+++ b/src/process.h
@@ -83,7 +83,10 @@ struct Lisp_Process
Lisp_Object mark;
/* Symbol indicating status of process.
- This may be a symbol: run, open, or closed.
+ This may be a symbol: run, open, closed, listen, or failed.
+ Or it may be a pair (connect . ADDRINFOS) where ADDRINFOS is
+ a list of remaining (PROTOCOL . ADDRINFO) pairs to try.
+ Or it may be (failed ERR) where ERR is an integer, string or symbol.
Or it may be a list, whose car is stop, exit or signal
and whose cdr is a pair (EXIT_CODE . COREDUMP_FLAG)
or (SIGNAL_NUMBER . COREDUMP_FLAG). */
@@ -106,6 +109,7 @@ struct Lisp_Process
#ifdef HAVE_GNUTLS
Lisp_Object gnutls_cred_type;
+ Lisp_Object gnutls_boot_parameters;
#endif
/* Pipe process attached to the standard error of this process. */
@@ -114,10 +118,11 @@ struct Lisp_Process
/* After this point, there are no Lisp_Objects any more. */
/* alloc.c assumes that `pid' is the first such non-Lisp slot. */
- /* Number of this process.
- allocate_process assumes this is the first non-Lisp_Object field.
- A value 0 is used for pseudo-processes such as network or serial
- connections. */
+ /* Process ID. A positive value is a child process ID.
+ Zero is for pseudo-processes such as network or serial connections,
+ or for processes that have not been fully created yet.
+ -1 is for a process that was not created successfully.
+ -2 is for a pty with no process, e.g., for GDB. */
pid_t pid;
/* Descriptor by which we read from this process. */
int infd;
@@ -161,7 +166,23 @@ struct Lisp_Process
flag indicates that `raw_status' contains a new status that still
needs to be synced to `status'. */
bool_bf raw_status_new : 1;
+ /* Whether this is a nonblocking socket. */
+ bool_bf is_non_blocking_client : 1;
+ /* Whether this is a server or a client socket. */
+ bool_bf is_server : 1;
int raw_status;
+ /* The length of the socket backlog. */
+ int backlog;
+ /* The port number. */
+ int port;
+ /* The socket type. */
+ int socktype;
+
+#ifdef HAVE_GETADDRINFO_A
+ /* Whether the socket is waiting for response from an asynchronous
+ DNS call. */
+ struct gaicb *dns_request;
+#endif
#ifdef HAVE_GNUTLS
gnutls_initstage_t gnutls_initstage;
@@ -174,6 +195,7 @@ struct Lisp_Process
int gnutls_log_level;
int gnutls_handshakes_tried;
bool_bf gnutls_p : 1;
+ bool_bf gnutls_complete_negotiation_p : 1;
#endif
};
@@ -191,6 +213,12 @@ pset_childp (struct Lisp_Process *p, Lisp_Object val)
p->childp = val;
}
+INLINE void
+pset_status (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->status = val;
+}
+
#ifdef HAVE_GNUTLS
INLINE void
pset_gnutls_cred_type (struct Lisp_Process *p, Lisp_Object val)
@@ -225,7 +253,7 @@ extern Lisp_Object system_process_attributes (Lisp_Object);
extern void record_deleted_pid (pid_t, Lisp_Object);
struct sockaddr;
-extern Lisp_Object conv_sockaddr_to_lisp (struct sockaddr *, int);
+extern Lisp_Object conv_sockaddr_to_lisp (struct sockaddr *, ptrdiff_t);
extern void hold_keyboard_input (void);
extern void unhold_keyboard_input (void);
extern bool kbd_on_hold_p (void);
@@ -237,6 +265,7 @@ extern void delete_read_fd (int fd);
extern void add_write_fd (int fd, fd_callback func, void *data);
extern void delete_write_fd (int fd);
extern void catch_child_signal (void);
+extern void restore_nofile_limit (void);
#ifdef WINDOWSNT
extern Lisp_Object network_interface_list (void);
diff --git a/src/profiler.c b/src/profiler.c
index 31bd77f00e3..07e21aeab10 100644
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -201,7 +201,12 @@ static bool profiler_timer_ok;
/* Status of sampling profiler. */
static enum profiler_cpu_running
- { NOT_RUNNING, TIMER_SETTIME_RUNNING, SETITIMER_RUNNING }
+ { NOT_RUNNING,
+#ifdef HAVE_ITIMERSPEC
+ TIMER_SETTIME_RUNNING,
+#endif
+ SETITIMER_RUNNING
+ }
profiler_cpu_running;
/* Hash-table log of CPU profiler. */
@@ -224,7 +229,7 @@ static EMACS_INT current_sampling_interval;
static void
handle_profiler_signal (int signal)
{
- if (EQ (backtrace_top_function (), Qautomatic_gc))
+ if (EQ (backtrace_top_function (), QAutomatic_GC))
/* Special case the time-count inside GC because the hash-table
code is not prepared to be used while the GC is running.
More specifically it uses ASIZE at many places where it does
@@ -418,7 +423,7 @@ Before returning, a new log is allocated for future samples. */)
cpu_log = (profiler_cpu_running
? make_log (profiler_log_size, profiler_max_stack_depth)
: Qnil);
- Fputhash (Fmake_vector (make_number (1), Qautomatic_gc),
+ Fputhash (Fmake_vector (make_number (1), QAutomatic_GC),
make_number (cpu_gc_count),
result);
cpu_gc_count = 0;
diff --git a/src/puresize.h b/src/puresize.h
index fb9d934cad5..da827ed3997 100644
--- a/src/puresize.h
+++ b/src/puresize.h
@@ -47,7 +47,7 @@ INLINE_HEADER_BEGIN
#endif
#ifndef BASE_PURESIZE
-#define BASE_PURESIZE (1800000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA)
+#define BASE_PURESIZE (1900000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA)
#endif
/* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */
diff --git a/src/ralloc.c b/src/ralloc.c
index a94f81b5bfe..2faa42e8296 100644
--- a/src/ralloc.c
+++ b/src/ralloc.c
@@ -22,31 +22,15 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
rather than all of them. This means allowing for a possible
hole between the first bloc and the end of malloc storage. */
-#ifdef emacs
-
#include <config.h>
-#include "lisp.h" /* Needed for VALBITS. */
-#include "blockinput.h"
-
-#include <unistd.h>
-
-#ifdef DOUG_LEA_MALLOC
-#define M_TOP_PAD -2
-extern int mallopt (int, int);
-#else /* not DOUG_LEA_MALLOC */
-#if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC
-extern size_t __malloc_extra_blocks;
-#endif /* not SYSTEM_MALLOC and not HYBRID_MALLOC */
-#endif /* not DOUG_LEA_MALLOC */
-
-#else /* not emacs */
-
#include <stddef.h>
-#include <malloc.h>
-
-#endif /* not emacs */
+#ifdef emacs
+# include "lisp.h"
+# include "blockinput.h"
+# include <unistd.h>
+#endif
#include "getpagesize.h"
@@ -95,7 +79,10 @@ static int extra_bytes;
/* The hook `malloc' uses for the function which gets more space
from the system. */
-#if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC
+#ifdef HAVE_MALLOC_H
+# include <malloc.h>
+#endif
+#ifndef DOUG_LEA_MALLOC
extern void *(*__morecore) (ptrdiff_t);
#endif
diff --git a/src/regex.c b/src/regex.c
index 56b18e6b5bb..1c6c9e5c18b 100644
--- a/src/regex.c
+++ b/src/regex.c
@@ -50,6 +50,7 @@
#include <config.h>
#include <stddef.h>
+#include <stdlib.h>
#ifdef emacs
/* We need this for `regex.h', and perhaps for the Emacs include files. */
@@ -217,7 +218,7 @@ xmalloc (size_t size)
void *val = malloc (size);
if (!val && size)
{
- write (2, "virtual memory exhausted\n", 25);
+ write (STDERR_FILENO, "virtual memory exhausted\n", 25);
exit (1);
}
return val;
@@ -235,7 +236,7 @@ xrealloc (void *block, size_t size)
val = realloc (block, size);
if (!val && size)
{
- write (2, "virtual memory exhausted\n", 25);
+ write (STDERR_FILENO, "virtual memory exhausted\n", 25);
exit (1);
}
return val;
@@ -326,7 +327,7 @@ enum syntaxcode { Swhitespace = 0, Sword = 1, Ssymbol = 2 };
? (((c) >= 'a' && (c) <= 'z') \
|| ((c) >= 'A' && (c) <= 'Z') \
|| ((c) >= '0' && (c) <= '9')) \
- : (alphabeticp (c) || decimalnump (c)))
+ : alphanumericp (c))
# define ISALPHA(c) (IS_REAL_ASCII (c) \
? (((c) >= 'a' && (c) <= 'z') \
@@ -445,25 +446,12 @@ init_syntax_once (void)
#else /* not REGEX_MALLOC */
-/* Emacs already defines alloca, sometimes. */
-# ifndef alloca
-
-/* Make alloca work the best possible way. */
-# ifdef __GNUC__
-# define alloca __builtin_alloca
-# else /* not __GNUC__ */
-# ifdef HAVE_ALLOCA_H
-# include <alloca.h>
-# endif /* HAVE_ALLOCA_H */
-# endif /* not __GNUC__ */
-
-# endif /* not alloca */
-
# ifdef emacs
# define REGEX_USE_SAFE_ALLOCA USE_SAFE_ALLOCA
# define REGEX_SAFE_FREE() SAFE_FREE ()
# define REGEX_ALLOCATE SAFE_ALLOCA
# else
+# include <alloca.h>
# define REGEX_ALLOCATE alloca
# endif
@@ -515,8 +503,6 @@ init_syntax_once (void)
#define BYTEWIDTH 8 /* In bits. */
-#define STREQ(s1, s2) ((strcmp (s1, s2) == 0))
-
#ifndef emacs
# undef max
# undef min
@@ -671,9 +657,7 @@ typedef enum
notsyntaxspec
#ifdef emacs
- ,before_dot, /* Succeeds if before point. */
- at_dot, /* Succeeds if at point. */
- after_dot, /* Succeeds if after point. */
+ , at_dot, /* Succeeds if at point. */
/* Matches any character whose category-set contains the specified
category. The operator is followed by a byte which contains a
@@ -785,44 +769,6 @@ extract_number_and_incr (re_char **source)
and end. */
#define CHARSET_RANGE_TABLE_END(range_table, count) \
((range_table) + (count) * 2 * 3)
-
-/* Test if C is in RANGE_TABLE. A flag NOT is negated if C is in.
- COUNT is number of ranges in RANGE_TABLE. */
-#define CHARSET_LOOKUP_RANGE_TABLE_RAW(not, c, range_table, count) \
- do \
- { \
- re_wchar_t range_start, range_end; \
- re_char *rtp; \
- re_char *range_table_end \
- = CHARSET_RANGE_TABLE_END ((range_table), (count)); \
- \
- for (rtp = (range_table); rtp < range_table_end; rtp += 2 * 3) \
- { \
- EXTRACT_CHARACTER (range_start, rtp); \
- EXTRACT_CHARACTER (range_end, rtp + 3); \
- \
- if (range_start <= (c) && (c) <= range_end) \
- { \
- (not) = !(not); \
- break; \
- } \
- } \
- } \
- while (0)
-
-/* Test if C is in range table of CHARSET. The flag NOT is negated if
- C is listed in it. */
-#define CHARSET_LOOKUP_RANGE_TABLE(not, c, charset) \
- do \
- { \
- /* Number of ranges in range table. */ \
- int count; \
- re_char *range_table = CHARSET_RANGE_TABLE (charset); \
- \
- EXTRACT_NUMBER_AND_INCR (count, range_table); \
- CHARSET_LOOKUP_RANGE_TABLE_RAW ((not), (c), range_table, count); \
- } \
- while (0)
/* If DEBUG is defined, Regex prints many voluminous messages about what
it is doing (if the variable `debug' is nonzero). If linked with the
@@ -1093,18 +1039,10 @@ print_partial_compiled_pattern (re_char *start, re_char *end)
break;
# ifdef emacs
- case before_dot:
- fprintf (stderr, "/before_dot");
- break;
-
case at_dot:
fprintf (stderr, "/at_dot");
break;
- case after_dot:
- fprintf (stderr, "/after_dot");
- break;
-
case categoryspec:
fprintf (stderr, "/categoryspec");
mcnt = *p++;
@@ -1158,7 +1096,9 @@ print_compiled_pattern (struct re_pattern_buffer *bufp)
printf ("no_sub: %d\t", bufp->no_sub);
printf ("not_bol: %d\t", bufp->not_bol);
printf ("not_eol: %d\t", bufp->not_eol);
+#ifndef emacs
printf ("syntax: %lx\n", bufp->syntax);
+#endif
fflush (stdout);
/* Perhaps we should print the translate table? */
}
@@ -1199,13 +1139,8 @@ print_double_string (re_char *where, re_char *string1, ssize_t size1,
#endif /* not DEBUG */
-/* Use this to suppress gcc's `...may be used before initialized' warnings. */
-#ifdef lint
-# define IF_LINT(Code) Code
-#else
-# define IF_LINT(Code) /* empty */
-#endif
-
+#ifndef emacs
+
/* Set by `re_set_syntax' to the current regexp syntax to recognize. Can
also be assigned to arbitrarily: each pattern buffer stores its own
syntax, so it can be changed between regex compilations. */
@@ -1231,15 +1166,7 @@ re_set_syntax (reg_syntax_t syntax)
}
WEAK_ALIAS (__re_set_syntax, re_set_syntax)
-/* Regexp to use to replace spaces, or NULL meaning don't. */
-static const_re_char *whitespace_regexp;
-
-void
-re_set_whitespace_regexp (const char *regexp)
-{
- whitespace_regexp = (const_re_char *) regexp;
-}
-WEAK_ALIAS (__re_set_syntax, re_set_syntax)
+#endif
/* This table gives an error message for each of the error codes listed
in regex.h. Obviously the order here has to be same as there.
@@ -1621,7 +1548,12 @@ do { \
/* Subroutine declarations and macros for regex_compile. */
static reg_errcode_t regex_compile (re_char *pattern, size_t size,
+#ifdef emacs
+ bool posix_backtracking,
+ const char *whitespace_regexp,
+#else
reg_syntax_t syntax,
+#endif
struct re_pattern_buffer *bufp);
static void store_op1 (re_opcode_t op, unsigned char *loc, int arg);
static void store_op2 (re_opcode_t op, unsigned char *loc, int arg1, int arg2);
@@ -2016,29 +1948,96 @@ struct range_table_work_area
#if ! WIDE_CHAR_SUPPORT
-/* Map a string to the char class it names (if any). */
+/* Parse a character class, i.e. string such as "[:name:]". *strp
+ points to the string to be parsed and limit is length, in bytes, of
+ that string.
+
+ If *strp point to a string that begins with "[:name:]", where name is
+ a non-empty sequence of lower case letters, *strp will be advanced past the
+ closing square bracket and RECC_* constant which maps to the name will be
+ returned. If name is not a valid character class name zero, or RECC_ERROR,
+ is returned.
+
+ Otherwise, if *strp doesn’t begin with "[:name:]", -1 is returned.
+
+ The function can be used on ASCII and multibyte (UTF-8-encoded) strings.
+ */
re_wctype_t
-re_wctype (const_re_char *str)
+re_wctype_parse (const unsigned char **strp, unsigned limit)
{
- const char *string = (const char *) str;
- if (STREQ (string, "alnum")) return RECC_ALNUM;
- else if (STREQ (string, "alpha")) return RECC_ALPHA;
- else if (STREQ (string, "word")) return RECC_WORD;
- else if (STREQ (string, "ascii")) return RECC_ASCII;
- else if (STREQ (string, "nonascii")) return RECC_NONASCII;
- else if (STREQ (string, "graph")) return RECC_GRAPH;
- else if (STREQ (string, "lower")) return RECC_LOWER;
- else if (STREQ (string, "print")) return RECC_PRINT;
- else if (STREQ (string, "punct")) return RECC_PUNCT;
- else if (STREQ (string, "space")) return RECC_SPACE;
- else if (STREQ (string, "upper")) return RECC_UPPER;
- else if (STREQ (string, "unibyte")) return RECC_UNIBYTE;
- else if (STREQ (string, "multibyte")) return RECC_MULTIBYTE;
- else if (STREQ (string, "digit")) return RECC_DIGIT;
- else if (STREQ (string, "xdigit")) return RECC_XDIGIT;
- else if (STREQ (string, "cntrl")) return RECC_CNTRL;
- else if (STREQ (string, "blank")) return RECC_BLANK;
- else return 0;
+ const char *beg = (const char *)*strp, *it;
+
+ if (limit < 4 || beg[0] != '[' || beg[1] != ':')
+ return -1;
+
+ beg += 2; /* skip opening ‘[:’ */
+ limit -= 3; /* opening ‘[:’ and half of closing ‘:]’; --limit handles rest */
+ for (it = beg; it[0] != ':' || it[1] != ']'; ++it)
+ if (!--limit)
+ return -1;
+
+ *strp = (const unsigned char *)(it + 2);
+
+ /* Sort tests in the length=five case by frequency the classes to minimize
+ number of times we fail the comparison. The frequencies of character class
+ names used in Emacs sources as of 2016-07-27:
+
+ $ find \( -name \*.c -o -name \*.el \) -exec grep -h '\[:[a-z]*:]' {} + |
+ sed 's/]/]\n/g' |grep -o '\[:[a-z]*:]' |sort |uniq -c |sort -nr
+ 213 [:alnum:]
+ 104 [:alpha:]
+ 62 [:space:]
+ 39 [:digit:]
+ 36 [:blank:]
+ 26 [:word:]
+ 26 [:upper:]
+ 21 [:lower:]
+ 10 [:xdigit:]
+ 10 [:punct:]
+ 10 [:ascii:]
+ 4 [:nonascii:]
+ 4 [:graph:]
+ 2 [:print:]
+ 2 [:cntrl:]
+ 1 [:ff:]
+
+ If you update this list, consider also updating chain of or’ed conditions
+ in execute_charset function.
+ */
+
+ switch (it - beg) {
+ case 4:
+ if (!memcmp (beg, "word", 4)) return RECC_WORD;
+ break;
+ case 5:
+ if (!memcmp (beg, "alnum", 5)) return RECC_ALNUM;
+ if (!memcmp (beg, "alpha", 5)) return RECC_ALPHA;
+ if (!memcmp (beg, "space", 5)) return RECC_SPACE;
+ if (!memcmp (beg, "digit", 5)) return RECC_DIGIT;
+ if (!memcmp (beg, "blank", 5)) return RECC_BLANK;
+ if (!memcmp (beg, "upper", 5)) return RECC_UPPER;
+ if (!memcmp (beg, "lower", 5)) return RECC_LOWER;
+ if (!memcmp (beg, "punct", 5)) return RECC_PUNCT;
+ if (!memcmp (beg, "ascii", 5)) return RECC_ASCII;
+ if (!memcmp (beg, "graph", 5)) return RECC_GRAPH;
+ if (!memcmp (beg, "print", 5)) return RECC_PRINT;
+ if (!memcmp (beg, "cntrl", 5)) return RECC_CNTRL;
+ break;
+ case 6:
+ if (!memcmp (beg, "xdigit", 6)) return RECC_XDIGIT;
+ break;
+ case 7:
+ if (!memcmp (beg, "unibyte", 7)) return RECC_UNIBYTE;
+ break;
+ case 8:
+ if (!memcmp (beg, "nonascii", 8)) return RECC_NONASCII;
+ break;
+ case 9:
+ if (!memcmp (beg, "multibyte", 9)) return RECC_MULTIBYTE;
+ break;
+ }
+
+ return RECC_ERROR;
}
/* True if CH is in the char class CC. */
@@ -2384,6 +2383,9 @@ static boolean group_in_compile_stack (compile_stack_type compile_stack,
/* `regex_compile' compiles PATTERN (of length SIZE) according to SYNTAX.
Returns one of error codes defined in `regex.h', or zero for success.
+ If WHITESPACE_REGEXP is given (only #ifdef emacs), it is used instead of
+ a space character in PATTERN.
+
Assumes the `allocated' (and perhaps `buffer') and `translate'
fields are set in BUFP on entry.
@@ -2416,7 +2418,15 @@ do { \
} while (0)
static reg_errcode_t
-regex_compile (const_re_char *pattern, size_t size, reg_syntax_t syntax,
+regex_compile (const_re_char *pattern, size_t size,
+#ifdef emacs
+# define syntax RE_SYNTAX_EMACS
+ bool posix_backtracking,
+ const char *whitespace_regexp,
+#else
+ reg_syntax_t syntax,
+# define posix_backtracking (!(syntax & RE_NO_POSIX_BACKTRACKING))
+#endif
struct re_pattern_buffer *bufp)
{
/* We fetch characters from PATTERN here. */
@@ -2469,14 +2479,16 @@ regex_compile (const_re_char *pattern, size_t size, reg_syntax_t syntax,
/* If the object matched can contain multibyte characters. */
const boolean multibyte = RE_MULTIBYTE_P (bufp);
+#ifdef emacs
/* Nonzero if we have pushed down into a subpattern. */
int in_subpattern = 0;
/* These hold the values of p, pattern, and pend from the main
pattern when we have pushed into a subpattern. */
- re_char *main_p IF_LINT (= NULL);
- re_char *main_pattern IF_LINT (= NULL);
- re_char *main_pend IF_LINT (= NULL);
+ re_char *main_p;
+ re_char *main_pattern;
+ re_char *main_pend;
+#endif
#ifdef DEBUG
debug++;
@@ -2503,7 +2515,9 @@ regex_compile (const_re_char *pattern, size_t size, reg_syntax_t syntax,
range_table_work.allocated = 0;
/* Initialize the pattern buffer. */
+#ifndef emacs
bufp->syntax = syntax;
+#endif
bufp->fastmap_accurate = 0;
bufp->not_bol = bufp->not_eol = 0;
bufp->used_syntax = 0;
@@ -2545,6 +2559,7 @@ regex_compile (const_re_char *pattern, size_t size, reg_syntax_t syntax,
{
if (p == pend)
{
+#ifdef emacs
/* If this is the end of an included regexp,
pop back to the main regexp and try again. */
if (in_subpattern)
@@ -2555,6 +2570,7 @@ regex_compile (const_re_char *pattern, size_t size, reg_syntax_t syntax,
pend = main_pend;
continue;
}
+#endif
/* If this is the end of the main regexp, we are done. */
break;
}
@@ -2563,6 +2579,7 @@ regex_compile (const_re_char *pattern, size_t size, reg_syntax_t syntax,
switch (c)
{
+#ifdef emacs
case ' ':
{
re_char *p1 = p;
@@ -2591,10 +2608,11 @@ regex_compile (const_re_char *pattern, size_t size, reg_syntax_t syntax,
main_p = p1;
main_pend = pend;
main_pattern = pattern;
- p = pattern = whitespace_regexp;
- pend = p + strlen ((const char *) p);
+ p = pattern = (re_char *) whitespace_regexp;
+ pend = p + strlen (whitespace_regexp);
break;
}
+#endif
case '^':
{
@@ -2823,10 +2841,69 @@ regex_compile (const_re_char *pattern, size_t size, reg_syntax_t syntax,
{
boolean escaped_char = false;
const unsigned char *p2 = p;
+ re_wctype_t cc;
re_wchar_t ch;
if (p == pend) FREE_STACK_RETURN (REG_EBRACK);
+ /* See if we're at the beginning of a possible character
+ class. */
+ if (syntax & RE_CHAR_CLASSES &&
+ (cc = re_wctype_parse(&p, pend - p)) != -1)
+ {
+ if (cc == 0)
+ FREE_STACK_RETURN (REG_ECTYPE);
+
+ if (p == pend)
+ FREE_STACK_RETURN (REG_EBRACK);
+
+#ifndef emacs
+ for (ch = 0; ch < (1 << BYTEWIDTH); ++ch)
+ if (re_iswctype (btowc (ch), cc))
+ {
+ c = TRANSLATE (ch);
+ if (c < (1 << BYTEWIDTH))
+ SET_LIST_BIT (c);
+ }
+#else /* emacs */
+ /* Most character classes in a multibyte match just set
+ a flag. Exceptions are is_blank, is_digit, is_cntrl, and
+ is_xdigit, since they can only match ASCII characters.
+ We don't need to handle them for multibyte. */
+
+ /* Setup the gl_state object to its buffer-defined value.
+ This hardcodes the buffer-global syntax-table for ASCII
+ chars, while the other chars will obey syntax-table
+ properties. It's not ideal, but it's the way it's been
+ done until now. */
+ SETUP_BUFFER_SYNTAX_TABLE ();
+
+ for (c = 0; c < 0x80; ++c)
+ if (re_iswctype (c, cc))
+ {
+ SET_LIST_BIT (c);
+ c1 = TRANSLATE (c);
+ if (c1 == c)
+ continue;
+ if (ASCII_CHAR_P (c1))
+ SET_LIST_BIT (c1);
+ else if ((c1 = RE_CHAR_TO_UNIBYTE (c1)) >= 0)
+ SET_LIST_BIT (c1);
+ }
+ SET_RANGE_TABLE_WORK_AREA_BIT
+ (range_table_work, re_wctype_to_bit (cc));
+#endif /* emacs */
+ /* In most cases the matching rule for char classes only
+ uses the syntax table for multibyte chars, so that the
+ content of the syntax-table is not hardcoded in the
+ range_table. SPACE and WORD are the two exceptions. */
+ if ((1 << cc) & ((1 << RECC_SPACE) | (1 << RECC_WORD)))
+ bufp->used_syntax = 1;
+
+ /* Repeat the loop. */
+ continue;
+ }
+
/* Don't translate yet. The range TRANSLATE(X..Y) cannot
always be determined from TRANSLATE(X) and TRANSLATE(Y)
So the translation is done later in a loop. Example:
@@ -2850,119 +2927,6 @@ regex_compile (const_re_char *pattern, size_t size, reg_syntax_t syntax,
break;
}
- /* See if we're at the beginning of a possible character
- class. */
-
- if (!escaped_char &&
- syntax & RE_CHAR_CLASSES && c == '[' && *p == ':')
- {
- /* Leave room for the null. */
- unsigned char str[CHAR_CLASS_MAX_LENGTH + 1];
- const unsigned char *class_beg;
-
- PATFETCH (c);
- c1 = 0;
- class_beg = p;
-
- /* If pattern is `[[:'. */
- if (p == pend) FREE_STACK_RETURN (REG_EBRACK);
-
- for (;;)
- {
- PATFETCH (c);
- if ((c == ':' && *p == ']') || p == pend)
- break;
- if (c1 < CHAR_CLASS_MAX_LENGTH)
- str[c1++] = c;
- else
- /* This is in any case an invalid class name. */
- str[0] = '\0';
- }
- str[c1] = '\0';
-
- /* If isn't a word bracketed by `[:' and `:]':
- undo the ending character, the letters, and
- leave the leading `:' and `[' (but set bits for
- them). */
- if (c == ':' && *p == ']')
- {
- re_wctype_t cc = re_wctype (str);
-
- if (cc == 0)
- FREE_STACK_RETURN (REG_ECTYPE);
-
- /* Throw away the ] at the end of the character
- class. */
- PATFETCH (c);
-
- if (p == pend) FREE_STACK_RETURN (REG_EBRACK);
-
-#ifndef emacs
- for (ch = 0; ch < (1 << BYTEWIDTH); ++ch)
- if (re_iswctype (btowc (ch), cc))
- {
- c = TRANSLATE (ch);
- if (c < (1 << BYTEWIDTH))
- SET_LIST_BIT (c);
- }
-#else /* emacs */
- /* Most character classes in a multibyte match
- just set a flag. Exceptions are is_blank,
- is_digit, is_cntrl, and is_xdigit, since
- they can only match ASCII characters. We
- don't need to handle them for multibyte.
- They are distinguished by a negative wctype. */
-
- /* Setup the gl_state object to its buffer-defined
- value. This hardcodes the buffer-global
- syntax-table for ASCII chars, while the other chars
- will obey syntax-table properties. It's not ideal,
- but it's the way it's been done until now. */
- SETUP_BUFFER_SYNTAX_TABLE ();
-
- for (ch = 0; ch < 256; ++ch)
- {
- c = RE_CHAR_TO_MULTIBYTE (ch);
- if (! CHAR_BYTE8_P (c)
- && re_iswctype (c, cc))
- {
- SET_LIST_BIT (ch);
- c1 = TRANSLATE (c);
- if (c1 == c)
- continue;
- if (ASCII_CHAR_P (c1))
- SET_LIST_BIT (c1);
- else if ((c1 = RE_CHAR_TO_UNIBYTE (c1)) >= 0)
- SET_LIST_BIT (c1);
- }
- }
- SET_RANGE_TABLE_WORK_AREA_BIT
- (range_table_work, re_wctype_to_bit (cc));
-#endif /* emacs */
- /* In most cases the matching rule for char classes
- only uses the syntax table for multibyte chars,
- so that the content of the syntax-table is not
- hardcoded in the range_table. SPACE and WORD are
- the two exceptions. */
- if ((1 << cc) & ((1 << RECC_SPACE) | (1 << RECC_WORD)))
- bufp->used_syntax = 1;
-
- /* Repeat the loop. */
- continue;
- }
- else
- {
- /* Go back to right after the "[:". */
- p = class_beg;
- SET_LIST_BIT ('[');
-
- /* Because the `:' may start the range, we
- can't simply set bit and repeat the loop.
- Instead, just set it to C and handle below. */
- c = ':';
- }
- }
-
if (p < pend && p[0] == '-' && p[1] != ']')
{
@@ -3469,8 +3433,6 @@ regex_compile (const_re_char *pattern, size_t size, reg_syntax_t syntax,
goto normal_char;
#ifdef emacs
- /* There is no way to specify the before_dot and after_dot
- operators. rms says this is ok. --karl */
case '=':
laststart = b;
BUF_PUSH (at_dot);
@@ -3677,7 +3639,7 @@ regex_compile (const_re_char *pattern, size_t size, reg_syntax_t syntax,
/* If we don't want backtracking, force success
the first time we reach the end of the compiled pattern. */
- if (syntax & RE_NO_POSIX_BACKTRACKING)
+ if (!posix_backtracking)
BUF_PUSH (succeed);
/* We have succeeded; set the length of the buffer. */
@@ -3712,6 +3674,12 @@ regex_compile (const_re_char *pattern, size_t size, reg_syntax_t syntax,
#endif /* not MATCH_MAY_ALLOCATE */
FREE_STACK_RETURN (REG_NOERROR);
+
+#ifdef emacs
+# undef syntax
+#else
+# undef posix_backtracking
+#endif
} /* regex_compile */
/* Subroutines for `regex_compile'. */
@@ -4047,9 +4015,7 @@ analyze_first (const_re_char *p, const_re_char *pend, char *fastmap,
/* All cases after this match the empty string. These end with
`continue'. */
- case before_dot:
case at_dot:
- case after_dot:
#endif /* !emacs */
case no_op:
case begline:
@@ -4670,6 +4636,73 @@ skip_noops (const_re_char *p, const_re_char *pend)
return p;
}
+/* Test if C matches charset op. *PP points to the charset or charset_not
+ opcode. When the function finishes, *PP will be advanced past that opcode.
+ C is character to test (possibly after translations) and CORIG is original
+ character (i.e. without any translations). UNIBYTE denotes whether c is
+ unibyte or multibyte character. */
+static bool
+execute_charset (const_re_char **pp, unsigned c, unsigned corig, bool unibyte)
+{
+ re_char *p = *pp, *rtp = NULL;
+ bool not = (re_opcode_t) *p == charset_not;
+
+ if (CHARSET_RANGE_TABLE_EXISTS_P (p))
+ {
+ int count;
+ rtp = CHARSET_RANGE_TABLE (p);
+ EXTRACT_NUMBER_AND_INCR (count, rtp);
+ *pp = CHARSET_RANGE_TABLE_END ((rtp), (count));
+ }
+ else
+ *pp += 2 + CHARSET_BITMAP_SIZE (p);
+
+ if (unibyte && c < (1 << BYTEWIDTH))
+ { /* Lookup bitmap. */
+ /* Cast to `unsigned' instead of `unsigned char' in
+ case the bit list is a full 32 bytes long. */
+ if (c < (unsigned) (CHARSET_BITMAP_SIZE (p) * BYTEWIDTH)
+ && p[2 + c / BYTEWIDTH] & (1 << (c % BYTEWIDTH)))
+ return !not;
+ }
+#ifdef emacs
+ else if (rtp)
+ {
+ int class_bits = CHARSET_RANGE_TABLE_BITS (p);
+ re_wchar_t range_start, range_end;
+
+ /* Sort tests by the most commonly used classes with some adjustment to which
+ tests are easiest to perform. Take a look at comment in re_wctype_parse
+ for table with frequencies of character class names. */
+
+ if ((class_bits & BIT_MULTIBYTE) ||
+ (class_bits & BIT_ALNUM && ISALNUM (c)) ||
+ (class_bits & BIT_ALPHA && ISALPHA (c)) ||
+ (class_bits & BIT_SPACE && ISSPACE (c)) ||
+ (class_bits & BIT_WORD && ISWORD (c)) ||
+ ((class_bits & BIT_UPPER) &&
+ (ISUPPER (c) || (corig != c &&
+ c == downcase (corig) && ISLOWER (c)))) ||
+ ((class_bits & BIT_LOWER) &&
+ (ISLOWER (c) || (corig != c &&
+ c == upcase (corig) && ISUPPER(c)))) ||
+ (class_bits & BIT_PUNCT && ISPUNCT (c)) ||
+ (class_bits & BIT_GRAPH && ISGRAPH (c)) ||
+ (class_bits & BIT_PRINT && ISPRINT (c)))
+ return !not;
+
+ for (p = *pp; rtp < p; rtp += 2 * 3)
+ {
+ EXTRACT_CHARACTER (range_start, rtp);
+ EXTRACT_CHARACTER (range_end, rtp + 3);
+ if (range_start <= c && c <= range_end)
+ return !not;
+ }
+ }
+#endif /* emacs */
+ return not;
+}
+
/* Non-zero if "p1 matches something" implies "p2 fails". */
static int
mutually_exclusive_p (struct re_pattern_buffer *bufp, const_re_char *p1,
@@ -4727,22 +4760,7 @@ mutually_exclusive_p (struct re_pattern_buffer *bufp, const_re_char *p1,
else if ((re_opcode_t) *p1 == charset
|| (re_opcode_t) *p1 == charset_not)
{
- int not = (re_opcode_t) *p1 == charset_not;
-
- /* Test if C is listed in charset (or charset_not)
- at `p1'. */
- if (! multibyte || IS_REAL_ASCII (c))
- {
- if (c < CHARSET_BITMAP_SIZE (p1) * BYTEWIDTH
- && p1[2 + c / BYTEWIDTH] & (1 << (c % BYTEWIDTH)))
- not = !not;
- }
- else if (CHARSET_RANGE_TABLE_EXISTS_P (p1))
- CHARSET_LOOKUP_RANGE_TABLE (not, c, p1);
-
- /* `not' is equal to 1 if c would match, which means
- that we can't change to pop_failure_jump. */
- if (!not)
+ if (!execute_charset (&p1, c, c, !multibyte || IS_REAL_ASCII (c)))
{
DEBUG_PRINT (" No match => fast loop.\n");
return 1;
@@ -5142,8 +5160,6 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
if (p == pend)
{
- ptrdiff_t dcnt;
-
/* End of pattern means we might have succeeded. */
DEBUG_PRINT ("end of pattern ... ");
@@ -5151,19 +5167,22 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
longest match, try backtracking. */
if (d != end_match_2)
{
- /* 1 if this match ends in the same string (string1 or string2)
- as the best previous match. */
- boolean same_str_p = (FIRST_STRING_P (match_end)
- == FIRST_STRING_P (d));
- /* 1 if this match is the best seen so far. */
- boolean best_match_p;
-
- /* AIX compiler got confused when this was combined
- with the previous declaration. */
- if (same_str_p)
- best_match_p = d > match_end;
- else
- best_match_p = !FIRST_STRING_P (d);
+ /* True if this match is the best seen so far. */
+ bool best_match_p;
+
+ {
+ /* True if this match ends in the same string (string1
+ or string2) as the best previous match. */
+ bool same_str_p = (FIRST_STRING_P (match_end)
+ == FIRST_STRING_P (d));
+
+ /* AIX compiler got confused when this was combined
+ with the previous declaration. */
+ if (same_str_p)
+ best_match_p = d > match_end;
+ else
+ best_match_p = !FIRST_STRING_P (d);
+ }
DEBUG_PRINT ("backtracking.\n");
@@ -5292,7 +5311,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
nfailure_points_pushed - nfailure_points_popped);
DEBUG_PRINT ("%u registers pushed.\n", num_regs_pushed);
- dcnt = POINTER_TO_OFFSET (d) - pos;
+ ptrdiff_t dcnt = POINTER_TO_OFFSET (d) - pos;
DEBUG_PRINT ("Returning %td from re_match_2.\n", dcnt);
@@ -5423,6 +5442,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
{
int buf_charlen;
re_wchar_t buf_ch;
+ reg_syntax_t syntax;
DEBUG_PRINT ("EXECUTING anychar.\n");
@@ -5431,10 +5451,14 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
target_multibyte);
buf_ch = TRANSLATE (buf_ch);
- if ((!(bufp->syntax & RE_DOT_NEWLINE)
- && buf_ch == '\n')
- || ((bufp->syntax & RE_DOT_NOT_NULL)
- && buf_ch == '\000'))
+#ifdef emacs
+ syntax = RE_SYNTAX_EMACS;
+#else
+ syntax = bufp->syntax;
+#endif
+
+ if ((!(syntax & RE_DOT_NEWLINE) && buf_ch == '\n')
+ || ((syntax & RE_DOT_NOT_NULL) && buf_ch == '\000'))
goto fail;
DEBUG_PRINT (" Matched \"%d\".\n", *d);
@@ -5447,32 +5471,13 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
case charset_not:
{
register unsigned int c, corig;
- boolean not = (re_opcode_t) *(p - 1) == charset_not;
int len;
- /* Start of actual range_table, or end of bitmap if there is no
- range table. */
- re_char *range_table IF_LINT (= NULL);
-
- /* Nonzero if there is a range table. */
- int range_table_exists;
-
- /* Number of ranges of range table. This is not included
- in the initial byte-length of the command. */
- int count = 0;
-
/* Whether matching against a unibyte character. */
boolean unibyte_char = false;
- DEBUG_PRINT ("EXECUTING charset%s.\n", not ? "_not" : "");
-
- range_table_exists = CHARSET_RANGE_TABLE_EXISTS_P (&p[-1]);
-
- if (range_table_exists)
- {
- range_table = CHARSET_RANGE_TABLE (&p[-1]); /* Past the bitmap. */
- EXTRACT_NUMBER_AND_INCR (count, range_table);
- }
+ DEBUG_PRINT ("EXECUTING charset%s.\n",
+ (re_opcode_t) *(p - 1) == charset_not ? "_not" : "");
PREFETCH ();
corig = c = RE_STRING_CHAR_AND_LENGTH (d, len, target_multibyte);
@@ -5506,47 +5511,9 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
unibyte_char = true;
}
- if (unibyte_char && c < (1 << BYTEWIDTH))
- { /* Lookup bitmap. */
- /* Cast to `unsigned' instead of `unsigned char' in
- case the bit list is a full 32 bytes long. */
- if (c < (unsigned) (CHARSET_BITMAP_SIZE (&p[-1]) * BYTEWIDTH)
- && p[1 + c / BYTEWIDTH] & (1 << (c % BYTEWIDTH)))
- not = !not;
- }
-#ifdef emacs
- else if (range_table_exists)
- {
- int class_bits = CHARSET_RANGE_TABLE_BITS (&p[-1]);
-
- if ( (class_bits & BIT_LOWER
- && (ISLOWER (c)
- || (corig != c
- && c == upcase (corig) && ISUPPER(c))))
- | (class_bits & BIT_MULTIBYTE)
- | (class_bits & BIT_PUNCT && ISPUNCT (c))
- | (class_bits & BIT_SPACE && ISSPACE (c))
- | (class_bits & BIT_UPPER
- && (ISUPPER (c)
- || (corig != c
- && c == downcase (corig) && ISLOWER (c))))
- | (class_bits & BIT_WORD && ISWORD (c))
- | (class_bits & BIT_ALPHA && ISALPHA (c))
- | (class_bits & BIT_ALNUM && ISALNUM (c))
- | (class_bits & BIT_GRAPH && ISGRAPH (c))
- | (class_bits & BIT_PRINT && ISPRINT (c)))
- not = !not;
- else
- CHARSET_LOOKUP_RANGE_TABLE_RAW (not, c, range_table, count);
- }
-#endif /* emacs */
-
- if (range_table_exists)
- p = CHARSET_RANGE_TABLE_END (range_table, count);
- else
- p += CHARSET_BITMAP_SIZE (&p[-1]) + 1;
-
- if (!not) goto fail;
+ p -= 1;
+ if (!execute_charset (&p, c, corig, unibyte_char))
+ goto fail;
d += len;
}
@@ -6181,24 +6148,12 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
break;
#ifdef emacs
- case before_dot:
- DEBUG_PRINT ("EXECUTING before_dot.\n");
- if (PTR_BYTE_POS (d) >= PT_BYTE)
- goto fail;
- break;
-
case at_dot:
DEBUG_PRINT ("EXECUTING at_dot.\n");
if (PTR_BYTE_POS (d) != PT_BYTE)
goto fail;
break;
- case after_dot:
- DEBUG_PRINT ("EXECUTING after_dot.\n");
- if (PTR_BYTE_POS (d) <= PT_BYTE)
- goto fail;
- break;
-
case categoryspec:
case notcategoryspec:
{
@@ -6330,6 +6285,9 @@ bcmp_translate (const_re_char *s1, const_re_char *s2, register ssize_t len,
const char *
re_compile_pattern (const char *pattern, size_t length,
+#ifdef emacs
+ bool posix_backtracking, const char *whitespace_regexp,
+#endif
struct re_pattern_buffer *bufp)
{
reg_errcode_t ret;
@@ -6343,7 +6301,14 @@ re_compile_pattern (const char *pattern, size_t length,
setting no_sub. */
bufp->no_sub = 0;
- ret = regex_compile ((re_char*) pattern, length, re_syntax_options, bufp);
+ ret = regex_compile ((re_char*) pattern, length,
+#ifdef emacs
+ posix_backtracking,
+ whitespace_regexp,
+#else
+ re_syntax_options,
+#endif
+ bufp);
if (!ret)
return NULL;
diff --git a/src/regex.h b/src/regex.h
index 51f4424ce94..4922440e472 100644
--- a/src/regex.h
+++ b/src/regex.h
@@ -20,6 +20,13 @@
#ifndef _REGEX_H
#define _REGEX_H 1
+#if defined emacs && (defined _REGEX_RE_COMP || defined _LIBC)
+/* We’re not defining re_set_syntax and using a different prototype of
+ re_compile_pattern when building Emacs so fail compilation early with
+ a (somewhat helpful) error message when conflict is detected. */
+# error "_REGEX_RE_COMP nor _LIBC can be defined if emacs is defined."
+#endif
+
/* Allow the use in C++ code. */
#ifdef __cplusplus
extern "C" {
@@ -351,9 +358,10 @@ struct re_pattern_buffer
/* Number of bytes actually used in `buffer'. */
size_t used;
+#ifndef emacs
/* Syntax setting with which the pattern was compiled. */
reg_syntax_t syntax;
-
+#endif
/* Pointer to a fastmap, if any, otherwise zero. re_search uses
the fastmap, if there is one, to skip over impossible
starting points for matches. */
@@ -457,14 +465,22 @@ typedef struct
/* Declarations for routines. */
+#ifndef emacs
+
/* Sets the current default syntax to SYNTAX, and return the old syntax.
You can also simply assign to the `re_syntax_options' variable. */
extern reg_syntax_t re_set_syntax (reg_syntax_t __syntax);
+#endif
+
/* Compile the regular expression PATTERN, with length LENGTH
and syntax given by the global `re_syntax_options', into the buffer
BUFFER. Return NULL if successful, and an error string if not. */
extern const char *re_compile_pattern (const char *__pattern, size_t __length,
+#ifdef emacs
+ bool posix_backtracking,
+ const char *whitespace_regexp,
+#endif
struct re_pattern_buffer *__buffer);
@@ -589,25 +605,13 @@ extern void regfree (regex_t *__preg);
/* Solaris 2.5 has a bug: <wchar.h> must be included before <wctype.h>. */
# include <wchar.h>
# include <wctype.h>
-#endif
-#if WIDE_CHAR_SUPPORT
-/* The GNU C library provides support for user-defined character classes
- and the functions from ISO C amendment 1. */
-# ifdef CHARCLASS_NAME_MAX
-# define CHAR_CLASS_MAX_LENGTH CHARCLASS_NAME_MAX
-# else
-/* This shouldn't happen but some implementation might still have this
- problem. Use a reasonable default value. */
-# define CHAR_CLASS_MAX_LENGTH 256
-# endif
typedef wctype_t re_wctype_t;
typedef wchar_t re_wchar_t;
# define re_wctype wctype
# define re_iswctype iswctype
# define re_wctype_to_bit(cc) 0
#else
-# define CHAR_CLASS_MAX_LENGTH 9 /* Namely, `multibyte'. */
# ifndef emacs
# define btowc(c) c
# endif
@@ -625,12 +629,10 @@ typedef enum { RECC_ERROR = 0,
} re_wctype_t;
extern char re_iswctype (int ch, re_wctype_t cc);
-extern re_wctype_t re_wctype (const unsigned char* str);
+extern re_wctype_t re_wctype_parse (const unsigned char **strp, unsigned limit);
typedef int re_wchar_t;
-extern void re_set_whitespace_regexp (const char *regexp);
-
#endif /* not WIDE_CHAR_SUPPORT */
#endif /* regex.h */
diff --git a/src/search.c b/src/search.c
index 9f55d728362..e597c33a0fb 100644
--- a/src/search.c
+++ b/src/search.c
@@ -113,8 +113,8 @@ static void
compile_pattern_1 (struct regexp_cache *cp, Lisp_Object pattern,
Lisp_Object translate, bool posix)
{
+ const char *whitespace_regexp;
char *val;
- reg_syntax_t old;
cp->regexp = Qnil;
cp->buf.translate = (! NILP (translate) ? translate : make_number (0));
@@ -131,24 +131,17 @@ compile_pattern_1 (struct regexp_cache *cp, Lisp_Object pattern,
Using BLOCK_INPUT here means the debugger won't run if an error occurs.
So let's turn it off. */
/* BLOCK_INPUT; */
- old = re_set_syntax (RE_SYNTAX_EMACS
- | (posix ? 0 : RE_NO_POSIX_BACKTRACKING));
- if (STRINGP (Vsearch_spaces_regexp))
- re_set_whitespace_regexp (SSDATA (Vsearch_spaces_regexp));
- else
- re_set_whitespace_regexp (NULL);
+ whitespace_regexp = STRINGP (Vsearch_spaces_regexp) ?
+ SSDATA (Vsearch_spaces_regexp) : NULL;
- val = (char *) re_compile_pattern (SSDATA (pattern),
- SBYTES (pattern), &cp->buf);
+ val = (char *) re_compile_pattern (SSDATA (pattern), SBYTES (pattern),
+ posix, whitespace_regexp, &cp->buf);
/* If the compiled pattern hard codes some of the contents of the
syntax-table, it can only be reused with *this* syntax table. */
cp->syntax_table = cp->buf.used_syntax ? BVAR (current_buffer, syntax_table) : Qt;
- re_set_whitespace_regexp (NULL);
-
- re_set_syntax (old);
/* unblock_input (); */
if (val)
xsignal1 (Qinvalid_regexp, build_string (val));
@@ -2789,7 +2782,8 @@ since only regular expressions have distinguished subexpressions. */)
if (case_action == all_caps)
Fupcase_region (make_number (search_regs.start[sub]),
- make_number (newpoint));
+ make_number (newpoint),
+ Qnil);
else if (case_action == cap_initial)
Fupcase_initials_region (make_number (search_regs.start[sub]),
make_number (newpoint));
diff --git a/src/sheap.c b/src/sheap.c
index fc53c5822d7..72b74fa355f 100644
--- a/src/sheap.c
+++ b/src/sheap.c
@@ -19,87 +19,62 @@ You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
+
+#include "sheap.h"
+
#include <stdio.h>
#include "lisp.h"
#include <unistd.h>
#include <stdlib.h> /* for exit */
-#ifdef ENABLE_CHECKING
-#define STATIC_HEAP_SIZE (28 * 1024 * 1024)
-#else
-#define STATIC_HEAP_SIZE (19 * 1024 * 1024)
-#endif
-
-int debug_sheap = 0;
-
-#define BLOCKSIZE 4096
+static int debug_sheap;
char bss_sbrk_buffer[STATIC_HEAP_SIZE];
-/* The following is needed in gmalloc.c */
-void *bss_sbrk_buffer_end = bss_sbrk_buffer + STATIC_HEAP_SIZE;
-char *bss_sbrk_ptr;
char *max_bss_sbrk_ptr;
-int bss_sbrk_did_unexec;
+bool bss_sbrk_did_unexec;
void *
bss_sbrk (ptrdiff_t request_size)
{
+ static char *bss_sbrk_ptr;
+
if (!bss_sbrk_ptr)
{
max_bss_sbrk_ptr = bss_sbrk_ptr = bss_sbrk_buffer;
#ifdef CYGWIN
- sbrk (BLOCKSIZE); /* force space for fork to work */
+ /* Force space for fork to work. */
+ sbrk (4096);
#endif
}
- if (!(int) request_size)
- {
- return (bss_sbrk_ptr);
- }
- else if (bss_sbrk_ptr + (int) request_size < bss_sbrk_buffer)
+ int used = bss_sbrk_ptr - bss_sbrk_buffer;
+
+ if (request_size < -used)
{
- printf
- ("attempt to free too much: avail %d used %d failed request %d\n",
- STATIC_HEAP_SIZE, bss_sbrk_ptr - bss_sbrk_buffer,
- (int) request_size);
+ printf (("attempt to free too much: "
+ "avail %d used %d failed request %"pD"d\n"),
+ STATIC_HEAP_SIZE, used, request_size);
exit (-1);
return 0;
}
- else if (bss_sbrk_ptr + (int) request_size >
- bss_sbrk_buffer + STATIC_HEAP_SIZE)
+ else if (STATIC_HEAP_SIZE - used < request_size)
{
- printf ("static heap exhausted: avail %d used %d failed request %d\n",
- STATIC_HEAP_SIZE,
- bss_sbrk_ptr - bss_sbrk_buffer, (int) request_size);
+ printf ("static heap exhausted: avail %d used %d failed request %"pD"d\n",
+ STATIC_HEAP_SIZE, used, request_size);
exit (-1);
return 0;
}
- else if ((int) request_size < 0)
- {
- bss_sbrk_ptr += (int) request_size;
- if (debug_sheap)
- printf ("freed size %d\n", request_size);
- return bss_sbrk_ptr;
- }
- else
+
+ void *ret = bss_sbrk_ptr;
+ bss_sbrk_ptr += request_size;
+ if (max_bss_sbrk_ptr < bss_sbrk_ptr)
+ max_bss_sbrk_ptr = bss_sbrk_ptr;
+ if (debug_sheap)
{
- char *ret = bss_sbrk_ptr;
- if (debug_sheap)
- printf ("allocated 0x%08x size %d\n", ret, request_size);
- bss_sbrk_ptr += (int) request_size;
- if (bss_sbrk_ptr > max_bss_sbrk_ptr)
- max_bss_sbrk_ptr = bss_sbrk_ptr;
- return ret;
+ if (request_size < 0)
+ printf ("freed size %"pD"d\n", request_size);
+ else
+ printf ("allocated %p size %"pD"d\n", ret, request_size);
}
-}
-
-void
-report_sheap_usage (int die_if_pure_storage_exceeded)
-{
- char buf[200];
- sprintf (buf, "Maximum static heap usage: %d of %d bytes",
- max_bss_sbrk_ptr - bss_sbrk_buffer, STATIC_HEAP_SIZE);
- /* Don't log messages, cause at this point, we're not allowed to create
- buffers. */
- message1_nolog (buf);
+ return ret;
}
diff --git a/src/sheap.h b/src/sheap.h
new file mode 100644
index 00000000000..c229a1b06ed
--- /dev/null
+++ b/src/sheap.h
@@ -0,0 +1,31 @@
+/* Static heap allocation for GNU Emacs.
+
+Copyright 2016 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 <http://www.gnu.org/licenses/>. */
+
+#include <stddef.h>
+#include "lisp.h"
+
+/* 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 };
+
+extern char bss_sbrk_buffer[STATIC_HEAP_SIZE];
+extern char *max_bss_sbrk_ptr;
+extern bool bss_sbrk_did_unexec;
+extern void *bss_sbrk (ptrdiff_t);
diff --git a/src/sound.c b/src/sound.c
index b9a794b6a42..f5f570190ca 100644
--- a/src/sound.c
+++ b/src/sound.c
@@ -310,12 +310,13 @@ sound_perror (const char *msg)
}
#endif
if (saved_errno != 0)
- error ("%s: %s", msg, strerror (saved_errno));
+ error ("%s: %s", msg, emacs_strerror (saved_errno));
else
error ("%s", msg);
}
+#ifndef WINDOWSNT
/* Display a warning message. */
static void
@@ -323,6 +324,7 @@ sound_warning (const char *msg)
{
message1 (msg);
}
+#endif /* !WINDOWSNT */
/* Parse sound specification SOUND, and fill ATTRS with what is
diff --git a/src/syntax.c b/src/syntax.c
index 6e133ad9c27..d463f7e93db 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -81,6 +81,11 @@ SYNTAX_FLAGS_COMEND_SECOND (int flags)
return (flags >> 19) & 1;
}
static bool
+SYNTAX_FLAGS_COMSTARTEND_FIRST (int flags)
+{
+ return (flags & 0x50000) != 0;
+}
+static bool
SYNTAX_FLAGS_PREFIX (int flags)
{
return (flags >> 20) & 1;
@@ -153,6 +158,10 @@ struct lisp_parse_state
ptrdiff_t comstr_start; /* Position of last comment/string starter. */
Lisp_Object levelstarts; /* Char numbers of starts-of-expression
of levels (starting from outermost). */
+ int prev_syntax; /* Syntax of previous position scanned, when
+ that position (potentially) holds the first char
+ of a 2-char construct, i.e. comment delimiter
+ or Sescape, etc. Smax otherwise. */
};
/* These variables are a cache for finding the start of a defun.
@@ -176,7 +185,8 @@ static Lisp_Object skip_syntaxes (bool, Lisp_Object, Lisp_Object);
static Lisp_Object scan_lists (EMACS_INT, EMACS_INT, EMACS_INT, bool);
static void scan_sexps_forward (struct lisp_parse_state *,
ptrdiff_t, ptrdiff_t, ptrdiff_t, EMACS_INT,
- bool, Lisp_Object, int);
+ bool, int);
+static void internalize_parse_state (Lisp_Object, struct lisp_parse_state *);
static bool in_classes (int, Lisp_Object);
static void parse_sexp_propertize (ptrdiff_t charpos);
@@ -698,7 +708,7 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
ptrdiff_t comment_end = from;
ptrdiff_t comment_end_byte = from_byte;
ptrdiff_t comstart_pos = 0;
- ptrdiff_t comstart_byte IF_LINT (= 0);
+ ptrdiff_t comstart_byte;
/* Place where the containing defun starts,
or 0 if we didn't come across it yet. */
ptrdiff_t defun_start = 0;
@@ -911,10 +921,11 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
}
do
{
+ internalize_parse_state (Qnil, &state);
scan_sexps_forward (&state,
defun_start, defun_start_byte,
comment_end, TYPE_MINIMUM (EMACS_INT),
- 0, Qnil, 0);
+ 0, 0);
defun_start = comment_end;
if (!adjusted)
{
@@ -1622,7 +1633,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
int c;
char fastmap[0400];
/* Store the ranges of non-ASCII characters. */
- int *char_ranges IF_LINT (= NULL);
+ int *char_ranges UNINIT;
int n_char_ranges = 0;
bool negate = 0;
ptrdiff_t i, i_byte;
@@ -1680,44 +1691,22 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
/* At first setup fastmap. */
while (i_byte < size_byte)
{
- c = str[i_byte++];
-
- if (handle_iso_classes && c == '['
- && i_byte < size_byte
- && str[i_byte] == ':')
+ if (handle_iso_classes)
{
- const unsigned char *class_beg = str + i_byte + 1;
- const unsigned char *class_end = class_beg;
- const unsigned char *class_limit = str + size_byte - 2;
- /* Leave room for the null. */
- unsigned char class_name[CHAR_CLASS_MAX_LENGTH + 1];
- re_wctype_t cc;
-
- if (class_limit - class_beg > CHAR_CLASS_MAX_LENGTH)
- class_limit = class_beg + CHAR_CLASS_MAX_LENGTH;
-
- while (class_end < class_limit
- && *class_end >= 'a' && *class_end <= 'z')
- class_end++;
-
- if (class_end == class_beg
- || *class_end != ':' || class_end[1] != ']')
- goto not_a_class_name;
-
- memcpy (class_name, class_beg, class_end - class_beg);
- class_name[class_end - class_beg] = 0;
-
- cc = re_wctype (class_name);
+ const unsigned char *ch = str + i_byte;
+ re_wctype_t cc = re_wctype_parse (&ch, size_byte - i_byte);
if (cc == 0)
error ("Invalid ISO C character class");
-
- iso_classes = Fcons (make_number (cc), iso_classes);
-
- i_byte = class_end + 2 - str;
- continue;
+ if (cc != -1)
+ {
+ iso_classes = Fcons (make_number (cc), iso_classes);
+ i_byte = ch - str;
+ continue;
+ }
}
- not_a_class_name:
+ c = str[i_byte++];
+
if (c == '\\')
{
if (i_byte == size_byte)
@@ -1797,54 +1786,32 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
while (i_byte < size_byte)
{
int leading_code = str[i_byte];
- c = STRING_CHAR_AND_LENGTH (str + i_byte, len);
- i_byte += len;
- if (handle_iso_classes && c == '['
- && i_byte < size_byte
- && STRING_CHAR (str + i_byte) == ':')
+ if (handle_iso_classes)
{
- const unsigned char *class_beg = str + i_byte + 1;
- const unsigned char *class_end = class_beg;
- const unsigned char *class_limit = str + size_byte - 2;
- /* Leave room for the null. */
- unsigned char class_name[CHAR_CLASS_MAX_LENGTH + 1];
- re_wctype_t cc;
-
- if (class_limit - class_beg > CHAR_CLASS_MAX_LENGTH)
- class_limit = class_beg + CHAR_CLASS_MAX_LENGTH;
-
- while (class_end < class_limit
- && *class_end >= 'a' && *class_end <= 'z')
- class_end++;
-
- if (class_end == class_beg
- || *class_end != ':' || class_end[1] != ']')
- goto not_a_class_name_multibyte;
-
- memcpy (class_name, class_beg, class_end - class_beg);
- class_name[class_end - class_beg] = 0;
-
- cc = re_wctype (class_name);
+ const unsigned char *ch = str + i_byte;
+ re_wctype_t cc = re_wctype_parse (&ch, size_byte - i_byte);
if (cc == 0)
error ("Invalid ISO C character class");
-
- iso_classes = Fcons (make_number (cc), iso_classes);
-
- i_byte = class_end + 2 - str;
- continue;
+ if (cc != -1)
+ {
+ iso_classes = Fcons (make_number (cc), iso_classes);
+ i_byte = ch - str;
+ continue;
+ }
}
- not_a_class_name_multibyte:
- if (c == '\\')
+ if (leading_code== '\\')
{
- if (i_byte == size_byte)
+ if (++i_byte == size_byte)
break;
leading_code = str[i_byte];
- c = STRING_CHAR_AND_LENGTH (str + i_byte, len);
- i_byte += len;
}
+ c = STRING_CHAR_AND_LENGTH (str + i_byte, len);
+ i_byte += len;
+
+
/* Treat `-' as range character only if another character
follows. */
if (i_byte + 1 < size_byte
@@ -2299,11 +2266,15 @@ in_classes (int c, Lisp_Object iso_classes)
PREV_SYNTAX is the SYNTAX_WITH_FLAGS of the previous character
(or 0 If the search cannot start in the middle of a two-character).
- If successful, return true and store the charpos of the comment's end
- into *CHARPOS_PTR and the corresponding bytepos into *BYTEPOS_PTR.
- Else, return false and store the charpos STOP into *CHARPOS_PTR, the
- corresponding bytepos into *BYTEPOS_PTR and the current nesting
- (as defined for state.incomment) in *INCOMMENT_PTR.
+ If successful, return true and store the charpos of the comment's
+ end into *CHARPOS_PTR and the corresponding bytepos into
+ *BYTEPOS_PTR. Else, return false and store the charpos STOP into
+ *CHARPOS_PTR, the corresponding bytepos into *BYTEPOS_PTR and the
+ current nesting (as defined for state->incomment) in
+ *INCOMMENT_PTR. Should the last character scanned in an incomplete
+ comment be a possible first character of a two character construct,
+ we store its SYNTAX_WITH_FLAGS into *last_syntax_ptr. Otherwise,
+ we store Smax into *last_syntax_ptr.
The comment end is the last character of the comment rather than the
character just after the comment.
@@ -2315,7 +2286,7 @@ static bool
forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
EMACS_INT nesting, int style, int prev_syntax,
ptrdiff_t *charpos_ptr, ptrdiff_t *bytepos_ptr,
- EMACS_INT *incomment_ptr)
+ EMACS_INT *incomment_ptr, int *last_syntax_ptr)
{
register int c, c1;
register enum syntaxcode code;
@@ -2326,7 +2297,8 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
/* Enter the loop in the middle so that we find
a 2-char comment ender if we start in the middle of it. */
syntax = prev_syntax;
- if (syntax != 0) goto forw_incomment;
+ code = syntax & 0xff;
+ if (syntax != 0 && from < stop) goto forw_incomment;
while (1)
{
@@ -2335,6 +2307,12 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
*incomment_ptr = nesting;
*charpos_ptr = from;
*bytepos_ptr = from_byte;
+ *last_syntax_ptr =
+ (code == Sescape || code == Scharquote
+ || SYNTAX_FLAGS_COMEND_FIRST (syntax)
+ || (nesting > 0
+ && SYNTAX_FLAGS_COMSTART_FIRST (syntax)))
+ ? syntax : Smax ;
return 0;
}
c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
@@ -2375,7 +2353,9 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
SYNTAX_FLAGS_COMMENT_NESTED (other_syntax))
? nesting > 0 : nesting < 0))
{
- if (--nesting <= 0)
+ syntax = Smax; /* So that "|#" (lisp) can not return
+ the syntax of "#" in *last_syntax_ptr. */
+ if (--nesting <= 0)
/* We have encountered a comment end of the same style
as the comment sequence which began this comment section. */
break;
@@ -2397,6 +2377,7 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
/* We have encountered a nested comment of the same style
as the comment sequence which began this comment section. */
{
+ syntax = Smax; /* So that "#|#" isn't also a comment ender. */
INC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
nesting++;
@@ -2404,6 +2385,8 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
}
*charpos_ptr = from;
*bytepos_ptr = from_byte;
+ *last_syntax_ptr = Smax; /* Any syntactic power the last byte had is
+ used up. */
return 1;
}
@@ -2425,6 +2408,7 @@ between them, return t; otherwise return nil. */)
EMACS_INT count1;
ptrdiff_t out_charpos, out_bytepos;
EMACS_INT dummy;
+ int dummy2;
CHECK_NUMBER (count);
count1 = XINT (count);
@@ -2488,7 +2472,7 @@ between them, return t; otherwise return nil. */)
}
/* We're at the start of a comment. */
found = forw_comment (from, from_byte, stop, comnested, comstyle, 0,
- &out_charpos, &out_bytepos, &dummy);
+ &out_charpos, &out_bytepos, &dummy, &dummy2);
from = out_charpos; from_byte = out_bytepos;
if (!found)
{
@@ -2648,6 +2632,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
ptrdiff_t from_byte;
ptrdiff_t out_bytepos, out_charpos;
EMACS_INT dummy;
+ int dummy2;
bool multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol;
if (depth > 0) min_depth = 0;
@@ -2744,7 +2729,8 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
UPDATE_SYNTAX_TABLE_FORWARD (from);
found = forw_comment (from, from_byte, stop,
comnested, comstyle, 0,
- &out_charpos, &out_bytepos, &dummy);
+ &out_charpos, &out_bytepos, &dummy,
+ &dummy2);
from = out_charpos, from_byte = out_bytepos;
if (!found)
{
@@ -3109,7 +3095,7 @@ the prefix syntax flag (p). */)
}
/* Parse forward from FROM / FROM_BYTE to END,
- assuming that FROM has state OLDSTATE (nil means FROM is start of function),
+ assuming that FROM has state STATE,
and return a description of the state of the parse at END.
If STOPBEFORE, stop at the start of an atom.
If COMMENTSTOP is 1, stop at the start of a comment.
@@ -3117,12 +3103,11 @@ the prefix syntax flag (p). */)
after the beginning of a string, or after the end of a string. */
static void
-scan_sexps_forward (struct lisp_parse_state *stateptr,
+scan_sexps_forward (struct lisp_parse_state *state,
ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t end,
EMACS_INT targetdepth, bool stopbefore,
- Lisp_Object oldstate, int commentstop)
+ int commentstop)
{
- struct lisp_parse_state state;
enum syntaxcode code;
int c1;
bool comnested;
@@ -3138,7 +3123,8 @@ scan_sexps_forward (struct lisp_parse_state *stateptr,
Lisp_Object tem;
ptrdiff_t prev_from; /* Keep one character before FROM. */
ptrdiff_t prev_from_byte;
- int prev_from_syntax;
+ int prev_from_syntax, prev_prev_from_syntax;
+ int syntax;
bool boundary_stop = commentstop == -1;
bool nofence;
bool found;
@@ -3155,6 +3141,7 @@ scan_sexps_forward (struct lisp_parse_state *stateptr,
do { prev_from = from; \
prev_from_byte = from_byte; \
temp = FETCH_CHAR_AS_MULTIBYTE (prev_from_byte); \
+ prev_prev_from_syntax = prev_from_syntax; \
prev_from_syntax = SYNTAX_WITH_FLAGS (temp); \
INC_BOTH (from, from_byte); \
if (from < end) \
@@ -3164,88 +3151,38 @@ do { prev_from = from; \
immediate_quit = 1;
QUIT;
- if (NILP (oldstate))
- {
- depth = 0;
- state.instring = -1;
- state.incomment = 0;
- state.comstyle = 0; /* comment style a by default. */
- state.comstr_start = -1; /* no comment/string seen. */
- }
- else
- {
- tem = Fcar (oldstate);
- if (!NILP (tem))
- depth = XINT (tem);
- else
- depth = 0;
+ depth = state->depth;
+ start_quoted = state->quoted;
+ prev_prev_from_syntax = Smax;
+ prev_from_syntax = state->prev_syntax;
- oldstate = Fcdr (oldstate);
- oldstate = Fcdr (oldstate);
- oldstate = Fcdr (oldstate);
- tem = Fcar (oldstate);
- /* Check whether we are inside string_fence-style string: */
- state.instring = (!NILP (tem)
- ? (CHARACTERP (tem) ? XFASTINT (tem) : ST_STRING_STYLE)
- : -1);
-
- oldstate = Fcdr (oldstate);
- tem = Fcar (oldstate);
- state.incomment = (!NILP (tem)
- ? (INTEGERP (tem) ? XINT (tem) : -1)
- : 0);
-
- oldstate = Fcdr (oldstate);
- tem = Fcar (oldstate);
- start_quoted = !NILP (tem);
-
- /* if the eighth element of the list is nil, we are in comment
- style a. If it is non-nil, we are in comment style b */
- oldstate = Fcdr (oldstate);
- oldstate = Fcdr (oldstate);
- tem = Fcar (oldstate);
- state.comstyle = (NILP (tem)
- ? 0
- : (RANGED_INTEGERP (0, tem, ST_COMMENT_STYLE)
- ? XINT (tem)
- : ST_COMMENT_STYLE));
-
- oldstate = Fcdr (oldstate);
- tem = Fcar (oldstate);
- state.comstr_start =
- RANGED_INTEGERP (PTRDIFF_MIN, tem, PTRDIFF_MAX) ? XINT (tem) : -1;
- oldstate = Fcdr (oldstate);
- tem = Fcar (oldstate);
- while (!NILP (tem)) /* >= second enclosing sexps. */
- {
- Lisp_Object temhd = Fcar (tem);
- if (RANGED_INTEGERP (PTRDIFF_MIN, temhd, PTRDIFF_MAX))
- curlevel->last = XINT (temhd);
- if (++curlevel == endlevel)
- curlevel--; /* error ("Nesting too deep for parser"); */
- curlevel->prev = -1;
- curlevel->last = -1;
- tem = Fcdr (tem);
- }
+ tem = state->levelstarts;
+ while (!NILP (tem)) /* >= second enclosing sexps. */
+ {
+ Lisp_Object temhd = Fcar (tem);
+ if (RANGED_INTEGERP (PTRDIFF_MIN, temhd, PTRDIFF_MAX))
+ curlevel->last = XINT (temhd);
+ if (++curlevel == endlevel)
+ curlevel--; /* error ("Nesting too deep for parser"); */
+ curlevel->prev = -1;
+ curlevel->last = -1;
+ tem = Fcdr (tem);
}
- state.quoted = 0;
- mindepth = depth;
-
curlevel->prev = -1;
curlevel->last = -1;
- SETUP_SYNTAX_TABLE (prev_from, 1);
- temp = FETCH_CHAR (prev_from_byte);
- prev_from_syntax = SYNTAX_WITH_FLAGS (temp);
- UPDATE_SYNTAX_TABLE_FORWARD (from);
+ state->quoted = 0;
+ mindepth = depth;
+
+ SETUP_SYNTAX_TABLE (from, 1);
/* Enter the loop at a place appropriate for initial state. */
- if (state.incomment)
+ if (state->incomment)
goto startincomment;
- if (state.instring >= 0)
+ if (state->instring >= 0)
{
- nofence = state.instring != ST_STRING_STYLE;
+ nofence = state->instring != ST_STRING_STYLE;
if (start_quoted)
goto startquotedinstring;
goto startinstring;
@@ -3255,12 +3192,7 @@ do { prev_from = from; \
while (from < end)
{
- int syntax;
- INC_FROM;
- code = prev_from_syntax & 0xff;
-
- if (from < end
- && SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax)
+ if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax)
&& (c1 = FETCH_CHAR (from_byte),
syntax = SYNTAX_WITH_FLAGS (c1),
SYNTAX_FLAGS_COMSTART_SECOND (syntax)))
@@ -3270,32 +3202,39 @@ do { prev_from = from; \
/* Record the comment style we have entered so that only
the comment-end sequence of the same style actually
terminates the comment section. */
- state.comstyle
+ state->comstyle
= SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_from_syntax);
comnested = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax)
| SYNTAX_FLAGS_COMMENT_NESTED (syntax));
- state.incomment = comnested ? 1 : -1;
- state.comstr_start = prev_from;
+ state->incomment = comnested ? 1 : -1;
+ state->comstr_start = prev_from;
INC_FROM;
+ prev_from_syntax = Smax; /* the syntax has already been
+ "used up". */
code = Scomment;
}
- else if (code == Scomment_fence)
- {
- /* Record the comment style we have entered so that only
- the comment-end sequence of the same style actually
- terminates the comment section. */
- state.comstyle = ST_COMMENT_STYLE;
- state.incomment = -1;
- state.comstr_start = prev_from;
- code = Scomment;
- }
- else if (code == Scomment)
- {
- state.comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax, 0);
- state.incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ?
- 1 : -1);
- state.comstr_start = prev_from;
- }
+ else
+ {
+ INC_FROM;
+ code = prev_from_syntax & 0xff;
+ if (code == Scomment_fence)
+ {
+ /* Record the comment style we have entered so that only
+ the comment-end sequence of the same style actually
+ terminates the comment section. */
+ state->comstyle = ST_COMMENT_STYLE;
+ state->incomment = -1;
+ state->comstr_start = prev_from;
+ code = Scomment;
+ }
+ else if (code == Scomment)
+ {
+ state->comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax, 0);
+ state->incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ?
+ 1 : -1);
+ state->comstr_start = prev_from;
+ }
+ }
if (SYNTAX_FLAGS_PREFIX (prev_from_syntax))
continue;
@@ -3318,7 +3257,24 @@ do { prev_from = from; \
while (from < end)
{
int symchar = FETCH_CHAR_AS_MULTIBYTE (from_byte);
- switch (SYNTAX (symchar))
+
+ if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax)
+ && (syntax = SYNTAX_WITH_FLAGS (symchar),
+ SYNTAX_FLAGS_COMSTART_SECOND (syntax)))
+ {
+ state->comstyle
+ = SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_from_syntax);
+ comnested = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax)
+ | SYNTAX_FLAGS_COMMENT_NESTED (syntax));
+ state->incomment = comnested ? 1 : -1;
+ state->comstr_start = prev_from;
+ INC_FROM;
+ prev_from_syntax = Smax;
+ code = Scomment;
+ goto atcomment;
+ }
+
+ switch (SYNTAX (symchar))
{
case Scharquote:
case Sescape:
@@ -3340,26 +3296,29 @@ do { prev_from = from; \
case Scomment_fence: /* Can't happen because it's handled above. */
case Scomment:
- if (commentstop || boundary_stop) goto done;
+ atcomment:
+ if (commentstop || boundary_stop) goto done;
startincomment:
/* The (from == BEGV) test was to enter the loop in the middle so
that we find a 2-char comment ender even if we start in the
middle of it. We don't want to do that if we're just at the
beginning of the comment (think of (*) ... (*)). */
found = forw_comment (from, from_byte, end,
- state.incomment, state.comstyle,
- (from == BEGV || from < state.comstr_start + 3)
- ? 0 : prev_from_syntax,
- &out_charpos, &out_bytepos, &state.incomment);
+ state->incomment, state->comstyle,
+ from == BEGV ? 0 : prev_from_syntax,
+ &out_charpos, &out_bytepos, &state->incomment,
+ &prev_from_syntax);
from = out_charpos; from_byte = out_bytepos;
- /* Beware! prev_from and friends are invalid now.
- Luckily, the `done' doesn't use them and the INC_FROM
- sets them to a sane value without looking at them. */
+ /* Beware! prev_from and friends (except prev_from_syntax)
+ are invalid now. Luckily, the `done' doesn't use them
+ and the INC_FROM sets them to a sane value without
+ looking at them. */
if (!found) goto done;
INC_FROM;
- state.incomment = 0;
- state.comstyle = 0; /* reset the comment style */
- if (boundary_stop) goto done;
+ state->incomment = 0;
+ state->comstyle = 0; /* reset the comment style */
+ prev_from_syntax = Smax; /* For the comment closer */
+ if (boundary_stop) goto done;
break;
case Sopen:
@@ -3386,16 +3345,16 @@ do { prev_from = from; \
case Sstring:
case Sstring_fence:
- state.comstr_start = from - 1;
+ state->comstr_start = from - 1;
if (stopbefore) goto stop; /* this arg means stop at sexp start */
curlevel->last = prev_from;
- state.instring = (code == Sstring
+ state->instring = (code == Sstring
? (FETCH_CHAR_AS_MULTIBYTE (prev_from_byte))
: ST_STRING_STYLE);
if (boundary_stop) goto done;
startinstring:
{
- nofence = state.instring != ST_STRING_STYLE;
+ nofence = state->instring != ST_STRING_STYLE;
while (1)
{
@@ -3409,7 +3368,7 @@ do { prev_from = from; \
/* Check C_CODE here so that if the char has
a syntax-table property which says it is NOT
a string character, it does not end the string. */
- if (nofence && c == state.instring && c_code == Sstring)
+ if (nofence && c == state->instring && c_code == Sstring)
break;
switch (c_code)
@@ -3432,7 +3391,7 @@ do { prev_from = from; \
}
}
string_end:
- state.instring = -1;
+ state->instring = -1;
curlevel->prev = curlevel->last;
INC_FROM;
if (boundary_stop) goto done;
@@ -3451,25 +3410,96 @@ do { prev_from = from; \
stop: /* Here if stopping before start of sexp. */
from = prev_from; /* We have just fetched the char that starts it; */
from_byte = prev_from_byte;
+ prev_from_syntax = prev_prev_from_syntax;
goto done; /* but return the position before it. */
endquoted:
- state.quoted = 1;
+ state->quoted = 1;
done:
- state.depth = depth;
- state.mindepth = mindepth;
- state.thislevelstart = curlevel->prev;
- state.prevlevelstart
+ state->depth = depth;
+ state->mindepth = mindepth;
+ state->thislevelstart = curlevel->prev;
+ state->prevlevelstart
= (curlevel == levelstart) ? -1 : (curlevel - 1)->last;
- state.location = from;
- state.location_byte = from_byte;
- state.levelstarts = Qnil;
+ state->location = from;
+ state->location_byte = from_byte;
+ state->levelstarts = Qnil;
while (curlevel > levelstart)
- state.levelstarts = Fcons (make_number ((--curlevel)->last),
- state.levelstarts);
+ state->levelstarts = Fcons (make_number ((--curlevel)->last),
+ state->levelstarts);
+ state->prev_syntax = (SYNTAX_FLAGS_COMSTARTEND_FIRST (prev_from_syntax)
+ || state->quoted) ? prev_from_syntax : Smax;
immediate_quit = 0;
+}
+
+/* Convert a (lisp) parse state to the internal form used in
+ scan_sexps_forward. */
+static void
+internalize_parse_state (Lisp_Object external, struct lisp_parse_state *state)
+{
+ Lisp_Object tem;
+
+ if (NILP (external))
+ {
+ state->depth = 0;
+ state->instring = -1;
+ state->incomment = 0;
+ state->quoted = 0;
+ state->comstyle = 0; /* comment style a by default. */
+ state->comstr_start = -1; /* no comment/string seen. */
+ state->levelstarts = Qnil;
+ state->prev_syntax = Smax;
+ }
+ else
+ {
+ tem = Fcar (external);
+ if (!NILP (tem))
+ state->depth = XINT (tem);
+ else
+ state->depth = 0;
- *stateptr = state;
+ external = Fcdr (external);
+ external = Fcdr (external);
+ external = Fcdr (external);
+ tem = Fcar (external);
+ /* Check whether we are inside string_fence-style string: */
+ state->instring = (!NILP (tem)
+ ? (CHARACTERP (tem) ? XFASTINT (tem) : ST_STRING_STYLE)
+ : -1);
+
+ external = Fcdr (external);
+ tem = Fcar (external);
+ state->incomment = (!NILP (tem)
+ ? (INTEGERP (tem) ? XINT (tem) : -1)
+ : 0);
+
+ external = Fcdr (external);
+ tem = Fcar (external);
+ state->quoted = !NILP (tem);
+
+ /* if the eighth element of the list is nil, we are in comment
+ style a. If it is non-nil, we are in comment style b */
+ external = Fcdr (external);
+ external = Fcdr (external);
+ tem = Fcar (external);
+ state->comstyle = (NILP (tem)
+ ? 0
+ : (RANGED_INTEGERP (0, tem, ST_COMMENT_STYLE)
+ ? XINT (tem)
+ : ST_COMMENT_STYLE));
+
+ external = Fcdr (external);
+ tem = Fcar (external);
+ state->comstr_start =
+ RANGED_INTEGERP (PTRDIFF_MIN, tem, PTRDIFF_MAX) ? XINT (tem) : -1;
+ external = Fcdr (external);
+ tem = Fcar (external);
+ state->levelstarts = tem;
+
+ external = Fcdr (external);
+ tem = Fcar (external);
+ state->prev_syntax = NILP (tem) ? Smax : XINT (tem);
+ }
}
DEFUN ("parse-partial-sexp", Fparse_partial_sexp, Sparse_partial_sexp, 2, 6, 0,
@@ -3478,6 +3508,7 @@ Parsing stops at TO or when certain criteria are met;
point is set to where parsing stops.
If fifth arg OLDSTATE is omitted or nil,
parsing assumes that FROM is the beginning of a function.
+
Value is a list of elements describing final state of parsing:
0. depth in parens.
1. character address of start of innermost containing list; nil if none.
@@ -3491,16 +3522,22 @@ Value is a list of elements describing final state of parsing:
6. the minimum paren-depth encountered during this scan.
7. style of comment, if any.
8. character address of start of comment or string; nil if not in one.
- 9. Intermediate data for continuation of parsing (subject to change).
+ 9. List of positions of currently open parens, outermost first.
+10. When the last position scanned holds the first character of a
+ (potential) two character construct, the syntax of that position,
+ otherwise nil. That construct can be a two character comment
+ delimiter or an Escaped or Char-quoted character.
+11..... Possible further internal information used by `parse-partial-sexp'.
+
If third arg TARGETDEPTH is non-nil, parsing stops if the depth
in parentheses becomes equal to TARGETDEPTH.
-Fourth arg STOPBEFORE non-nil means stop when come to
+Fourth arg STOPBEFORE non-nil means stop when we come to
any character that starts a sexp.
Fifth arg OLDSTATE is a list like what this function returns.
It is used to initialize the state of the parse. Elements number 1, 2, 6
are ignored.
-Sixth arg COMMENTSTOP non-nil means stop at the start of a comment.
- If it is symbol `syntax-table', stop after the start of a comment or a
+Sixth arg COMMENTSTOP non-nil means stop after the start of a comment.
+ If it is the symbol `syntax-table', stop after the start of a comment or a
string, or after end of a comment or a string. */)
(Lisp_Object from, Lisp_Object to, Lisp_Object targetdepth,
Lisp_Object stopbefore, Lisp_Object oldstate, Lisp_Object commentstop)
@@ -3517,15 +3554,17 @@ Sixth arg COMMENTSTOP non-nil means stop at the start of a comment.
target = TYPE_MINIMUM (EMACS_INT); /* We won't reach this depth. */
validate_region (&from, &to);
+ internalize_parse_state (oldstate, &state);
scan_sexps_forward (&state, XINT (from), CHAR_TO_BYTE (XINT (from)),
XINT (to),
- target, !NILP (stopbefore), oldstate,
+ target, !NILP (stopbefore),
(NILP (commentstop)
? 0 : (EQ (commentstop, Qsyntax_table) ? -1 : 1)));
SET_PT_BOTH (state.location, state.location_byte);
- return Fcons (make_number (state.depth),
+ return
+ Fcons (make_number (state.depth),
Fcons (state.prevlevelstart < 0
? Qnil : make_number (state.prevlevelstart),
Fcons (state.thislevelstart < 0
@@ -3543,11 +3582,15 @@ Sixth arg COMMENTSTOP non-nil means stop at the start of a comment.
? Qsyntax_table
: make_number (state.comstyle))
: Qnil),
- Fcons (((state.incomment
- || (state.instring >= 0))
- ? make_number (state.comstr_start)
- : Qnil),
- Fcons (state.levelstarts, Qnil))))))))));
+ Fcons (((state.incomment
+ || (state.instring >= 0))
+ ? make_number (state.comstr_start)
+ : Qnil),
+ Fcons (state.levelstarts,
+ Fcons (state.prev_syntax == Smax
+ ? Qnil
+ : make_number (state.prev_syntax),
+ Qnil)))))))))));
}
void
diff --git a/src/sysdep.c b/src/sysdep.c
index 674e76db7a0..892e97626bd 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -19,14 +19,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-/* If HYBRID_GET_CURRENT_DIR_NAME is defined in conf_post.h, then we
- need the following before including unistd.h, in order to pick up
- the right prototype for gget_current_dir_name. */
-#ifdef HYBRID_GET_CURRENT_DIR_NAME
-#undef get_current_dir_name
-#define get_current_dir_name gget_current_dir_name
-#endif
-
#include <execinfo.h>
#include "sysstdio.h"
#ifdef HAVE_PWD_H
@@ -34,12 +26,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <grp.h>
#endif /* HAVE_PWD_H */
#include <limits.h>
+#include <stdlib.h>
#include <unistd.h>
#include <c-ctype.h>
#include <utimens.h>
#include "lisp.h"
+#include "sheap.h"
#include "sysselect.h"
#include "blockinput.h"
@@ -102,7 +96,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "gnutls.h"
/* MS-Windows loads GnuTLS at run time, if available; we don't want to
do that during startup just to call gnutls_rnd. */
-#if 0x020c00 <= GNUTLS_VERSION_NUMBER && !defined WINDOWSNT
+#if defined HAVE_GNUTLS && !defined WINDOWSNT
# include <gnutls/crypto.h>
#else
# define emacs_gnutls_global_init() Qnil
@@ -114,7 +108,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* In process.h which conflicts with the local copy. */
#define _P_WAIT 0
int _cdecl _spawnlp (int, const char *, const char *, ...);
-int _cdecl _getpid (void);
/* The following is needed for O_CLOEXEC, F_SETFD, FD_CLOEXEC, and
several prototypes of functions called below. */
#include <sys/socket.h>
@@ -137,14 +130,92 @@ static const int baud_convert[] =
1800, 2400, 4800, 9600, 19200, 38400
};
-#if !defined HAVE_GET_CURRENT_DIR_NAME || defined BROKEN_GET_CURRENT_DIR_NAME \
- || (defined HYBRID_GET_CURRENT_DIR_NAME)
-/* Return the current working directory. Returns NULL on errors.
- Any other returned value must be freed with free. This is used
- only when get_current_dir_name is not defined on the system. */
+#ifdef HAVE_PERSONALITY_ADDR_NO_RANDOMIZE
+# include <sys/personality.h>
+
+/* Disable address randomization in the current process. Return true
+ if addresses were randomized but this has been disabled, false
+ otherwise. */
+bool
+disable_address_randomization (void)
+{
+ bool disabled = false;
+ int pers = personality (0xffffffff);
+ disabled = (! (pers & ADDR_NO_RANDOMIZE)
+ && 0 <= personality (pers | ADDR_NO_RANDOMIZE));
+ return disabled;
+}
+#endif
+
+/* Execute the program in FILE, with argument vector ARGV and environ
+ ENVP. Return an error number if unsuccessful. This is like execve
+ except it reenables ASLR in the executed program if necessary, and
+ on error it returns an error number rather than -1. */
+int
+emacs_exec_file (char const *file, char *const *argv, char *const *envp)
+{
+#ifdef HAVE_PERSONALITY_ADDR_NO_RANDOMIZE
+ int pers = getenv ("EMACS_HEAP_EXEC") ? personality (0xffffffff) : -1;
+ bool change_personality = 0 <= pers && pers & ADDR_NO_RANDOMIZE;
+ if (change_personality)
+ personality (pers & ~ADDR_NO_RANDOMIZE);
+#endif
+
+ execve (file, argv, envp);
+ int err = errno;
+
+#ifdef HAVE_PERSONALITY_ADDR_NO_RANDOMIZE
+ if (change_personality)
+ personality (pers);
+#endif
+
+ return err;
+}
+
+/* If FD is not already open, arrange for it to be open with FLAGS. */
+static void
+force_open (int fd, int flags)
+{
+ if (dup2 (fd, fd) < 0 && errno == EBADF)
+ {
+ int n = open (NULL_DEVICE, flags);
+ if (n < 0 || (fd != n && (dup2 (n, fd) < 0 || emacs_close (n) != 0)))
+ {
+ emacs_perror (NULL_DEVICE);
+ exit (EXIT_FAILURE);
+ }
+ }
+}
+
+/* Make sure stdin, stdout, and stderr are open to something, so that
+ their file descriptors are not hijacked by later system calls. */
+void
+init_standard_fds (void)
+{
+ /* Open stdin for *writing*, and stdout and stderr for *reading*.
+ That way, any attempt to do normal I/O will result in an error,
+ just as if the files were closed, and the file descriptors will
+ not be reused by later opens. */
+ force_open (STDIN_FILENO, O_WRONLY);
+ force_open (STDOUT_FILENO, O_RDONLY);
+ force_open (STDERR_FILENO, O_RDONLY);
+}
+
+/* Return the current working directory. The result should be freed
+ with 'free'. Return NULL on errors. */
char *
-get_current_dir_name (void)
+emacs_get_current_dir_name (void)
{
+# if HAVE_GET_CURRENT_DIR_NAME && !BROKEN_GET_CURRENT_DIR_NAME
+# ifdef HYBRID_MALLOC
+ bool use_libc = bss_sbrk_did_unexec;
+# else
+ bool use_libc = true;
+# endif
+ if (use_libc)
+ return get_current_dir_name ();
+# endif
+
char *buf;
char *pwd = getenv ("PWD");
struct stat dotstat, pwdstat;
@@ -192,7 +263,6 @@ get_current_dir_name (void)
}
return buf;
}
-#endif
/* Discard pending input on all input descriptors. */
@@ -479,15 +549,16 @@ void
sys_subshell (void)
{
#ifdef DOS_NT /* Demacs 1.1.2 91/10/20 Manabu Higashida */
- int st;
#ifdef MSDOS
+ int st;
char oldwd[MAXPATHLEN+1]; /* Fixed length is safe on MSDOS. */
#else
char oldwd[MAX_UTF8_PATH];
-#endif
+#endif /* MSDOS */
+#else /* !DOS_NT */
+ int status;
#endif
pid_t pid;
- int status;
struct save_signal saved_handlers[5];
char *str = SSDATA (encode_current_directory ());
@@ -910,7 +981,9 @@ void
init_sys_modes (struct tty_display_info *tty_out)
{
struct emacs_tty tty;
+#ifndef DOS_NT
Lisp_Object terminal;
+#endif
Vtty_erase_char = Qnil;
@@ -1409,6 +1482,12 @@ setup_pty (int fd)
void
init_system_name (void)
{
+ if (!build_details)
+ {
+ /* Set system-name to nil so that the build is deterministic. */
+ Vsystem_name = Qnil;
+ return;
+ }
char *hostname_alloc = NULL;
char *hostname;
#ifndef HAVE_GETHOSTNAME
@@ -1632,6 +1711,9 @@ static unsigned char sigsegv_stack[SIGSTKSZ];
static bool
stack_overflow (siginfo_t *siginfo)
{
+ if (!attempt_stack_overflow_recovery)
+ return false;
+
/* In theory, a more-accurate heuristic can be obtained by using
GNU/Linux pthread_getattr_np along with POSIX pthread_attr_getstack
and pthread_attr_getguardsize to find the location and size of the
@@ -2106,27 +2188,35 @@ void
init_random (void)
{
random_seed v;
- if (! (EQ (emacs_gnutls_global_init (), Qt)
- && gnutls_rnd (GNUTLS_RND_NONCE, &v, sizeof v) == 0))
- {
- bool success = false;
-#ifndef WINDOWSNT
- int fd = emacs_open ("/dev/urandom", O_RDONLY | O_BINARY, 0);
- if (0 <= fd)
- {
- success = emacs_read (fd, &v, sizeof v) == sizeof v;
- emacs_close (fd);
- }
+ bool success = false;
+
+ /* First, try seeding the PRNG from the operating system's entropy
+ source. This approach is both fast and secure. */
+#ifdef WINDOWSNT
+ success = w32_init_random (&v, sizeof v) == 0;
#else
- success = w32_init_random (&v, sizeof v) == 0;
+ int fd = emacs_open ("/dev/urandom", O_RDONLY, 0);
+ if (0 <= fd)
+ {
+ success = emacs_read (fd, &v, sizeof v) == sizeof v;
+ close (fd);
+ }
#endif
- if (! success)
- {
- /* Fall back to current time value + PID. */
- struct timespec t = current_timespec ();
- v = getpid () ^ t.tv_sec ^ t.tv_nsec;
- }
+
+ /* If that didn't work, try using GnuTLS, which is secure, but on
+ some systems, can be somewhat slow. */
+ if (!success)
+ success = EQ (emacs_gnutls_global_init (), Qt)
+ && gnutls_rnd (GNUTLS_RND_NONCE, &v, sizeof v) == 0;
+
+ /* If _that_ didn't work, just use the current time value and PID.
+ It's at least better than XKCD 221. */
+ if (!success)
+ {
+ struct timespec t = current_timespec ();
+ v = getpid () ^ t.tv_sec ^ t.tv_nsec;
}
+
set_random_seed (v);
}
@@ -2142,8 +2232,8 @@ get_random (void)
int i;
for (i = 0; i < (FIXNUM_BITS + RAND_BITS - 1) / RAND_BITS; i++)
val = (random () ^ (val << RAND_BITS)
- ^ (val >> (BITS_PER_EMACS_INT - RAND_BITS)));
- val ^= val >> (BITS_PER_EMACS_INT - FIXNUM_BITS);
+ ^ (val >> (EMACS_INT_WIDTH - RAND_BITS)));
+ val ^= val >> (EMACS_INT_WIDTH - FIXNUM_BITS);
return val & INTMASK;
}
@@ -2291,7 +2381,6 @@ emacs_fopen (char const *file, char const *mode)
switch (*m++)
{
case '+': omode = O_RDWR; break;
- case 'b': bflag = O_BINARY; break;
case 't': bflag = O_TEXT; break;
default: /* Ignore. */ break;
}
@@ -2460,7 +2549,7 @@ void
emacs_perror (char const *message)
{
int err = errno;
- char const *error_string = strerror (err);
+ char const *error_string = emacs_strerror (err);
char const *command = (initial_argv && initial_argv[0]
? initial_argv[0] : "emacs");
/* Write it out all at once, if it's short; this is less likely to
@@ -3013,7 +3102,7 @@ system_process_attributes (Lisp_Object pid)
struct timespec tnow, tstart, tboot, telapsed, us_time;
double pcpu, pmem;
Lisp_Object attrs = Qnil;
- Lisp_Object cmd_str, decoded_cmd;
+ Lisp_Object decoded_cmd;
ptrdiff_t count;
CHECK_NUMBER_OR_FLOAT (pid);
@@ -3070,7 +3159,7 @@ system_process_attributes (Lisp_Object pid)
else
q = NULL;
/* Command name is encoded in locale-coding-system; decode it. */
- cmd_str = make_unibyte_string (cmd, cmdsize);
+ AUTO_STRING_WITH_LEN (cmd_str, cmd, cmdsize);
decoded_cmd = code_convert_string_norecord (cmd_str,
Vlocale_coding_system, 0);
attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs);
@@ -3203,7 +3292,7 @@ system_process_attributes (Lisp_Object pid)
sprintf (cmdline, "[%.*s]", cmdsize, cmd);
}
/* Command line is encoded in locale-coding-system; decode it. */
- cmd_str = make_unibyte_string (q, nread);
+ AUTO_STRING_WITH_LEN (cmd_str, q, nread);
decoded_cmd = code_convert_string_norecord (cmd_str,
Vlocale_coding_system, 0);
unbind_to (count, Qnil);
@@ -3338,13 +3427,13 @@ system_process_attributes (Lisp_Object pid)
make_float (100.0 / 0x8000 * pinfo.pr_pctmem)),
attrs);
- decoded_cmd = (code_convert_string_norecord
- (build_unibyte_string (pinfo.pr_fname),
- Vlocale_coding_system, 0));
+ AUTO_STRING (fname, pinfo.pr_fname);
+ decoded_cmd = code_convert_string_norecord (fname,
+ Vlocale_coding_system, 0);
attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs);
- decoded_cmd = (code_convert_string_norecord
- (build_unibyte_string (pinfo.pr_psargs),
- Vlocale_coding_system, 0));
+ AUTO_STRING (psargs, pinfo.pr_psargs);
+ decoded_cmd = code_convert_string_norecord (psargs,
+ Vlocale_coding_system, 0);
attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs);
}
unbind_to (count, Qnil);
@@ -3409,9 +3498,8 @@ system_process_attributes (Lisp_Object pid)
if (gr)
attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
- decoded_comm = (code_convert_string_norecord
- (build_unibyte_string (proc.ki_comm),
- Vlocale_coding_system, 0));
+ AUTO_STRING (comm, proc.ki_comm);
+ decoded_comm = code_convert_string_norecord (comm, Vlocale_coding_system, 0);
attrs = Fcons (Fcons (Qcomm, decoded_comm), attrs);
{
@@ -3522,10 +3610,9 @@ system_process_attributes (Lisp_Object pid)
args[i] = ' ';
}
- decoded_comm =
- (code_convert_string_norecord
- (build_unibyte_string (args),
- Vlocale_coding_system, 0));
+ AUTO_STRING (comm, args);
+ decoded_comm = code_convert_string_norecord (comm,
+ Vlocale_coding_system, 0);
attrs = Fcons (Fcons (Qargs, decoded_comm), attrs);
}
@@ -3533,6 +3620,146 @@ system_process_attributes (Lisp_Object pid)
return attrs;
}
+#elif 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)
+{
+ return make_lisp_time (timeval_to_timespec (t));
+}
+
+Lisp_Object
+system_process_attributes (Lisp_Object pid)
+{
+ int proc_id;
+ int pagesize = getpagesize ();
+ unsigned long npages;
+ int fscale;
+ struct passwd *pw;
+ struct group *gr;
+ char *ttyname;
+ size_t len;
+ char args[MAXPATHLEN];
+ struct timeval starttime;
+ struct timespec t, now;
+ struct rusage *rusage;
+ dev_t tdev;
+ uid_t uid;
+ gid_t gid;
+
+ int mib[4] = {CTL_KERN, KERN_PROC, KERN_PROC_PID};
+ struct kinfo_proc proc;
+ size_t proclen = sizeof proc;
+
+ Lisp_Object attrs = Qnil;
+ Lisp_Object decoded_comm;
+
+ CHECK_NUMBER_OR_FLOAT (pid);
+ CONS_TO_INTEGER (pid, int, proc_id);
+ mib[3] = proc_id;
+
+ if (sysctl (mib, 4, &proc, &proclen, NULL, 0) != 0)
+ return attrs;
+
+ uid = proc.kp_eproc.e_ucred.cr_uid;
+ attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (uid)), attrs);
+
+ block_input ();
+ pw = getpwuid (uid);
+ unblock_input ();
+ if (pw)
+ attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs);
+
+ gid = proc.kp_eproc.e_pcred.p_svgid;
+ attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (gid)), attrs);
+
+ block_input ();
+ gr = getgrgid (gid);
+ unblock_input ();
+ if (gr)
+ attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
+
+ decoded_comm = (code_convert_string_norecord
+ (build_unibyte_string (proc.kp_proc.p_comm),
+ Vlocale_coding_system, 0));
+
+ attrs = Fcons (Fcons (Qcomm, decoded_comm), attrs);
+ {
+ char state[2] = {'\0', '\0'};
+ switch (proc.kp_proc.p_stat)
+ {
+ case SRUN:
+ state[0] = 'R';
+ break;
+
+ case SSLEEP:
+ state[0] = 'S';
+ break;
+
+ case SZOMB:
+ state[0] = 'Z';
+ break;
+
+ case SSTOP:
+ state[0] = 'T';
+ break;
+
+ case SIDL:
+ state[0] = 'I';
+ break;
+ }
+ attrs = Fcons (Fcons (Qstate, build_string (state)), attrs);
+ }
+
+ attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (proc.kp_eproc.e_ppid)),
+ attrs);
+ attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (proc.kp_eproc.e_pgid)),
+ attrs);
+
+ tdev = proc.kp_eproc.e_tdev;
+ block_input ();
+ ttyname = tdev == NODEV ? NULL : devname (tdev, S_IFCHR);
+ unblock_input ();
+ if (ttyname)
+ attrs = Fcons (Fcons (Qtty, build_string (ttyname)), attrs);
+
+ attrs = Fcons (Fcons (Qtpgid, make_fixnum_or_float (proc.kp_eproc.e_tpgid)),
+ attrs);
+
+ rusage = proc.kp_proc.p_ru;
+ if (rusage)
+ {
+ attrs = Fcons (Fcons (Qminflt, make_fixnum_or_float (rusage->ru_minflt)),
+ attrs);
+ attrs = Fcons (Fcons (Qmajflt, make_fixnum_or_float (rusage->ru_majflt)),
+ attrs);
+
+ attrs = Fcons (Fcons (Qutime, make_lisp_timeval (rusage->ru_utime)),
+ attrs);
+ attrs = Fcons (Fcons (Qstime, make_lisp_timeval (rusage->ru_stime)),
+ attrs);
+ t = timespec_add (timeval_to_timespec (rusage->ru_utime),
+ timeval_to_timespec (rusage->ru_stime));
+ attrs = Fcons (Fcons (Qtime, make_lisp_time (t)), attrs);
+ }
+
+ starttime = proc.kp_proc.p_starttime;
+ attrs = Fcons (Fcons (Qnice, make_number (proc.kp_proc.p_nice)), attrs);
+ attrs = Fcons (Fcons (Qstart, make_lisp_timeval (starttime)), attrs);
+
+ now = current_timespec ();
+ t = timespec_sub (now, timeval_to_timespec (starttime));
+ attrs = Fcons (Fcons (Qetime, make_lisp_time (t)), attrs);
+
+ return attrs;
+}
+
/* The WINDOWSNT implementation is in w32.c.
The MSDOS implementation is in dosfns.c. */
#elif !defined (WINDOWSNT) && !defined (MSDOS)
@@ -3689,7 +3916,7 @@ str_collate (Lisp_Object s1, Lisp_Object s2,
locale_t loc = newlocale (LC_COLLATE_MASK | LC_CTYPE_MASK,
SSDATA (locale), 0);
if (!loc)
- error ("Invalid locale %s: %s", SSDATA (locale), strerror (errno));
+ error ("Invalid locale %s: %s", SSDATA (locale), emacs_strerror (errno));
if (! NILP (ignore_case))
for (int i = 1; i < 3; i++)
@@ -3720,10 +3947,10 @@ str_collate (Lisp_Object s1, Lisp_Object s2,
}
# ifndef HAVE_NEWLOCALE
if (err)
- error ("Invalid locale or string for collation: %s", strerror (err));
+ error ("Invalid locale or string for collation: %s", emacs_strerror (err));
# else
if (err)
- error ("Invalid string for collation: %s", strerror (err));
+ error ("Invalid string for collation: %s", emacs_strerror (err));
# endif
SAFE_FREE ();
@@ -3741,7 +3968,7 @@ str_collate (Lisp_Object s1, Lisp_Object s2,
int res, err = errno;
errno = 0;
- res = w32_compare_strings (SDATA (s1), SDATA (s2), loc, !NILP (ignore_case));
+ res = w32_compare_strings (SSDATA (s1), SSDATA (s2), loc, !NILP (ignore_case));
if (errno)
error ("Invalid string for collation: %s", strerror (errno));
diff --git a/src/systty.h b/src/systty.h
index fbdc6b18373..a53c874699f 100644
--- a/src/systty.h
+++ b/src/systty.h
@@ -26,7 +26,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <fcntl.h>
#endif /* not DOS_NT */
-#include <stdbool.h>
#include <sys/ioctl.h>
#ifdef HPUX
diff --git a/src/term.c b/src/term.c
index 43972109655..d691a7aa101 100644
--- a/src/term.c
+++ b/src/term.c
@@ -23,6 +23,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <errno.h>
#include <fcntl.h>
#include <stdio.h>
+#include <stdlib.h>
#include <sys/file.h>
#include <sys/time.h>
#include <unistd.h>
@@ -58,10 +59,7 @@ static int been_here = -1;
/* The name of the default console device. */
#ifdef WINDOWSNT
-#define DEV_TTY "CONOUT$"
#include "w32term.h"
-#else
-#define DEV_TTY "/dev/tty"
#endif
static void tty_set_scroll_region (struct frame *f, int start, int stop);
@@ -548,8 +546,8 @@ encode_terminal_code (struct glyph *src, int src_len,
{
if (src->type == COMPOSITE_GLYPH)
{
- struct composition *cmp IF_LINT (= NULL);
- Lisp_Object gstring IF_LINT (= Qnil);
+ struct composition *cmp UNINIT;
+ Lisp_Object gstring UNINIT;
int i;
nbytes = buf - encode_terminal_src;
@@ -596,7 +594,7 @@ encode_terminal_code (struct glyph *src, int src_len,
continue;
if (char_charset (c, charset_list, NULL))
{
- if (CHAR_WIDTH (c) == 0
+ if (CHARACTER_WIDTH (c) == 0
&& i > 0 && COMPOSITION_GLYPH (cmp, i - 1) == '\t')
/* Should be left-padded */
{
@@ -614,7 +612,7 @@ encode_terminal_code (struct glyph *src, int src_len,
else if (! CHAR_GLYPH_PADDING_P (*src))
{
GLYPH g;
- int c IF_LINT (= 0);
+ int c UNINIT;
Lisp_Object string;
string = Qnil;
@@ -1496,6 +1494,8 @@ append_glyph (struct it *it)
glyph->pixel_width = 1;
glyph->u.ch = it->char_to_display;
glyph->face_id = it->face_id;
+ glyph->avoid_cursor_p = it->avoid_cursor_p;
+ glyph->multibyte_p = it->multibyte_p;
glyph->padding_p = i > 0;
glyph->charpos = CHARPOS (it->position);
glyph->object = it->object;
@@ -1627,7 +1627,7 @@ produce_glyphs (struct it *it)
if (char_charset (it->char_to_display, charset_list, NULL))
{
- it->pixel_width = CHAR_WIDTH (it->char_to_display);
+ it->pixel_width = CHARACTER_WIDTH (it->char_to_display);
it->nglyphs = it->pixel_width;
if (it->glyph_row)
append_glyph (it);
@@ -1692,8 +1692,10 @@ append_composite_glyph (struct it *it)
glyph->slice.cmp.to = it->cmp_it.to - 1;
}
+ glyph->avoid_cursor_p = it->avoid_cursor_p;
+ glyph->multibyte_p = it->multibyte_p;
glyph->face_id = it->face_id;
- glyph->padding_p = 0;
+ glyph->padding_p = false;
glyph->charpos = CHARPOS (it->position);
glyph->object = it->object;
if (it->bidi_p)
@@ -1776,8 +1778,10 @@ append_glyphless_glyph (struct it *it, int face_id, const char *str)
return;
glyph->type = CHAR_GLYPH;
glyph->pixel_width = 1;
+ glyph->avoid_cursor_p = it->avoid_cursor_p;
+ glyph->multibyte_p = it->multibyte_p;
glyph->face_id = face_id;
- glyph->padding_p = 0;
+ glyph->padding_p = false;
glyph->charpos = CHARPOS (it->position);
glyph->object = it->object;
if (it->bidi_p)
@@ -1818,7 +1822,7 @@ static void
produce_glyphless_glyph (struct it *it, Lisp_Object acronym)
{
int len, face_id = merge_glyphless_glyph_face (it);
- char buf[sizeof "\\x" + max (6, (sizeof it->c * CHAR_BIT + 3) / 4)];
+ char buf[sizeof "\\x" + max (6, (INT_WIDTH + 3) / 4)];
char const *str = " ";
if (it->glyphless_method == GLYPHLESS_DISPLAY_THIN_SPACE)
@@ -1829,7 +1833,7 @@ produce_glyphless_glyph (struct it *it, Lisp_Object acronym)
}
else if (it->glyphless_method == GLYPHLESS_DISPLAY_EMPTY_BOX)
{
- len = CHAR_WIDTH (it->c);
+ len = CHARACTER_WIDTH (it->c);
if (len == 0)
len = 1;
else if (len > 4)
@@ -1954,8 +1958,6 @@ turn_off_face (struct frame *f, int face_id)
struct face *face = FACE_FROM_ID (f, face_id);
struct tty_display_info *tty = FRAME_TTY (f);
- eassert (face != NULL);
-
if (tty->TS_exit_attribute_mode)
{
/* Capability "me" will turn off appearance modes double-bright,
@@ -3101,7 +3103,7 @@ tty_menu_activate (tty_menu *menu, int *pane, int *selidx,
struct tty_menu_state *state;
int statecount, x, y, i;
bool leave, onepane;
- int result IF_LINT (= 0);
+ int result UNINIT;
int title_faces[4]; /* Face to display the menu title. */
int faces[4], buffers_num_deleted = 0;
struct frame *sf = SELECTED_FRAME ();
@@ -3755,7 +3757,7 @@ tty_menu_show (struct frame *f, int x, int y, int menuflags,
/* Make "Cancel" equivalent to C-g unless FOR_CLICK (which means
the menu was invoked with a mouse event as POSITION). */
if (!(menuflags & MENU_FOR_CLICK))
- Fsignal (Qquit, Qnil);
+ quit ();
break;
}
@@ -3904,7 +3906,7 @@ dissociate_if_controlling_tty (int fd)
/* Create a termcap display on the tty device with the given name and
type.
- If NAME is NULL, then use the controlling tty, i.e., "/dev/tty".
+ If NAME is NULL, then use the controlling tty, i.e., DEV_TTY.
Otherwise NAME should be a path to the tty device file,
e.g. "/dev/pts/7".
@@ -3915,13 +3917,15 @@ dissociate_if_controlling_tty (int fd)
struct terminal *
init_tty (const char *name, const char *terminal_type, bool must_succeed)
{
+ struct tty_display_info *tty = NULL;
+ struct terminal *terminal = NULL;
+#ifndef DOS_NT
char *area;
char **address = &area;
int status;
- struct tty_display_info *tty = NULL;
- struct terminal *terminal = NULL;
sigset_t oldset;
bool ctty = false; /* True if asked to open controlling tty. */
+#endif
if (!terminal_type)
maybe_fatal (must_succeed, 0,
@@ -3930,8 +3934,10 @@ init_tty (const char *name, const char *terminal_type, bool must_succeed)
if (name == NULL)
name = DEV_TTY;
+#ifndef DOS_NT
if (!strcmp (name, DEV_TTY))
ctty = 1;
+#endif
/* If we already have a terminal on the given device, use that. If
all such terminals are suspended, create a new one instead. */
diff --git a/src/termhooks.h b/src/termhooks.h
index d21d6ce588a..03416cb8842 100644
--- a/src/termhooks.h
+++ b/src/termhooks.h
@@ -158,6 +158,9 @@ enum event_kind
SELECTION_CLEAR_EVENT, /* Another X client cleared our selection. */
BUFFER_SWITCH_EVENT, /* A process filter has switched buffers. */
DELETE_WINDOW_EVENT, /* An X client said "delete this window". */
+#ifdef HAVE_NTGUI
+ END_SESSION_EVENT, /* The user is logging out or shutting down. */
+#endif
MENU_BAR_EVENT, /* An event generated by the menu bar.
The frame_or_window field's cdr holds the
Lisp-level event value.
@@ -628,6 +631,11 @@ struct terminal
/* Called when a frame's display becomes entirely up to date. */
void (*frame_up_to_date_hook) (struct frame *);
+ /* Called when buffer flipping becomes unblocked after having
+ previously been blocked. Redisplay always blocks buffer flips
+ while it runs. */
+ void (*buffer_flipping_unblocked_hook) (struct frame *);
+
/* Called to delete the device-specific portions of a frame that is
on this terminal device. */
diff --git a/src/textprop.c b/src/textprop.c
index c4e49d98ebc..7af8c698736 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -2043,18 +2043,19 @@ add_text_properties_from_list (Lisp_Object object, Lisp_Object list, Lisp_Object
end-points to NEW_END. */
Lisp_Object
-extend_property_ranges (Lisp_Object list, Lisp_Object new_end)
+extend_property_ranges (Lisp_Object list, Lisp_Object old_end, Lisp_Object new_end)
{
Lisp_Object prev = Qnil, head = list;
ptrdiff_t max = XINT (new_end);
for (; CONSP (list); prev = list, list = XCDR (list))
{
- Lisp_Object item, beg, end;
+ Lisp_Object item, beg;
+ ptrdiff_t end;
item = XCAR (list);
beg = XCAR (item);
- end = XCAR (XCDR (item));
+ end = XINT (XCAR (XCDR (item)));
if (XINT (beg) >= max)
{
@@ -2065,9 +2066,16 @@ extend_property_ranges (Lisp_Object list, Lisp_Object new_end)
else
XSETCDR (prev, XCDR (list));
}
- else if (XINT (end) > max)
- /* The end-point is past the end of the new string. */
- XSETCAR (XCDR (item), new_end);
+ else if ((end == XINT (old_end) && end != max)
+ || end > max)
+ {
+ /* Either the end-point is past the end of the new string,
+ and we need to discard the properties past the new end,
+ or the caller is extending the property range, and we
+ should update all end-points that are on the old end of
+ the range to reflect that. */
+ XSETCAR (XCDR (item), new_end);
+ }
}
return head;
diff --git a/src/unexcw.c b/src/unexcw.c
index afd5413c644..c0d1bc176a5 100644
--- a/src/unexcw.c
+++ b/src/unexcw.c
@@ -21,7 +21,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include "unexec.h"
#include "lisp.h"
-#include <string.h>
#include <stdio.h>
#include <fcntl.h>
#include <a.out.h>
@@ -30,10 +29,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define DOTEXE ".exe"
-extern void report_sheap_usage (int);
-
-extern int bss_sbrk_did_unexec;
-
/*
** header for Windows executable files
*/
@@ -151,7 +146,7 @@ fixup_executable (int fd)
assert (ret == my_edata - (char *) start_address);
++found_data;
if (debug_unexcw)
- printf (" .data, mem start %#lx mem length %d\n",
+ printf (" .data, mem start %#lx mem length %td\n",
start_address, my_edata - (char *) start_address);
if (debug_unexcw)
printf (" .data, file start %d file length %d\n",
@@ -217,7 +212,7 @@ fixup_executable (int fd)
sizeof (exe_header->section_header[i]));
assert (ret == sizeof (exe_header->section_header[i]));
if (debug_unexcw)
- printf (" seek to %ld, write %d\n",
+ printf (" seek to %ld, write %zu\n",
(long) ((char *) &exe_header->section_header[i] -
(char *) exe_header),
sizeof (exe_header->section_header[i]));
@@ -232,7 +227,7 @@ fixup_executable (int fd)
my_endbss - (char *) start_address);
assert (ret == (my_endbss - (char *) start_address));
if (debug_unexcw)
- printf (" .bss, mem start %#lx mem length %d\n",
+ printf (" .bss, mem start %#lx mem length %td\n",
start_address, my_endbss - (char *) start_address);
if (debug_unexcw)
printf (" .bss, file start %d file length %d\n",
@@ -276,14 +271,12 @@ unexec (const char *outfile, const char *infile)
int ret;
int ret2;
- report_sheap_usage (1);
-
infile = add_exe_suffix_if_necessary (infile, infile_buffer);
outfile = add_exe_suffix_if_necessary (outfile, outfile_buffer);
- fd_in = emacs_open (infile, O_RDONLY | O_BINARY, 0);
+ fd_in = emacs_open (infile, O_RDONLY, 0);
assert (fd_in >= 0);
- fd_out = emacs_open (outfile, O_RDWR | O_TRUNC | O_CREAT | O_BINARY, 0755);
+ fd_out = emacs_open (outfile, O_RDWR | O_TRUNC | O_CREAT, 0755);
assert (fd_out >= 0);
for (;;)
{
@@ -302,9 +295,7 @@ unexec (const char *outfile, const char *infile)
ret = emacs_close (fd_in);
assert (ret == 0);
- bss_sbrk_did_unexec = 1;
fixup_executable (fd_out);
- bss_sbrk_did_unexec = 0;
ret = emacs_close (fd_out);
assert (ret == 0);
diff --git a/src/unexelf.c b/src/unexelf.c
index 068d268808a..748e7a42cfa 100644
--- a/src/unexelf.c
+++ b/src/unexelf.c
@@ -329,7 +329,11 @@ unexec (const char *new_name, const char *old_name)
if (old_bss_index == -1)
fatal ("no bss section found");
+#ifdef HAVE_SBRK
new_break = sbrk (0);
+#else
+ new_break = (byte *) old_bss_addr + old_bss_size;
+#endif
new_bss_addr = (ElfW (Addr)) new_break;
bss_size_growth = new_bss_addr - old_bss_addr;
new_data2_size = bss_size_growth;
@@ -461,29 +465,6 @@ unexec (const char *new_name, const char *old_name)
|| !strcmp (old_section_names + new_shdr->sh_name, ".sdata")
|| !strcmp (old_section_names + new_shdr->sh_name, ".lit4")
|| !strcmp (old_section_names + new_shdr->sh_name, ".lit8")
- /* The conditional bit below was in Oliva's original code
- (1999-08-25) and seems to have been dropped by mistake
- subsequently. It prevents a crash at startup under X in
- `IRIX64 6.5 6.5.17m', whether compiled on that release or
- an earlier one. It causes no trouble on the other ELF
- platforms I could test (Irix 6.5.15m, Solaris 8, Debian
- Potato x86, Debian Woody SPARC); however, it's reported
- to cause crashes under some version of GNU/Linux. It's
- not yet clear what's changed in that Irix version to
- cause the problem, or why the fix sometimes fails under
- GNU/Linux. There's probably no good reason to have
- something Irix-specific here, but this will have to do
- for now. IRIX6_5 is the most specific macro we have to
- test. -- fx 2002-10-01
-
- The issue _looks_ as though it's gone away on 6.5.18m,
- but maybe it's still lurking, to be triggered by some
- change in the binary. It appears to concern the dynamic
- loader, but I never got anywhere with an SGI support call
- seeking clues. -- fx 2002-11-29. */
-#ifdef IRIX6_5
- || !strcmp (old_section_names + new_shdr->sh_name, ".got")
-#endif
|| !strcmp (old_section_names + new_shdr->sh_name, ".sdata1")
|| !strcmp (old_section_names + new_shdr->sh_name, ".data1"))
src = (caddr_t) old_shdr->sh_addr;
@@ -665,9 +646,6 @@ unexec (const char *new_name, const char *old_name)
|| !strcmp (old_section_names + shdr->sh_name, ".sdata")
|| !strcmp (old_section_names + shdr->sh_name, ".lit4")
|| !strcmp (old_section_names + shdr->sh_name, ".lit8")
-#ifdef IRIX6_5 /* see above */
- || !strcmp (old_section_names + shdr->sh_name, ".got")
-#endif
|| !strcmp (old_section_names + shdr->sh_name, ".sdata1")
|| !strcmp (old_section_names + shdr->sh_name, ".data1"))
{
diff --git a/src/unexmacosx.c b/src/unexmacosx.c
index f755f7fafd9..5584e693f75 100644
--- a/src/unexmacosx.c
+++ b/src/unexmacosx.c
@@ -85,17 +85,16 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
be changed accordingly.
*/
-/* config.h #define:s malloc/realloc/free and then includes stdlib.h.
- We want the undefined versions, but if config.h includes stdlib.h
- with the #define:s in place, the prototypes will be wrong and we get
- warnings. To prevent that, include stdlib.h before config.h. */
-
-#include <stdlib.h>
#include <config.h>
+
+/* Although <config.h> redefines malloc to unexec_malloc, etc., this
+ file wants stdlib.h to declare the originals. */
#undef malloc
#undef realloc
#undef free
+#include <stdlib.h>
+
#include "unexec.h"
#include "lisp.h"
diff --git a/src/unexw32.c b/src/unexw32.c
index 15aa7263bf8..f4183dc976f 100644
--- a/src/unexw32.c
+++ b/src/unexw32.c
@@ -50,10 +50,6 @@ extern char *my_begbss_static;
/* Basically, our "initialized" flag. */
BOOL using_dynamic_heap = FALSE;
-int open_input_file (file_data *p_file, char *name);
-int open_output_file (file_data *p_file, char *name, unsigned long size);
-void close_file_data (file_data *p_file);
-
void get_section_info (file_data *p_file);
void copy_executable_and_dump_data (file_data *, file_data *);
void dump_bss_and_heap (file_data *p_infile, file_data *p_outfile);
@@ -81,14 +77,17 @@ DWORD_PTR extra_bss_size_static = 0;
#define _start __start
#endif
+extern void mainCRTStartup (void);
+
/* Startup code for running on NT. When we are running as the dumped
version, we need to bootstrap our heap and .bss section into our
address space before we can actually hand off control to the startup
code supplied by NT (primarily because that code relies upon malloc ()). */
+void _start (void);
+
void
_start (void)
{
- extern void mainCRTStartup (void);
#if 1
/* Give us a way to debug problems with crashes on startup when
@@ -205,7 +204,7 @@ close_file_data (file_data *p_file)
/* Return pointer to section header for named section. */
IMAGE_SECTION_HEADER *
-find_section (char * name, IMAGE_NT_HEADERS * nt_header)
+find_section (const char * name, IMAGE_NT_HEADERS * nt_header)
{
PIMAGE_SECTION_HEADER section;
int i;
@@ -214,7 +213,7 @@ find_section (char * name, IMAGE_NT_HEADERS * nt_header)
for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++)
{
- if (strcmp (section->Name, name) == 0)
+ if (strcmp ((char *)section->Name, name) == 0)
return section;
section++;
}
@@ -249,9 +248,10 @@ rva_to_section (DWORD_PTR rva, IMAGE_NT_HEADERS * nt_header)
return NULL;
}
+#if 0 /* unused */
/* Return pointer to section header for section containing the given
offset in its raw data area. */
-IMAGE_SECTION_HEADER *
+static IMAGE_SECTION_HEADER *
offset_to_section (DWORD_PTR offset, IMAGE_NT_HEADERS * nt_header)
{
PIMAGE_SECTION_HEADER section;
@@ -268,11 +268,12 @@ offset_to_section (DWORD_PTR offset, IMAGE_NT_HEADERS * nt_header)
}
return NULL;
}
+#endif
/* Return offset to an object in dst, given offset in src. We assume
there is at least one section in both src and dst images, and that
the some sections may have been added to dst (after sections in src). */
-DWORD_PTR
+static DWORD_PTR
relocate_offset (DWORD_PTR offset,
IMAGE_NT_HEADERS * src_nt_header,
IMAGE_NT_HEADERS * dst_nt_header)
@@ -306,9 +307,6 @@ relocate_offset (DWORD_PTR offset,
(dst_section->PointerToRawData - src_section->PointerToRawData);
}
-#define OFFSET_TO_RVA(offset, section) \
- ((section)->VirtualAddress + ((DWORD_PTR)(offset) - (section)->PointerToRawData))
-
#define RVA_TO_OFFSET(rva, section) \
((section)->PointerToRawData + ((DWORD_PTR)(rva) - (section)->VirtualAddress))
@@ -318,15 +316,20 @@ relocate_offset (DWORD_PTR offset,
/* Convert address in executing image to RVA. */
#define PTR_TO_RVA(ptr) ((DWORD_PTR)(ptr) - (DWORD_PTR) GetModuleHandle (NULL))
-#define RVA_TO_PTR(var,section,filedata) \
- ((unsigned char *)(RVA_TO_OFFSET (var,section) + (filedata).file_base))
-
#define PTR_TO_OFFSET(ptr, pfile_data) \
((unsigned char *)(ptr) - (pfile_data)->file_base)
#define OFFSET_TO_PTR(offset, pfile_data) \
((pfile_data)->file_base + (DWORD_PTR)(offset))
+#if 0 /* unused */
+#define OFFSET_TO_RVA(offset, section) \
+ ((section)->VirtualAddress + ((DWORD_PTR)(offset) - (section)->PointerToRawData))
+
+#define RVA_TO_PTR(var,section,filedata) \
+ ((unsigned char *)(RVA_TO_OFFSET (var,section) + (filedata).file_base))
+#endif
+
/* Flip through the executable and cache the info necessary for dumping. */
void
diff --git a/src/vm-limit.c b/src/vm-limit.c
index d32050fd015..d53eecae3d3 100644
--- a/src/vm-limit.c
+++ b/src/vm-limit.c
@@ -51,9 +51,16 @@ char data_start[1] = { 1 };
# endif
#endif
-/* From gmalloc.c. */
-extern void (* __after_morecore_hook) (void);
+#ifdef HAVE_MALLOC_H
+# include <malloc.h>
+#endif
+#ifndef DOUG_LEA_MALLOC
+# ifndef __MALLOC_HOOK_VOLATILE
+# define __MALLOC_HOOK_VOLATILE volatile
+# endif
extern void *(*__morecore) (ptrdiff_t);
+extern void (*__MALLOC_HOOK_VOLATILE __after_morecore_hook) (void);
+#endif
/* From ralloc.c. */
#ifdef REL_ALLOC
diff --git a/src/w32.c b/src/w32.c
index 793bc0f28d0..ad7d94a21d2 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -21,6 +21,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
Geoff Voelker (voelker@cs.washington.edu) 7-29-94
*/
+#define DEFER_MS_W32_H
+#include <config.h>
+
#include <mingw_time.h>
#include <stddef.h> /* for offsetof */
#include <stdlib.h>
@@ -37,9 +40,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <sys/utime.h>
#include <math.h>
-/* must include CRT headers *before* config.h */
+/* Include (most) CRT headers *before* ms-w32.h. */
+#include <ms-w32.h>
-#include <config.h>
+#include <string.h> /* for strerror, needed by sys_strerror */
#include <mbstring.h> /* for _mbspbrk, _mbslwr, _mbsrchr, ... */
#undef access
@@ -66,19 +70,30 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#undef localtime
+char *sys_ctime (const time_t *);
+int sys_chdir (const char *);
+int sys_creat (const char *, int);
+FILE *sys_fopen (const char *, const char *);
+int sys_mkdir (const char *);
+int sys_open (const char *, int, int);
+int sys_rename (char const *, char const *);
+int sys_rmdir (const char *);
+int sys_close (int);
+int sys_dup2 (int, int);
+int sys_read (int, char *, unsigned int);
+int sys_write (int, const void *, unsigned int);
+struct tm *sys_localtime (const time_t *);
+
+#ifdef HAVE_MODULES
+extern void dynlib_reset_last_error (void);
+#endif
+
#include "lisp.h"
#include "epaths.h" /* for PATH_EXEC */
#include <pwd.h>
#include <grp.h>
-/* MinGW64 defines these in its _mingw.h. */
-#ifndef _ANONYMOUS_UNION
-# define _ANONYMOUS_UNION
-#endif
-#ifndef _ANONYMOUS_STRUCT
-# define _ANONYMOUS_STRUCT
-#endif
#include <windows.h>
/* Some versions of compiler define MEMORYSTATUSEX, some don't, so we
use a different name to avoid compilation problems. */
@@ -227,6 +242,7 @@ typedef struct _REPARSE_DATA_BUFFER {
#include <wincrypt.h>
#include <c-strcase.h>
+#include <utimens.h> /* for fdutimens */
#include "w32.h"
#include <dirent.h>
@@ -246,7 +262,6 @@ typedef struct _REPARSE_DATA_BUFFER {
typedef HRESULT (WINAPI * ShGetFolderPath_fn)
(IN HWND, IN int, IN HANDLE, IN DWORD, OUT char *);
-void globals_of_w32 (void);
static DWORD get_rid (PSID);
static int is_symlink (const char *);
static char * chase_symlinks (const char *);
@@ -260,8 +275,6 @@ extern int sys_select (int, SELECT_TYPE *, SELECT_TYPE *, SELECT_TYPE *,
struct timespec *, void *);
extern int sys_dup (int);
-
-
/* Initialization states.
@@ -312,6 +325,7 @@ static BOOL g_b_init_set_named_security_info_a;
static BOOL g_b_init_get_adapters_info;
BOOL g_b_init_compare_string_w;
+BOOL g_b_init_debug_break_process;
/*
BEGIN: Wrapper functions around OpenProcessToken
@@ -512,6 +526,8 @@ static Lisp_Object ltime (ULONGLONG);
/* Get total user and system times for get-internal-run-time.
Returns a list of integers if the times are provided by the OS
(NT derivatives), otherwise it returns the result of current-time. */
+Lisp_Object w32_get_internal_run_time (void);
+
Lisp_Object
w32_get_internal_run_time (void)
{
@@ -2485,13 +2501,42 @@ sys_putenv (char *str)
return unsetenv (str);
}
+ if (strncmp (str, "TZ=<", 4) == 0)
+ {
+ /* MS-Windows does not support POSIX.1-2001 angle-bracket TZ
+ abbreviation syntax. Convert to POSIX.1-1988 syntax if possible,
+ and to the undocumented placeholder "ZZZ" otherwise. */
+ bool supported_abbr = true;
+ for (char *p = str + 4; *p; p++)
+ {
+ if (('0' <= *p && *p <= '9') || *p == '-' || *p == '+')
+ supported_abbr = false;
+ else if (*p == '>')
+ {
+ ptrdiff_t abbrlen;
+ if (supported_abbr)
+ {
+ abbrlen = p - (str + 4);
+ memmove (str + 3, str + 4, abbrlen);
+ }
+ else
+ {
+ abbrlen = 3;
+ memset (str + 3, 'Z', abbrlen);
+ }
+ memmove (str + 3 + abbrlen, p + 1, strlen (p));
+ break;
+ }
+ }
+ }
+
return _putenv (str);
}
#define REG_ROOT "SOFTWARE\\GNU\\Emacs"
LPBYTE
-w32_get_resource (char *key, LPDWORD lpdwtype)
+w32_get_resource (const char *key, LPDWORD lpdwtype)
{
LPBYTE lpvalue;
HKEY hrootkey = NULL;
@@ -2600,8 +2645,8 @@ init_environment (char ** argv)
static const struct env_entry
{
- char * name;
- char * def_value;
+ const char * name;
+ const char * def_value;
} dflt_envvars[] =
{
/* If the default value is NULL, we will use the value from the
@@ -2761,14 +2806,14 @@ init_environment (char ** argv)
{
/* If not found in any directory, use the
default as the last resort. */
- lpval = env_vars[i].def_value;
+ lpval = (char *)env_vars[i].def_value;
dwType = REG_EXPAND_SZ;
}
} while (*pstart);
}
else
{
- lpval = env_vars[i].def_value;
+ lpval = (char *)env_vars[i].def_value;
dwType = REG_EXPAND_SZ;
}
if (strcmp (env_vars[i].name, "HOME") == 0 && !appdata)
@@ -2789,7 +2834,7 @@ init_environment (char ** argv)
if (dwType == REG_EXPAND_SZ)
ExpandEnvironmentStrings ((LPSTR) lpval, buf1, sizeof (buf1));
else if (dwType == REG_SZ)
- strcpy (buf1, lpval);
+ strcpy (buf1, (char *)lpval);
if (dwType == REG_EXPAND_SZ || dwType == REG_SZ)
{
_snprintf (buf2, sizeof (buf2)-1, "%s=%s", env_vars[i].name,
@@ -2964,7 +3009,7 @@ char *
sys_ctime (const time_t *t)
{
char *str = (char *) ctime (t);
- return (str ? str : "Sun Jan 01 00:00:00 1970");
+ return (str ? str : (char *)"Sun Jan 01 00:00:00 1970");
}
/* Emulate sleep...we could have done this with a define, but that
@@ -3228,6 +3273,8 @@ is_fat_volume (const char * name, const char ** pPath)
/* Convert all slashes in a filename to backslashes, and map filename
to a valid 8.3 name if necessary. The result is a pointer to a
static buffer, so CAVEAT EMPTOR! */
+const char *map_w32_filename (const char *, const char **);
+
const char *
map_w32_filename (const char * name, const char ** pPath)
{
@@ -4433,7 +4480,7 @@ sys_rename_replace (const char *oldname, const char *newname, BOOL force)
{
/* Force temp name to require a manufactured 8.3 alias - this
seems to make the second rename work properly. */
- sprintf (p, "_.%s.%u", o, i);
+ sprintf (p, "_.%s.%d", o, i);
i++;
result = rename (oldname_a, temp_a);
}
@@ -4861,6 +4908,8 @@ get_file_owner_and_group (PSECURITY_DESCRIPTOR psd, struct stat *st)
}
/* Return non-zero if NAME is a potentially slow filesystem. */
+int is_slow_fs (const char *);
+
int
is_slow_fs (const char *name)
{
@@ -7205,6 +7254,10 @@ int (PASCAL *pfn_recvfrom) (SOCKET s, char * buf, int len, int flags,
int (PASCAL *pfn_sendto) (SOCKET s, const char * buf, int len, int flags,
const struct sockaddr * to, int tolen);
+int (PASCAL *pfn_getaddrinfo) (const char *, const char *,
+ const struct addrinfo *, struct addrinfo **);
+void (PASCAL *pfn_freeaddrinfo) (struct addrinfo *);
+
/* SetHandleInformation is only needed to make sockets non-inheritable. */
BOOL (WINAPI *pfn_SetHandleInformation) (HANDLE object, DWORD mask, DWORD flags);
#ifndef HANDLE_FLAG_INHERIT
@@ -7214,6 +7267,8 @@ BOOL (WINAPI *pfn_SetHandleInformation) (HANDLE object, DWORD mask, DWORD flags)
HANDLE winsock_lib;
static int winsock_inuse;
+BOOL term_winsock (void);
+
BOOL
term_winsock (void)
{
@@ -7287,6 +7342,16 @@ init_winsock (int load_now)
LOAD_PROC (sendto);
#undef LOAD_PROC
+ /* Try loading functions not available before XP. */
+ pfn_getaddrinfo = (void *) GetProcAddress (winsock_lib, "getaddrinfo");
+ pfn_freeaddrinfo = (void *) GetProcAddress (winsock_lib, "freeaddrinfo");
+ /* Paranoia: these two functions should go together, so if one
+ is absent, we cannot use the other. */
+ if (pfn_getaddrinfo == NULL)
+ pfn_freeaddrinfo = NULL;
+ else if (pfn_freeaddrinfo == NULL)
+ pfn_getaddrinfo = NULL;
+
/* specify version 1.1 of winsock */
if (pfn_WSAStartup (0x101, &winsockData) == 0)
{
@@ -7361,7 +7426,7 @@ check_errno (void)
/* Extend strerror to handle the winsock-specific error codes. */
struct {
int errnum;
- char * msg;
+ const char * msg;
} _wsa_errlist[] = {
{WSAEINTR , "Interrupted function call"},
{WSAEBADF , "Bad file descriptor"},
@@ -7445,7 +7510,7 @@ sys_strerror (int error_no)
for (i = 0; _wsa_errlist[i].errnum >= 0; i++)
if (_wsa_errlist[i].errnum == error_no)
- return _wsa_errlist[i].msg;
+ return (char *)_wsa_errlist[i].msg;
sprintf (unknown_msg, "Unidentified error: %d", error_no);
return unknown_msg;
@@ -7737,6 +7802,117 @@ sys_getpeername (int s, struct sockaddr *addr, int * namelen)
}
int
+sys_getaddrinfo (const char *node, const char *service,
+ const struct addrinfo *hints, struct addrinfo **res)
+{
+ int rc;
+
+ if (winsock_lib == NULL)
+ {
+ errno = ENETDOWN;
+ return SOCKET_ERROR;
+ }
+
+ check_errno ();
+ if (pfn_getaddrinfo)
+ rc = pfn_getaddrinfo (node, service, hints, res);
+ else
+ {
+ int port = 0;
+ struct hostent *host_info;
+ struct gai_storage {
+ struct addrinfo addrinfo;
+ struct sockaddr_in sockaddr_in;
+ } *gai_storage;
+
+ /* We don't (yet) support any flags, as Emacs doesn't need that. */
+ if (hints && hints->ai_flags != 0)
+ return WSAEINVAL;
+ /* NODE cannot be NULL, since process.c has fallbacks for that. */
+ if (!node)
+ return WSAHOST_NOT_FOUND;
+
+ if (service)
+ {
+ const char *protocol =
+ (hints && hints->ai_socktype == SOCK_DGRAM) ? "udp" : "tcp";
+ struct servent *srv = sys_getservbyname (service, protocol);
+
+ if (srv)
+ port = srv->s_port;
+ else if (*service >= '0' && *service <= '9')
+ {
+ char *endp;
+
+ port = strtoul (service, &endp, 10);
+ if (*endp || port > 65536)
+ return WSAHOST_NOT_FOUND;
+ port = sys_htons ((unsigned short) port);
+ }
+ else
+ return WSAHOST_NOT_FOUND;
+ }
+
+ gai_storage = xzalloc (sizeof *gai_storage);
+ gai_storage->sockaddr_in.sin_port = port;
+ host_info = sys_gethostbyname (node);
+ if (host_info)
+ {
+ memcpy (&gai_storage->sockaddr_in.sin_addr,
+ host_info->h_addr, host_info->h_length);
+ gai_storage->sockaddr_in.sin_family = host_info->h_addrtype;
+ }
+ else
+ {
+ /* Attempt to interpret host as numeric inet address. */
+ unsigned long numeric_addr = sys_inet_addr (node);
+
+ if (numeric_addr == -1)
+ {
+ free (gai_storage);
+ return WSAHOST_NOT_FOUND;
+ }
+
+ memcpy (&gai_storage->sockaddr_in.sin_addr, &numeric_addr,
+ sizeof (gai_storage->sockaddr_in.sin_addr));
+ gai_storage->sockaddr_in.sin_family = (hints) ? hints->ai_family : 0;
+ }
+
+ gai_storage->addrinfo.ai_addr =
+ (struct sockaddr *)&gai_storage->sockaddr_in;
+ gai_storage->addrinfo.ai_addrlen = sizeof (gai_storage->sockaddr_in);
+ gai_storage->addrinfo.ai_protocol = (hints) ? hints->ai_protocol : 0;
+ gai_storage->addrinfo.ai_socktype = (hints) ? hints->ai_socktype : 0;
+ gai_storage->addrinfo.ai_family = gai_storage->sockaddr_in.sin_family;
+ gai_storage->addrinfo.ai_next = NULL;
+
+ *res = &gai_storage->addrinfo;
+ rc = 0;
+ }
+
+ return rc;
+}
+
+void
+sys_freeaddrinfo (struct addrinfo *ai)
+{
+ if (winsock_lib == NULL)
+ {
+ errno = ENETDOWN;
+ return;
+ }
+
+ check_errno ();
+ if (pfn_freeaddrinfo)
+ pfn_freeaddrinfo (ai);
+ else
+ {
+ eassert (ai->ai_next == NULL);
+ xfree (ai);
+ }
+}
+
+int
sys_shutdown (int s, int how)
{
if (winsock_lib == NULL)
@@ -8059,17 +8235,33 @@ sys_dup2 (int src, int dst)
return -1;
}
- /* make sure we close the destination first if it's a pipe or socket */
- if (src != dst && fd_info[dst].flags != 0)
+ /* MS _dup2 seems to have weird side effect when invoked with 2
+ identical arguments: an attempt to fclose the corresponding stdio
+ stream after that hangs (we do close standard streams in
+ init_ntproc). Attempt to avoid that by not calling _dup2 that
+ way: if SRC is valid, we know that dup2 should be a no-op, so do
+ nothing and return DST. */
+ if (src == dst)
+ {
+ if ((HANDLE)_get_osfhandle (src) == INVALID_HANDLE_VALUE)
+ {
+ errno = EBADF;
+ return -1;
+ }
+ return dst;
+ }
+
+ /* Make sure we close the destination first if it's a pipe or socket. */
+ if (fd_info[dst].flags != 0)
sys_close (dst);
rc = _dup2 (src, dst);
if (rc == 0)
{
- /* duplicate our internal info as well */
+ /* Duplicate our internal info as well. */
fd_info[dst] = fd_info[src];
}
- return rc;
+ return rc == 0 ? dst : rc;
}
int
@@ -8650,6 +8842,30 @@ sys_write (int fd, const void * buffer, unsigned int count)
unsigned long nblock = 0;
if (winsock_lib == NULL) emacs_abort ();
+ child_process *cp = fd_info[fd].cp;
+
+ /* If this is a non-blocking socket whose connection is in
+ progress or terminated with an error already, return the
+ proper error code to the caller. */
+ if (cp != NULL && (fd_info[fd].flags & FILE_CONNECT) != 0)
+ {
+ /* In case connection is in progress, ENOTCONN that would
+ result from calling pfn_send is not what callers expect. */
+ if (cp->status != STATUS_CONNECT_FAILED)
+ {
+ errno = EWOULDBLOCK;
+ return -1;
+ }
+ /* In case connection failed, use the actual error code
+ stashed by '_sys_wait_connect' in cp->errcode. */
+ else if (cp->errcode != 0)
+ {
+ pfn_WSASetLastError (cp->errcode);
+ set_errno ();
+ return -1;
+ }
+ }
+
/* TODO: implement select() properly so non-blocking I/O works. */
/* For now, make sure the write blocks. */
if (fd_info[fd].flags & FILE_NDELAY)
@@ -8657,6 +8873,13 @@ sys_write (int fd, const void * buffer, unsigned int count)
nchars = pfn_send (SOCK_HANDLE (fd), buffer, count, 0);
+ if (nchars == SOCKET_ERROR)
+ {
+ set_errno ();
+ DebPrint (("sys_write.send failed with error %d on socket %ld\n",
+ pfn_WSAGetLastError (), SOCK_HANDLE (fd)));
+ }
+
/* Set the socket back to non-blocking if it was before,
for other operations that support it. */
if (fd_info[fd].flags & FILE_NDELAY)
@@ -8664,13 +8887,6 @@ sys_write (int fd, const void * buffer, unsigned int count)
nblock = 1;
pfn_ioctlsocket (SOCK_HANDLE (fd), FIONBIO, &nblock);
}
-
- if (nchars == SOCKET_ERROR)
- {
- DebPrint (("sys_write.send failed with error %d on socket %ld\n",
- pfn_WSAGetLastError (), SOCK_HANDLE (fd)));
- set_errno ();
- }
}
else
{
@@ -8743,8 +8959,6 @@ sys_write (int fd, const void * buffer, unsigned int count)
/* Emulation of SIOCGIFCONF and getifaddrs, see process.c. */
-extern Lisp_Object conv_sockaddr_to_lisp (struct sockaddr *, int);
-
/* Return information about network interface IFNAME, or about all
interfaces (if IFNAME is nil). */
static Lisp_Object
@@ -9435,6 +9649,7 @@ globals_of_w32 (void)
g_b_init_set_named_security_info_a = 0;
g_b_init_get_adapters_info = 0;
g_b_init_compare_string_w = 0;
+ g_b_init_debug_break_process = 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
@@ -9457,7 +9672,6 @@ globals_of_w32 (void)
w32_unicode_filenames = 1;
#ifdef HAVE_MODULES
- extern void dynlib_reset_last_error (void);
dynlib_reset_last_error ();
#endif
diff --git a/src/w32.h b/src/w32.h
index 42a1c423ce7..702bb5255cd 100644
--- a/src/w32.h
+++ b/src/w32.h
@@ -162,7 +162,7 @@ extern void reset_standard_handles (int in, int out,
int err, HANDLE handles[4]);
/* Return the string resource associated with KEY of type TYPE. */
-extern LPBYTE w32_get_resource (char * key, LPDWORD type);
+extern LPBYTE w32_get_resource (const char * key, LPDWORD type);
extern void release_listen_threads (void);
extern void init_ntproc (int);
diff --git a/src/w32console.c b/src/w32console.c
index 512d20dd242..c71afb6f888 100644
--- a/src/w32console.c
+++ b/src/w32console.c
@@ -35,6 +35,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "w32common.h" /* for os_subtype */
#include "w32inevt.h"
+#ifdef WINDOWSNT
+#include "w32.h" /* for syms_of_ntterm */
+#endif
+
static void w32con_move_cursor (struct frame *f, int row, int col);
static void w32con_clear_to_end (struct frame *f);
static void w32con_clear_frame (struct frame *f);
@@ -67,6 +71,8 @@ int w32_console_unicode_input;
someone hits ^C in a 'suspended' session (child shell).
Also ignore Ctrl-Break signals. */
+BOOL ctrl_c_handler (unsigned long);
+
BOOL
ctrl_c_handler (unsigned long type)
{
@@ -509,11 +515,15 @@ w32con_update_end (struct frame * f)
stubs from termcap.c
***********************************************************************/
+void sys_tputs (char *, int, int (*) (int));
+
void
sys_tputs (char *str, int nlines, int (*outfun) (int))
{
}
+char *sys_tgetstr (char *, char **);
+
char *
sys_tgetstr (char *cap, char **area)
{
@@ -528,33 +538,45 @@ sys_tgetstr (char *cap, char **area)
struct tty_display_info *current_tty = NULL;
int cost = 0;
+int evalcost (int);
+
int
evalcost (int c)
{
return c;
}
+int cmputc (int);
+
int
cmputc (int c)
{
return c;
}
+void cmcheckmagic (struct tty_display_info *);
+
void
cmcheckmagic (struct tty_display_info *tty)
{
}
+void cmcostinit (struct tty_display_info *);
+
void
cmcostinit (struct tty_display_info *tty)
{
}
+void cmgoto (struct tty_display_info *, int, int);
+
void
cmgoto (struct tty_display_info *tty, int row, int col)
{
}
+void Wcm_clear (struct tty_display_info *);
+
void
Wcm_clear (struct tty_display_info *tty)
{
@@ -589,8 +611,6 @@ w32_face_attributes (struct frame *f, int face_id)
WORD char_attr;
struct face *face = FACE_FROM_ID (f, face_id);
- eassert (face != NULL);
-
char_attr = char_attr_normal;
/* Reverse the default color if requested. If background and
@@ -759,6 +779,9 @@ initialize_w32_display (struct terminal *term, int *width, int *height)
/* Setup w32_display_info structure for this frame. */
w32_initialize_display_info (build_string ("Console"));
+
+ /* Set up the keyboard hook. */
+ setup_w32_kbdhook ();
}
diff --git a/src/w32fns.c b/src/w32fns.c
index 27c0d65fbd0..8c8272b16d4 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -20,6 +20,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Added by Kevin Gallo */
#include <config.h>
+/* Override API version to get the latest functionality. */
+#undef _WIN32_WINNT
+#define _WIN32_WINNT 0x0600
#include <signal.h>
#include <stdio.h>
@@ -41,6 +44,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "coding.h"
#include "w32common.h"
+#include "w32inevt.h"
#ifdef WINDOWSNT
#include <mbstring.h>
@@ -52,6 +56,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "w32.h"
#endif
+#include <basetyps.h>
+#include <unknwn.h>
#include <commctrl.h>
#include <commdlg.h>
#include <shellapi.h>
@@ -68,15 +74,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define FOF_NO_CONNECTED_ELEMENTS 0x2000
#endif
-void syms_of_w32fns (void);
-void globals_of_w32fns (void);
-
-extern void free_frame_menubar (struct frame *);
extern int w32_console_toggle_lock_key (int, Lisp_Object);
extern void w32_menu_display_help (HWND, HMENU, UINT, UINT);
extern void w32_free_menu_strings (HWND);
extern const char *map_w32_filename (const char *, const char **);
-extern char * w32_strerror (int error_no);
#ifndef IDC_HAND
#define IDC_HAND MAKEINTRESOURCE(32649)
@@ -185,11 +186,7 @@ MonitorFromWindow_Proc monitor_from_window_fn = NULL;
EnumDisplayMonitors_Proc enum_display_monitors_fn = NULL;
GetTitleBarInfo_Proc get_title_bar_info_fn = NULL;
-#ifdef NTGUI_UNICODE
-#define unicode_append_menu AppendMenuW
-#else /* !NTGUI_UNICODE */
extern AppendMenuW_Proc unicode_append_menu;
-#endif /* NTGUI_UNICODE */
/* Flag to selectively ignore WM_IME_CHAR messages. */
static int ignore_ime_char = 0;
@@ -216,7 +213,6 @@ static HWND w32_visible_system_caret_hwnd;
static int w32_unicode_gui;
/* From w32menu.c */
-extern HMENU current_popup_menu;
int menubar_in_use = 0;
/* From w32uniscribe.c */
@@ -251,6 +247,40 @@ HINSTANCE hinst = NULL;
static unsigned int sound_type = 0xFFFFFFFF;
#define MB_EMACS_SILENT (0xFFFFFFFF - 1)
+/* Special virtual key code for indicating "any" key. */
+#define VK_ANY 0xFF
+
+#ifndef WM_WTSSESSION_CHANGE
+/* 32-bit MinGW does not define these constants. */
+# define WM_WTSSESSION_CHANGE 0x02B1
+# define WTS_SESSION_LOCK 0x7
+#endif
+
+/* Keyboard hook state data. */
+static struct
+{
+ int hook_count; /* counter, if several windows are created */
+ HHOOK hook; /* hook handle */
+ HWND console; /* console window handle */
+
+ int lwindown; /* Left Windows key currently pressed (and hooked) */
+ int rwindown; /* Right Windows key currently pressed (and hooked) */
+ int winsdown; /* Number of handled keys currently pressed */
+ int send_win_up; /* Pass through the keyup for this Windows key press? */
+ int suppress_lone; /* Suppress simulated Windows keydown-keyup for this press? */
+ int winseen; /* Windows keys seen during this press? */
+
+ char alt_hooked[256]; /* hook Alt+[this key]? */
+ char lwin_hooked[256]; /* hook left Win+[this key]? */
+ char rwin_hooked[256]; /* hook right Win+[this key]? */
+} kbdhook;
+typedef HWND (WINAPI *GetConsoleWindow_Proc) (void);
+
+typedef BOOL (WINAPI *IsDebuggerPresent_Proc) (void);
+
+/* stdin, from w32console.c */
+extern HANDLE keyboard_handle;
+
/* Let the user specify a display with a frame.
nil stands for the selected frame--or, if that is not a w32 frame,
the first display on the list. */
@@ -327,10 +357,7 @@ void x_set_cursor_type (struct frame *, Lisp_Object, Lisp_Object);
void x_set_icon_type (struct frame *, Lisp_Object, Lisp_Object);
void x_set_icon_name (struct frame *, Lisp_Object, Lisp_Object);
void x_explicitly_set_name (struct frame *, Lisp_Object, Lisp_Object);
-void x_set_menu_bar_lines (struct frame *, Lisp_Object, Lisp_Object);
void x_set_title (struct frame *, Lisp_Object, Lisp_Object);
-void x_set_tool_bar_lines (struct frame *, Lisp_Object, Lisp_Object);
-void x_set_internal_border_width (struct frame *f, Lisp_Object, Lisp_Object);
/* Store the screen positions of frame F into XPTR and YPTR.
@@ -453,7 +480,7 @@ if the entry is new. */)
/* The default colors for the w32 color map */
typedef struct colormap_t
{
- char *name;
+ const char *name;
COLORREF colorref;
} colormap_t;
@@ -791,7 +818,7 @@ add_system_logical_colors_to_map (Lisp_Object *system_colors)
NULL, NULL, (LPBYTE)color_buffer, &color_size)
== ERROR_SUCCESS)
{
- int r, g, b;
+ unsigned r, g, b;
if (sscanf (color_buffer, " %u %u %u", &r, &g, &b) == 3)
*system_colors = Fcons (Fcons (build_string (full_name_buffer),
make_number (RGB (r, g, b))),
@@ -1206,7 +1233,7 @@ w32_defined_color (struct frame *f, const char *color, XColor *color_def,
If F is not a color screen, return DEF (default) regardless of what
ARG says. */
-int
+static int
x_decode_color (struct frame *f, Lisp_Object arg, int def)
{
XColor cdef;
@@ -1489,7 +1516,7 @@ x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
Note that this does not fully take effect if done before
F has a window. */
-void
+static void
x_set_border_pixel (struct frame *f, int pix)
{
@@ -1600,7 +1627,7 @@ x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
#endif
}
-void
+static void
x_clear_under_internal_border (struct frame *f)
{
int border = FRAME_INTERNAL_BORDER_WIDTH (f);
@@ -1633,7 +1660,7 @@ x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldva
if (border != FRAME_INTERNAL_BORDER_WIDTH (f))
{
- FRAME_INTERNAL_BORDER_WIDTH (f) = border;
+ f->internal_border_width = border;
if (FRAME_X_WINDOW (f) != 0)
{
@@ -1826,7 +1853,7 @@ w32_set_title_bar_text (struct frame *f, Lisp_Object name)
suggesting a new name, which lisp code should override; if
F->explicit_name is set, ignore the new name; otherwise, set it. */
-void
+static void
x_set_name (struct frame *f, Lisp_Object name, bool explicit)
{
/* Make sure that requests from lisp code override requests from
@@ -1931,6 +1958,8 @@ x_set_scroll_bar_default_height (struct frame *f)
/* Subroutines for creating a frame. */
+Cursor w32_load_cursor (LPCTSTR);
+
Cursor
w32_load_cursor (LPCTSTR name)
{
@@ -2074,6 +2103,365 @@ my_post_msg (W32Msg * wmsg, HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
post_msg (wmsg);
}
+#ifdef WINDOWSNT
+/* The Windows keyboard hook callback. */
+static LRESULT CALLBACK
+funhook (int code, WPARAM w, LPARAM l)
+{
+ INPUT inputs[2];
+ HWND focus = GetFocus ();
+ int console = 0;
+ KBDLLHOOKSTRUCT const *hs = (KBDLLHOOKSTRUCT*)l;
+
+ if (code < 0 || (hs->flags & LLKHF_INJECTED))
+ return CallNextHookEx (0, code, w, l);
+
+ /* The keyboard hook sees keyboard input on all processes (except
+ elevated ones, when Emacs itself is not elevated). As such,
+ care must be taken to only filter out keyboard input when Emacs
+ itself is on the foreground.
+
+ GetFocus returns a non-NULL window if another application is active,
+ and always for a console Emacs process. For a console Emacs, determine
+ focus by checking if the current foreground window is the process's
+ console window. */
+ if (focus == NULL && kbdhook.console != NULL)
+ {
+ if (GetForegroundWindow () == kbdhook.console)
+ {
+ focus = kbdhook.console;
+ console = 1;
+ }
+ }
+
+ /* First, check hooks for the left and right Windows keys. */
+ if (hs->vkCode == VK_LWIN || hs->vkCode == VK_RWIN)
+ {
+ if (focus != NULL && (w == WM_KEYDOWN || w == WM_SYSKEYDOWN))
+ {
+ /* The key is being pressed in an Emacs window. */
+ if (hs->vkCode == VK_LWIN && !kbdhook.lwindown)
+ {
+ kbdhook.lwindown = 1;
+ kbdhook.winseen = 1;
+ kbdhook.winsdown++;
+ }
+ else if (hs->vkCode == VK_RWIN && !kbdhook.rwindown)
+ {
+ kbdhook.rwindown = 1;
+ kbdhook.winseen = 1;
+ kbdhook.winsdown++;
+ }
+ /* Returning 1 here drops the keypress without further processing.
+ If the keypress was allowed to go through, the normal Windows
+ hotkeys would take over. */
+ return 1;
+ }
+ else if (kbdhook.winsdown > 0 && (w == WM_KEYUP || w == WM_SYSKEYUP))
+ {
+ /* A key that has been captured earlier is being released now. */
+ if (hs->vkCode == VK_LWIN && kbdhook.lwindown)
+ {
+ kbdhook.lwindown = 0;
+ kbdhook.winsdown--;
+ }
+ else if (hs->vkCode == VK_RWIN && kbdhook.rwindown)
+ {
+ kbdhook.rwindown = 0;
+ kbdhook.winsdown--;
+ }
+ if (kbdhook.winsdown == 0 && kbdhook.winseen)
+ {
+ if (!kbdhook.suppress_lone)
+ {
+ /* The Windows key was pressed, then released,
+ without any other key pressed simultaneously.
+ Normally, this opens the Start menu, but the user
+ can prevent this by setting the
+ w32-pass-[lr]window-to-system variable to
+ NIL. */
+ if ((hs->vkCode == VK_LWIN && !NILP (Vw32_pass_lwindow_to_system)) ||
+ (hs->vkCode == VK_RWIN && !NILP (Vw32_pass_rwindow_to_system)))
+ {
+ /* Not prevented - Simulate the keypress to the system. */
+ memset (inputs, 0, sizeof (inputs));
+ inputs[0].type = INPUT_KEYBOARD;
+ inputs[0].ki.wVk = hs->vkCode;
+ inputs[0].ki.wScan = hs->vkCode;
+ inputs[0].ki.dwFlags = KEYEVENTF_EXTENDEDKEY;
+ inputs[0].ki.time = 0;
+ inputs[1].type = INPUT_KEYBOARD;
+ inputs[1].ki.wVk = hs->vkCode;
+ inputs[1].ki.wScan = hs->vkCode;
+ inputs[1].ki.dwFlags
+ = KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP;
+ inputs[1].ki.time = 0;
+ SendInput (2, inputs, sizeof (INPUT));
+ }
+ else if (focus != NULL)
+ {
+ /* When not passed to system, must simulate privately to Emacs. */
+ PostMessage (focus, WM_SYSKEYDOWN, hs->vkCode, 0);
+ PostMessage (focus, WM_SYSKEYUP, hs->vkCode, 0);
+ }
+ }
+ }
+ if (kbdhook.winsdown == 0)
+ {
+ /* No Windows keys pressed anymore - clear the state flags. */
+ kbdhook.suppress_lone = 0;
+ kbdhook.winseen = 0;
+ }
+ if (!kbdhook.send_win_up)
+ {
+ /* Swallow this release message, as not to confuse
+ applications who did not get to see the original
+ WM_KEYDOWN message either. */
+ return 1;
+ }
+ kbdhook.send_win_up = 0;
+ }
+ }
+ else if (kbdhook.winsdown > 0)
+ {
+ /* Some other key was pressed while a captured Win key is down.
+ This is either an Emacs registered hotkey combination, or a
+ system hotkey. */
+ if ((kbdhook.lwindown && kbdhook.lwin_hooked[hs->vkCode]) ||
+ (kbdhook.rwindown && kbdhook.rwin_hooked[hs->vkCode]))
+ {
+ /* Hooked Win-x combination, do not pass the keypress to Windows. */
+ kbdhook.suppress_lone = 1;
+ }
+ else if (!kbdhook.suppress_lone)
+ {
+ /* Unhooked S-x combination; simulate the combination now
+ (will be seen by the system). */
+ memset (inputs, 0, sizeof (inputs));
+ inputs[0].type = INPUT_KEYBOARD;
+ inputs[0].ki.wVk = kbdhook.lwindown ? VK_LWIN : VK_RWIN;
+ inputs[0].ki.wScan = kbdhook.lwindown ? VK_LWIN : VK_RWIN;
+ inputs[0].ki.dwFlags = KEYEVENTF_EXTENDEDKEY;
+ inputs[0].ki.time = 0;
+ inputs[1].type = INPUT_KEYBOARD;
+ inputs[1].ki.wVk = hs->vkCode;
+ inputs[1].ki.wScan = hs->scanCode;
+ inputs[1].ki.dwFlags =
+ (hs->flags & LLKHF_EXTENDED) ? KEYEVENTF_EXTENDEDKEY : 0;
+ inputs[1].ki.time = 0;
+ SendInput (2, inputs, sizeof (INPUT));
+ /* Stop processing of this Win sequence here; the
+ corresponding keyup messages will come through the normal
+ channel when the keys are released. */
+ kbdhook.suppress_lone = 1;
+ kbdhook.send_win_up = 1;
+ /* Swallow the original keypress (as we want the Win key
+ down message simulated above to precede this real message). */
+ return 1;
+ }
+ }
+
+ /* Next, handle the registered Alt-* combinations. */
+ if ((w == WM_SYSKEYDOWN || w == WM_KEYDOWN)
+ && kbdhook.alt_hooked[hs->vkCode]
+ && focus != NULL
+ && (GetAsyncKeyState (VK_MENU) & 0x8000))
+ {
+ /* Prevent the system from getting this Alt-* key - suppress the
+ message and post as a normal keypress to Emacs. */
+ if (console)
+ {
+ INPUT_RECORD rec;
+ DWORD n;
+ rec.EventType = KEY_EVENT;
+ rec.Event.KeyEvent.bKeyDown = TRUE;
+ rec.Event.KeyEvent.wVirtualKeyCode = hs->vkCode;
+ rec.Event.KeyEvent.wVirtualScanCode = hs->scanCode;
+ rec.Event.KeyEvent.uChar.UnicodeChar = 0;
+ rec.Event.KeyEvent.dwControlKeyState =
+ ((GetAsyncKeyState (VK_LMENU) & 0x8000) ? LEFT_ALT_PRESSED : 0)
+ | ((GetAsyncKeyState (VK_RMENU) & 0x8000) ? RIGHT_ALT_PRESSED : 0)
+ | ((GetAsyncKeyState (VK_LCONTROL) & 0x8000) ? LEFT_CTRL_PRESSED : 0)
+ | ((GetAsyncKeyState (VK_RCONTROL) & 0x8000) ? RIGHT_CTRL_PRESSED : 0)
+ | ((GetAsyncKeyState (VK_SHIFT) & 0x8000) ? SHIFT_PRESSED : 0)
+ | ((hs->flags & LLKHF_EXTENDED) ? ENHANCED_KEY : 0);
+ if (w32_console_unicode_input)
+ WriteConsoleInputW (keyboard_handle, &rec, 1, &n);
+ else
+ WriteConsoleInputA (keyboard_handle, &rec, 1, &n);
+ }
+ else
+ PostMessage (focus, w, hs->vkCode, 1 | (1<<29));
+ return 1;
+ }
+
+ /* The normal case - pass the message through. */
+ return CallNextHookEx (0, code, w, l);
+}
+
+/* Set up the hook; can be called several times, with matching
+ remove_w32_kbdhook calls. */
+void
+setup_w32_kbdhook (void)
+{
+ kbdhook.hook_count++;
+
+ /* This hook gets in the way of debugging, since when Emacs stops,
+ its input thread stops, and there's nothing to process keyboard
+ events, whereas this hook is global, and is invoked in the
+ context of the thread that installed it. So we don't install the
+ hook if the process is being debugged. */
+ if (w32_kbdhook_active)
+ {
+ IsDebuggerPresent_Proc is_debugger_present = (IsDebuggerPresent_Proc)
+ GetProcAddress (GetModuleHandle ("kernel32.dll"), "IsDebuggerPresent");
+ if (is_debugger_present && is_debugger_present ())
+ return;
+ }
+
+ /* Hooking is only available on NT architecture systems, as
+ indicated by the w32_kbdhook_active variable. */
+ if (kbdhook.hook_count == 1 && w32_kbdhook_active)
+ {
+ /* Get the handle of the Emacs console window. As the
+ GetConsoleWindow function is only available on Win2000+, a
+ hackish workaround described in Microsoft KB article 124103
+ (https://support.microsoft.com/en-us/kb/124103) is used for
+ NT 4 systems. */
+ GetConsoleWindow_Proc get_console = (GetConsoleWindow_Proc)
+ GetProcAddress (GetModuleHandle ("kernel32.dll"), "GetConsoleWindow");
+
+ if (get_console != NULL)
+ kbdhook.console = get_console ();
+ else
+ {
+ GUID guid;
+ wchar_t *oldTitle = malloc (1024 * sizeof(wchar_t));
+ wchar_t newTitle[64];
+ int i;
+
+ CoCreateGuid (&guid);
+ StringFromGUID2 (&guid, newTitle, 64);
+ if (newTitle != NULL)
+ {
+ GetConsoleTitleW (oldTitle, 1024);
+ SetConsoleTitleW (newTitle);
+ for (i = 0; i < 25; i++)
+ {
+ Sleep (40);
+ kbdhook.console = FindWindowW (NULL, newTitle);
+ if (kbdhook.console != NULL)
+ break;
+ }
+ SetConsoleTitleW (oldTitle);
+ }
+ free (oldTitle);
+ }
+
+ /* Set the hook. */
+ kbdhook.hook = SetWindowsHookEx (WH_KEYBOARD_LL, funhook,
+ GetModuleHandle (NULL), 0);
+ }
+}
+
+/* Remove the hook. */
+void
+remove_w32_kbdhook (void)
+{
+ kbdhook.hook_count--;
+ if (kbdhook.hook_count == 0 && w32_kbdhook_active)
+ {
+ UnhookWindowsHookEx (kbdhook.hook);
+ kbdhook.hook = NULL;
+ }
+}
+#endif /* WINDOWSNT */
+
+/* Mark a specific key combination as hooked, preventing it to be
+ handled by the system. */
+static void
+hook_w32_key (int hook, int modifier, int vkey)
+{
+ char *tbl = NULL;
+
+ switch (modifier)
+ {
+ case VK_MENU:
+ tbl = kbdhook.alt_hooked;
+ break;
+ case VK_LWIN:
+ tbl = kbdhook.lwin_hooked;
+ break;
+ case VK_RWIN:
+ tbl = kbdhook.rwin_hooked;
+ break;
+ }
+
+ if (tbl != NULL && vkey >= 0 && vkey <= 255)
+ {
+ /* VK_ANY hooks all keys for this modifier */
+ if (vkey == VK_ANY)
+ memset (tbl, (char)hook, 256);
+ else
+ tbl[vkey] = (char)hook;
+ /* Alt-<modifier>s should go through */
+ kbdhook.alt_hooked[VK_MENU] = 0;
+ kbdhook.alt_hooked[VK_LMENU] = 0;
+ kbdhook.alt_hooked[VK_RMENU] = 0;
+ kbdhook.alt_hooked[VK_CONTROL] = 0;
+ kbdhook.alt_hooked[VK_LCONTROL] = 0;
+ kbdhook.alt_hooked[VK_RCONTROL] = 0;
+ kbdhook.alt_hooked[VK_SHIFT] = 0;
+ kbdhook.alt_hooked[VK_LSHIFT] = 0;
+ kbdhook.alt_hooked[VK_RSHIFT] = 0;
+ }
+}
+
+#ifdef WINDOWSNT
+/* Check the current Win key pressed state. */
+int
+check_w32_winkey_state (int vkey)
+{
+ /* The hook code handles grabbing of the Windows keys and Alt-* key
+ combinations reserved by the system. Handling Alt is a bit
+ easier, as Windows intends Alt-* shortcuts for application use in
+ Windows; hotkeys such as Alt-tab and Alt-escape are special
+ cases. Win-* hotkeys, on the other hand, are primarily meant for
+ system use.
+
+ As a result, when we want Emacs to be able to grab the Win-*
+ keys, we must swallow all Win key presses in a low-level keyboard
+ hook. Unfortunately, this means that the Emacs window procedure
+ (and console input handler) never see the keypresses either.
+ Thus, to check the modifier states properly, Emacs code must use
+ the check_w32_winkey_state function that uses the flags directly
+ updated by the hook callback. */
+ switch (vkey)
+ {
+ case VK_LWIN:
+ return kbdhook.lwindown;
+ case VK_RWIN:
+ return kbdhook.rwindown;
+ }
+ return 0;
+}
+#endif /* WINDOWSNT */
+
+/* Reset the keyboard hook state. Locking the workstation with Win-L
+ leaves the Win key(s) "down" from the hook's point of view - the
+ keyup event is never seen. Thus, this function must be called when
+ the system is locked. */
+static void
+reset_w32_kbdhook_state (void)
+{
+ kbdhook.lwindown = 0;
+ kbdhook.rwindown = 0;
+ kbdhook.winsdown = 0;
+ kbdhook.send_win_up = 0;
+ kbdhook.suppress_lone = 0;
+ kbdhook.winseen = 0;
+}
+
/* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
between left and right keys as advertised. We test for this
support dynamically, and set a flag when the support is absent. If
@@ -2248,6 +2636,10 @@ modifier_set (int vkey)
else
return (GetKeyState (vkey) & 0x1);
}
+#ifdef WINDOWSNT
+ if (w32_kbdhook_active && (vkey == VK_LWIN || vkey == VK_RWIN))
+ return check_w32_winkey_state (vkey);
+#endif
if (!modifiers_recorded)
return (GetKeyState (vkey) & 0x8000);
@@ -2268,6 +2660,7 @@ modifier_set (int vkey)
/* Convert between the modifier bits W32 uses and the modifier bits
Emacs uses. */
+unsigned int w32_key_to_modifier (int);
unsigned int
w32_key_to_modifier (int key)
@@ -2366,6 +2759,8 @@ w32_get_key_modifiers (unsigned int wparam, unsigned int lparam)
return mods;
}
+unsigned int map_keypad_keys (unsigned int, unsigned int);
+
unsigned int
map_keypad_keys (unsigned int virt_key, unsigned int extended)
{
@@ -2390,7 +2785,9 @@ map_keypad_keys (unsigned int virt_key, unsigned int extended)
/* List of special key combinations which w32 would normally capture,
but Emacs should grab instead. Not directly visible to lisp, to
simplify synchronization. Each item is an integer encoding a virtual
- key code and modifier combination to capture. */
+ key code and modifier combination to capture.
+ Note: This code is not used if keyboard hooks are active
+ (Windows 2000 and later). */
static Lisp_Object w32_grabbed_keys;
#define HOTKEY(vk, mods) make_number (((vk) & 255) | ((mods) << 8))
@@ -2736,6 +3133,8 @@ cancel_all_deferred_msgs (void)
PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
}
+DWORD WINAPI w32_msg_worker (void *);
+
DWORD WINAPI
w32_msg_worker (void *arg)
{
@@ -2954,7 +3353,7 @@ get_wm_chars (HWND aWnd, int *buf, int buflen, int ignore_ctrl, int ctrl,
Be ready to treat the case when this delivers WM_(SYS)DEADCHAR. */
static int after_deadkey = -1;
-int
+static int
deliver_wm_chars (int do_translate, HWND hwnd, UINT msg, UINT wParam,
UINT lParam, int legacy_alt_meta)
{
@@ -2998,7 +3397,7 @@ deliver_wm_chars (int do_translate, HWND hwnd, UINT msg, UINT wParam,
W32Msg wmsg;
DWORD console_modifiers = construct_console_modifiers ();
int *b = buf, strip_ExtraMods = 1, hairy = 0;
- char *type_CtrlAlt = NULL;
+ const char *type_CtrlAlt = NULL;
/* XXXX In fact, there may be another case when we need to do the same:
What happens if the string defined in the LIGATURES has length
@@ -3476,7 +3875,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
switch (wParam)
{
case VK_LWIN:
- if (NILP (Vw32_pass_lwindow_to_system))
+ if (!w32_kbdhook_active && NILP (Vw32_pass_lwindow_to_system))
{
/* Prevent system from acting on keyup (which opens the
Start menu if no other key was pressed) by simulating a
@@ -3495,7 +3894,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
return 0;
break;
case VK_RWIN:
- if (NILP (Vw32_pass_rwindow_to_system))
+ if (!w32_kbdhook_active && NILP (Vw32_pass_rwindow_to_system))
{
if (GetAsyncKeyState (wParam) & 1)
{
@@ -4352,10 +4751,12 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
case WM_SETFOCUS:
dpyinfo->faked_key = 0;
reset_modifiers ();
- register_hot_keys (hwnd);
+ if (!w32_kbdhook_active)
+ register_hot_keys (hwnd);
goto command;
case WM_KILLFOCUS:
- unregister_hot_keys (hwnd);
+ if (!w32_kbdhook_active)
+ unregister_hot_keys (hwnd);
button_state = 0;
ReleaseCapture ();
/* Relinquish the system caret. */
@@ -4384,15 +4785,34 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
goto dflt;
+#ifdef WINDOWSNT
+ case WM_CREATE:
+ setup_w32_kbdhook ();
+ goto dflt;
+#endif
+
case WM_DESTROY:
+#ifdef WINDOWSNT
+ remove_w32_kbdhook ();
+#endif
CoUninitialize ();
return 0;
+ case WM_WTSSESSION_CHANGE:
+ if (wParam == WTS_SESSION_LOCK)
+ reset_w32_kbdhook_state ();
+ goto dflt;
+
case WM_CLOSE:
wmsg.dwModifiers = w32_get_modifiers ();
my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
return 0;
+ case WM_ENDSESSION:
+ my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
+ /* If we return, the process will be terminated immediately. */
+ sleep (1000);
+
case WM_WINDOWPOSCHANGING:
/* Don't restrict the sizing of any kind of frames. If the window
manager doesn't, there's no reason to do it ourselves. */
@@ -4860,7 +5280,7 @@ x_default_font_parameter (struct frame *f, Lisp_Object parms)
if (!STRINGP (font))
{
int i;
- static char *names[]
+ static const char *names[]
= { "Courier New-10",
"-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1",
"-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1",
@@ -4880,7 +5300,8 @@ x_default_font_parameter (struct frame *f, Lisp_Object parms)
{
/* Remember the explicit font parameter, so we can re-apply it after
we've applied the `default' face settings. */
- x_set_frame_parameters (f, Fcons (Fcons (Qfont_param, font_param), Qnil));
+ x_set_frame_parameters (f, Fcons (Fcons (Qfont_parameter, font_param),
+ Qnil));
}
x_default_parameter (f, parms, Qfont, font, "font", "Font", RES_TYPE_STRING);
}
@@ -5202,8 +5623,10 @@ This function is an internal primitive--use `make-frame' instead. */)
else if (! NILP (visibility))
x_make_frame_visible (f);
else
- /* Must have been Qnil. */
- ;
+ {
+ /* Must have been Qnil. */
+ ;
+ }
}
/* Initialize `default-minibuffer-frame' in case this is the first
@@ -5746,11 +6169,13 @@ SOUND is nil to use the normal beep. */)
return sound;
}
+#if 0 /* unused */
int
x_screen_planes (register struct frame *f)
{
return FRAME_DISPLAY_INFO (f)->n_planes;
}
+#endif
/* Return the display structure for the display named NAME.
Open a new connection if necessary. */
@@ -6056,8 +6481,6 @@ no value of TYPE (always string in the MS Windows case). */)
Tool tips
***********************************************************************/
-static Lisp_Object x_create_tip_frame (struct w32_display_info *,
- Lisp_Object, Lisp_Object);
static void compute_tip_xy (struct frame *, Lisp_Object, Lisp_Object,
Lisp_Object, int, int, int *, int *);
@@ -6092,8 +6515,7 @@ unwind_create_tip_frame (Lisp_Object frame)
/* 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.
+ PARMS is a list of frame parameters. Value is the frame.
Note that functions called here, esp. x_default_parameter can
signal errors, for instance when a specified color name is
@@ -6101,8 +6523,7 @@ unwind_create_tip_frame (Lisp_Object frame)
when this happens. */
static Lisp_Object
-x_create_tip_frame (struct w32_display_info *dpyinfo,
- Lisp_Object parms, Lisp_Object text)
+x_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms)
{
struct frame *f;
Lisp_Object frame;
@@ -6111,8 +6532,6 @@ x_create_tip_frame (struct w32_display_info *dpyinfo,
ptrdiff_t count = SPECPDL_INDEX ();
struct kboard *kb;
bool face_change_before = face_change;
- Lisp_Object buffer;
- struct buffer *old_buffer;
int x_width = 0, x_height = 0;
/* Use this general default value to start with until we know if
@@ -6136,23 +6555,9 @@ x_create_tip_frame (struct w32_display_info *dpyinfo,
frame = Qnil;
/* Make a frame without minibuffer nor mode-line. */
f = make_frame (false);
- f->wants_modeline = 0;
+ f->wants_modeline = false;
XSETFRAME (frame, f);
- AUTO_STRING (tip, " *tip*");
- buffer = Fget_buffer_create (tip);
- /* Use set_window_buffer instead of Fset_window_buffer (see
- discussion of bug#11984, bug#12025, bug#12026). */
- set_window_buffer (FRAME_ROOT_WINDOW (f), buffer, false, false);
- old_buffer = current_buffer;
- set_buffer_internal_1 (XBUFFER (buffer));
- bset_truncate_lines (current_buffer, Qnil);
- specbind (Qinhibit_read_only, Qt);
- specbind (Qinhibit_modification_hooks, Qt);
- Ferase_buffer ();
- Finsert (1, &text);
- set_buffer_internal_1 (old_buffer);
-
record_unwind_protect (unwind_create_tip_frame, frame);
/* By setting the output method, we're essentially saying that
@@ -6186,7 +6591,7 @@ x_create_tip_frame (struct w32_display_info *dpyinfo,
{
fset_name (f, name);
f->explicit_name = true;
- /* use the frame's title when getting resources for this frame. */
+ /* Use the frame's title when getting resources for this frame. */
specbind (Qx_resource_name, name);
}
@@ -6216,14 +6621,10 @@ x_create_tip_frame (struct w32_display_info *dpyinfo,
parms = Fcons (Fcons (Qinternal_border_width, value),
parms);
}
+
x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
"internalBorderWidth", "internalBorderWidth",
RES_TYPE_NUMBER);
- x_default_parameter (f, parms, Qright_divider_width, make_number (0),
- NULL, NULL, RES_TYPE_NUMBER);
- x_default_parameter (f, parms, Qbottom_divider_width, make_number (0),
- NULL, NULL, RES_TYPE_NUMBER);
-
/* Also do the stuff which must be set before the window exists. */
x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
"foreground", "Foreground", RES_TYPE_STRING);
@@ -6250,6 +6651,9 @@ x_create_tip_frame (struct w32_display_info *dpyinfo,
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;
block_input ();
my_create_tip_window (f);
@@ -6276,7 +6680,6 @@ x_create_tip_frame (struct w32_display_info *dpyinfo,
SET_FRAME_LINES (f, 0);
adjust_frame_size (f, width * FRAME_COLUMN_WIDTH (f),
height * FRAME_LINE_HEIGHT (f), 0, true, Qtip_frame);
-
/* Add `tooltip' frame parameter's default value. */
if (NILP (Fframe_parameter (frame, Qtooltip)))
Fmodify_frame_parameters (frame, Fcons (Fcons (Qtooltip, Qt), Qnil));
@@ -6294,8 +6697,6 @@ x_create_tip_frame (struct w32_display_info *dpyinfo,
Lisp_Object fg = Fframe_parameter (frame, Qforeground_color);
Lisp_Object colors = Qnil;
- /* Set tip_frame here, so that */
- tip_frame = frame;
call2 (Qface_set_after_frame_default, frame, Qnil);
if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
@@ -6427,6 +6828,48 @@ compute_tip_xy (struct frame *f,
*root_x = min_x;
}
+/* Hide tooltip. Delete its frame if DELETE is true. */
+static Lisp_Object
+x_hide_tip (bool delete)
+{
+ if (!NILP (tip_timer))
+ {
+ call1 (Qcancel_timer, tip_timer);
+ tip_timer = Qnil;
+ }
+
+ if (NILP (tip_frame)
+ || (!delete && FRAMEP (tip_frame)
+ && !FRAME_VISIBLE_P (XFRAME (tip_frame))))
+ return Qnil;
+ else
+ {
+ ptrdiff_t count;
+ Lisp_Object was_open = Qnil;
+
+ count = SPECPDL_INDEX ();
+ specbind (Qinhibit_redisplay, Qt);
+ specbind (Qinhibit_quit, Qt);
+
+ if (FRAMEP (tip_frame))
+ {
+ if (delete)
+ {
+ delete_frame (tip_frame, Qnil);
+ tip_frame = Qnil;
+ }
+ else
+ x_make_frame_invisible (XFRAME (tip_frame));
+
+ was_open = Qt;
+ }
+ else
+ tip_frame = Qnil;
+
+ return unbind_to (count, was_open);
+ }
+}
+
DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
@@ -6460,20 +6903,22 @@ A tooltip's maximum size is specified by `x-max-tooltip-size'.
Text larger than the specified size is clipped. */)
(Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
{
- struct frame *f;
+ struct frame *tip_f;
struct window *w;
int root_x, root_y;
struct buffer *old_buffer;
struct text_pos pos;
- int i, width, height;
- bool seen_reversed_p;
+ int width, height;
int old_windows_or_buffers_changed = windows_or_buffers_changed;
ptrdiff_t count = SPECPDL_INDEX ();
+ ptrdiff_t count_1;
+ Lisp_Object window, size;
+ AUTO_STRING (tip, " *tip*");
specbind (Qinhibit_redisplay, Qt);
CHECK_STRING (string);
- f = decode_window_system_frame (frame);
+ decode_window_system_frame (frame);
if (NILP (timeout))
timeout = make_number (5);
else
@@ -6492,91 +6937,155 @@ Text larger than the specified size is clipped. */)
if (NILP (last_show_tip_args))
last_show_tip_args = Fmake_vector (make_number (3), Qnil);
- if (!NILP (tip_frame))
+ if (FRAMEP (tip_frame) && FRAME_LIVE_P (XFRAME (tip_frame)))
{
Lisp_Object last_string = AREF (last_show_tip_args, 0);
Lisp_Object last_frame = AREF (last_show_tip_args, 1);
Lisp_Object last_parms = AREF (last_show_tip_args, 2);
- if (EQ (frame, last_frame)
- && !NILP (Fequal (last_string, string))
+ if (FRAME_VISIBLE_P (XFRAME (tip_frame))
+ && EQ (frame, last_frame)
+ && !NILP (Fequal_including_properties (last_string, string))
&& !NILP (Fequal (last_parms, parms)))
{
- struct frame *f = XFRAME (tip_frame);
-
/* Only DX and DY have changed. */
+ tip_f = XFRAME (tip_frame);
if (!NILP (tip_timer))
{
Lisp_Object timer = tip_timer;
+
tip_timer = Qnil;
call1 (Qcancel_timer, timer);
}
block_input ();
- compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f),
- FRAME_PIXEL_HEIGHT (f), &root_x, &root_y);
+ compute_tip_xy (tip_f, parms, dx, dy, FRAME_PIXEL_WIDTH (tip_f),
+ FRAME_PIXEL_HEIGHT (tip_f), &root_x, &root_y);
/* Put tooltip in topmost group and in position. */
- SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
+ SetWindowPos (FRAME_W32_WINDOW (tip_f), HWND_TOPMOST,
root_x, root_y, 0, 0,
SWP_NOSIZE | SWP_NOACTIVATE | SWP_NOOWNERZORDER);
/* Ensure tooltip is on top of other topmost windows (eg menus). */
- SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
+ SetWindowPos (FRAME_W32_WINDOW (tip_f), HWND_TOP,
0, 0, 0, 0,
SWP_NOMOVE | SWP_NOSIZE
| SWP_NOACTIVATE | SWP_NOOWNERZORDER);
+ /* Let redisplay know that we have made the frame visible already. */
+ SET_FRAME_VISIBLE (tip_f, 1);
+ ShowWindow (FRAME_W32_WINDOW (tip_f), SW_SHOWNOACTIVATE);
unblock_input ();
+
goto start_timer;
}
- }
+ else if (tooltip_reuse_hidden_frame && EQ (frame, last_frame))
+ {
+ bool delete = false;
+ Lisp_Object tail, elt, parm, last;
+
+ /* Check if every parameter in PARMS has the same value in
+ last_parms. This may destruct 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, last_parms);
+ if (NILP (Fequal (Fcdr (elt), Fcdr (last))))
+ {
+ /* We lost, delete the old tooltip. */
+ delete = true;
+ break;
+ }
+ else
+ last_parms = call2 (Qassq_delete_all, parm, last_parms);
+ }
+ else
+ last_parms = call2 (Qassq_delete_all, parm, last_parms);
+ }
+
+ /* Now check if there's a parameter left in last_parms with a
+ non-nil value. */
+ for (tail = 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;
+ }
+ }
- /* Hide a previous tip, if any. */
- Fx_hide_tip ();
+ x_hide_tip (delete);
+ }
+ else
+ x_hide_tip (true);
+ }
+ else
+ x_hide_tip (true);
ASET (last_show_tip_args, 0, string);
ASET (last_show_tip_args, 1, frame);
ASET (last_show_tip_args, 2, parms);
- /* 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_number (3)), parms);
- if (NILP (Fassq (Qright_divider_width, parms)))
- parms = Fcons (Fcons (Qright_divider_width, make_number (0)), parms);
- if (NILP (Fassq (Qbottom_divider_width, parms)))
- parms = Fcons (Fcons (Qbottom_divider_width, make_number (0)), parms);
- if (NILP (Fassq (Qborder_width, parms)))
- parms = Fcons (Fcons (Qborder_width, make_number (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);
-
/* Block input until the tip has been fully drawn, to avoid crashes
when drawing tips in menus. */
block_input ();
- /* Create a frame for the tooltip, and record it in the global
- variable tip_frame. */
- frame = x_create_tip_frame (FRAME_DISPLAY_INFO (f), parms, string);
- f = XFRAME (frame);
+ if (!FRAMEP (tip_frame) || !FRAME_LIVE_P (XFRAME (tip_frame)))
+ {
+ /* Add default values to frame parameters. */
+ if (NILP (Fassq (Qname, parms)))
+ parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
+ if (NILP (Fassq (Qinternal_border_width, parms)))
+ parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
+ if (NILP (Fassq (Qborder_width, parms)))
+ parms = Fcons (Fcons (Qborder_width, make_number (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);
- /* Set up the frame's root window. */
- w = XWINDOW (FRAME_ROOT_WINDOW (f));
+ /* Create a frame for the tooltip, and record it in the global
+ variable tip_frame. */
+ struct frame *f; /* The value is unused. */
+ if (NILP (tip_frame = x_create_tip_frame (FRAME_DISPLAY_INFO (f), parms)))
+ {
+ /* Creating the tip frame failed. */
+ unblock_input ();
+ return unbind_to (count, Qnil);
+ }
+ }
+
+ tip_f = XFRAME (tip_frame);
+ window = FRAME_ROOT_WINDOW (tip_f);
+ set_window_buffer (window, Fget_buffer_create (tip), false, false);
+ w = XWINDOW (window);
+ w->pseudo_window_p = true;
+
+ /* Set up the frame's root window. Note: The following code does not
+ try to size the window or its frame correctly. Its only purpose is
+ to make the subsequent text size calculations work. The right
+ sizes should get installed when the toolkit gets back to us. */
w->left_col = 0;
w->top_line = 0;
w->pixel_left = 0;
w->pixel_top = 0;
if (CONSP (Vx_max_tooltip_size)
- && INTEGERP (XCAR (Vx_max_tooltip_size))
- && XINT (XCAR (Vx_max_tooltip_size)) > 0
- && INTEGERP (XCDR (Vx_max_tooltip_size))
- && XINT (XCDR (Vx_max_tooltip_size)) > 0)
+ && RANGED_INTEGERP (1, XCAR (Vx_max_tooltip_size), INT_MAX)
+ && RANGED_INTEGERP (1, XCDR (Vx_max_tooltip_size), INT_MAX))
{
w->total_cols = XFASTINT (XCAR (Vx_max_tooltip_size));
w->total_lines = XFASTINT (XCDR (Vx_max_tooltip_size));
@@ -6587,164 +7096,71 @@ Text larger than the specified size is clipped. */)
w->total_lines = 40;
}
- w->pixel_width = w->total_cols * FRAME_COLUMN_WIDTH (f);
- w->pixel_height = w->total_lines * FRAME_LINE_HEIGHT (f);
+ 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);
+ adjust_frame_glyphs (tip_f);
- FRAME_TOTAL_COLS (f) = WINDOW_TOTAL_COLS (w);
- adjust_frame_glyphs (f);
- w->pseudo_window_p = true;
-
- /* Display the tooltip text in a temporary buffer. */
+ /* Insert STRING into the root window's buffer and fit the frame to
+ the buffer. */
+ count_1 = SPECPDL_INDEX ();
old_buffer = current_buffer;
- set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->contents));
+ 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 (FRAME_ROOT_WINDOW (f), pos, TRY_WINDOW_IGNORE_FONTS_CHANGE);
-
- /* Compute width and height of the tooltip. */
- width = height = 0;
- seen_reversed_p = false;
- for (i = 0; i < w->desired_matrix->nrows; ++i)
- {
- struct glyph_row *row = &w->desired_matrix->rows[i];
- struct glyph *last;
- int row_width;
-
- /* Stop at the first empty row at the end. */
- if (!row->enabled_p || !MATRIX_ROW_DISPLAYS_TEXT_P (row))
- break;
-
- /* Let the row go over the full width of the frame. */
- row->full_width_p = true;
-
- row_width = row->pixel_width;
- if (row->used[TEXT_AREA])
- {
- if (!row->reversed_p)
- {
- /* There's a glyph at the end of rows that is used to
- place the cursor there. Don't include the width of
- this glyph. */
- last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
- if (NILP (last->object))
- row_width -= last->pixel_width;
- }
- else
- {
- /* There could be a stretch glyph at the beginning of R2L
- rows that is produced by extend_face_to_end_of_line.
- Don't count that glyph. */
- struct glyph *g = row->glyphs[TEXT_AREA];
-
- if (g->type == STRETCH_GLYPH && NILP (g->object))
- {
- row_width -= g->pixel_width;
- seen_reversed_p = true;
- }
- }
- }
-
- height += row->height;
- width = max (width, row_width);
- }
-
- /* If we've seen partial-length R2L rows, we need to re-adjust the
- tool-tip frame width and redisplay it again, to avoid over-wide
- tips due to the stretch glyph that extends R2L lines to full
- width of the frame. */
- if (seen_reversed_p)
- {
- /* PXW: Why do we do the pixel-to-cols conversion only if
- seen_reversed_p holds? Don't we have to set other fields of
- the window/frame structure?
-
- w->total_cols and FRAME_TOTAL_COLS want the width in columns,
- not in pixels. */
- w->pixel_width = width;
- width /= WINDOW_FRAME_COLUMN_WIDTH (w);
- w->total_cols = width;
- FRAME_TOTAL_COLS (f) = width;
- SET_FRAME_WIDTH (f, width);
- adjust_frame_glyphs (f);
- w->pseudo_window_p = 1;
- clear_glyph_matrix (w->desired_matrix);
- clear_glyph_matrix (w->current_matrix);
- try_window (FRAME_ROOT_WINDOW (f), pos, TRY_WINDOW_IGNORE_FONTS_CHANGE);
- width = height = 0;
- /* Recompute width and height of the tooltip. */
- for (i = 0; i < w->desired_matrix->nrows; ++i)
- {
- struct glyph_row *row = &w->desired_matrix->rows[i];
- struct glyph *last;
- int row_width;
-
- if (!row->enabled_p || !MATRIX_ROW_DISPLAYS_TEXT_P (row))
- break;
- row->full_width_p = true;
- row_width = row->pixel_width;
- if (row->used[TEXT_AREA] && !row->reversed_p)
- {
- last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
- if (NILP (last->object))
- row_width -= last->pixel_width;
- }
-
- height += row->height;
- width = max (width, row_width);
- }
- }
-
- /* Add the frame's internal border to the width and height the w32
- window should have. */
- height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
- width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
-
- /* Move the tooltip window where the mouse pointer is. Resize and
- show it.
-
- PXW: This should use the frame's pixel coordinates. */
- compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
-
+ try_window (window, pos, TRY_WINDOW_IGNORE_FONTS_CHANGE);
+ /* Calculate size of tooltip window. */
+ size = Fwindow_text_pixel_size (window, Qnil, Qnil, Qnil,
+ make_number (w->pixel_height), Qnil);
+ /* Add the frame's internal border to calculated size. */
+ width = XINT (Fcar (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f);
+ height = XINT (Fcdr (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f);
+ /* Calculate position of tooltip frame. */
+ compute_tip_xy (tip_f, parms, dx, dy, width, height, &root_x, &root_y);
+
+ /* Show tooltip frame. */
{
- /* Adjust Window size to take border into account. */
RECT rect;
+ int pad = (NUMBERP (Vw32_tooltip_extra_pixels)
+ ? max (0, XINT (Vw32_tooltip_extra_pixels))
+ : FRAME_COLUMN_WIDTH (tip_f));
+
rect.left = rect.top = 0;
rect.right = width;
rect.bottom = height;
- AdjustWindowRect (&rect, f->output_data.w32->dwStyle, false);
-
- /* Position and size tooltip, and put it in the topmost group.
- The add-on of FRAME_COLUMN_WIDTH to the 5th argument is a
- peculiarity of w32 display: without it, some fonts cause the
- last character of the tip to be truncated or wrapped around to
- the next line. */
- SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
+ AdjustWindowRect (&rect, tip_f->output_data.w32->dwStyle,
+ FRAME_EXTERNAL_MENU_BAR (tip_f));
+
+ /* Position and size tooltip and put it in the topmost group. */
+ SetWindowPos (FRAME_W32_WINDOW (tip_f), HWND_TOPMOST,
root_x, root_y,
- rect.right - rect.left + FRAME_COLUMN_WIDTH (f),
+ rect.right - rect.left + pad,
rect.bottom - rect.top, SWP_NOACTIVATE | SWP_NOOWNERZORDER);
/* Ensure tooltip is on top of other topmost windows (eg menus). */
- SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
+ SetWindowPos (FRAME_W32_WINDOW (tip_f), HWND_TOP,
0, 0, 0, 0,
SWP_NOMOVE | SWP_NOSIZE
| SWP_NOACTIVATE | SWP_NOOWNERZORDER);
/* Let redisplay know that we have made the frame visible already. */
- SET_FRAME_VISIBLE (f, 1);
+ SET_FRAME_VISIBLE (tip_f, 1);
- ShowWindow (FRAME_W32_WINDOW (f), SW_SHOWNOACTIVATE);
+ ShowWindow (FRAME_W32_WINDOW (tip_f), SW_SHOWNOACTIVATE);
}
- /* Draw into the window. */
w->must_be_updated_p = true;
update_single_window (w);
-
- unblock_input ();
-
- /* Restore original current buffer. */
set_buffer_internal_1 (old_buffer);
+ unbind_to (count_1, Qnil);
+ unblock_input ();
windows_or_buffers_changed = old_windows_or_buffers_changed;
start_timer:
@@ -6761,31 +7177,7 @@ DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
Value is t if tooltip was open, nil otherwise. */)
(void)
{
- ptrdiff_t count;
- Lisp_Object deleted, frame, timer;
-
- /* Return quickly if nothing to do. */
- if (NILP (tip_timer) && NILP (tip_frame))
- return Qnil;
-
- frame = tip_frame;
- timer = tip_timer;
- tip_frame = tip_timer = deleted = Qnil;
-
- count = SPECPDL_INDEX ();
- specbind (Qinhibit_redisplay, Qt);
- specbind (Qinhibit_quit, Qt);
-
- if (!NILP (timer))
- call1 (Qcancel_timer, timer);
-
- if (FRAMEP (frame))
- {
- delete_frame (frame, Qnil);
- deleted = Qt;
- }
-
- return unbind_to (count, deleted);
+ return x_hide_tip (!tooltip_reuse_hidden_frame);
}
/***********************************************************************
@@ -6912,7 +7304,9 @@ value of DIR as in previous invocations; this is standard Windows behavior. */)
{
/* Filter index: 1: All Files, 2: Directories only */
static const wchar_t filter_w[] = L"All Files (*.*)\0*.*\0Directories\0*|*\0";
+#ifndef NTGUI_UNICODE
static const char filter_a[] = "All Files (*.*)\0*.*\0Directories\0*|*\0";
+#endif
Lisp_Object filename = default_filename;
struct frame *f = SELECTED_FRAME ();
@@ -7190,7 +7584,7 @@ value of DIR as in previous invocations; this is standard Windows behavior. */)
/* Make "Cancel" equivalent to C-g. */
if (NILP (filename))
- Fsignal (Qquit, Qnil);
+ quit ();
return filename;
}
@@ -7653,19 +8047,34 @@ lookup_vk_code (char *key)
&& strcmp (lispy_function_keys[i], key) == 0)
return i;
+ if (w32_kbdhook_active)
+ {
+ /* Alphanumerics map to themselves. */
+ if (key[1] == 0)
+ {
+ if ((key[0] >= 'A' && key[0] <= 'Z')
+ || (key[0] >= '0' && key[0] <= '9'))
+ return key[0];
+ if (key[0] >= 'a' && key[0] <= 'z')
+ return toupper(key[0]);
+ }
+ }
+
return -1;
}
/* Convert a one-element vector style key sequence to a hot key
definition. */
static Lisp_Object
-w32_parse_hot_key (Lisp_Object key)
+w32_parse_and_hook_hot_key (Lisp_Object key, int hook)
{
/* Copied from Fdefine_key and store_in_keymap. */
register Lisp_Object c;
int vk_code;
int lisp_modifiers;
int w32_modifiers;
+ Lisp_Object res = Qnil;
+ char* vkname;
CHECK_VECTOR (key);
@@ -7688,7 +8097,12 @@ w32_parse_hot_key (Lisp_Object key)
c = Fcar (c);
if (!SYMBOLP (c))
emacs_abort ();
- vk_code = lookup_vk_code (SSDATA (SYMBOL_NAME (c)));
+ vkname = SSDATA (SYMBOL_NAME (c));
+ /* [s-], [M-], [h-]: Register all keys for this modifier */
+ if (w32_kbdhook_active && vkname[0] == 0)
+ vk_code = VK_ANY;
+ else
+ vk_code = lookup_vk_code (vkname);
}
else if (INTEGERP (c))
{
@@ -7712,34 +8126,75 @@ w32_parse_hot_key (Lisp_Object key)
#define MOD_WIN 0x0008
#endif
- /* Convert lisp modifiers to Windows hot-key form. */
- w32_modifiers = (lisp_modifiers & hyper_modifier) ? MOD_WIN : 0;
- w32_modifiers |= (lisp_modifiers & alt_modifier) ? MOD_ALT : 0;
- w32_modifiers |= (lisp_modifiers & ctrl_modifier) ? MOD_CONTROL : 0;
- w32_modifiers |= (lisp_modifiers & shift_modifier) ? MOD_SHIFT : 0;
+ if (w32_kbdhook_active)
+ {
+ /* Register Alt-x combinations. */
+ if (lisp_modifiers & alt_modifier)
+ {
+ hook_w32_key (hook, VK_MENU, vk_code);
+ res = Qt;
+ }
+ /* Register Win-x combinations based on modifier mappings. */
+ if (((lisp_modifiers & hyper_modifier)
+ && EQ (Vw32_lwindow_modifier, Qhyper))
+ || ((lisp_modifiers & super_modifier)
+ && EQ (Vw32_lwindow_modifier, Qsuper)))
+ {
+ hook_w32_key (hook, VK_LWIN, vk_code);
+ res = Qt;
+ }
+ if (((lisp_modifiers & hyper_modifier)
+ && EQ (Vw32_rwindow_modifier, Qhyper))
+ || ((lisp_modifiers & super_modifier)
+ && EQ (Vw32_rwindow_modifier, Qsuper)))
+ {
+ hook_w32_key (hook, VK_RWIN, vk_code);
+ res = Qt;
+ }
+ return res;
+ }
+ else
+ {
+ /* Convert lisp modifiers to Windows hot-key form. */
+ w32_modifiers = (lisp_modifiers & hyper_modifier) ? MOD_WIN : 0;
+ w32_modifiers |= (lisp_modifiers & alt_modifier) ? MOD_ALT : 0;
+ w32_modifiers |= (lisp_modifiers & ctrl_modifier) ? MOD_CONTROL : 0;
+ w32_modifiers |= (lisp_modifiers & shift_modifier) ? MOD_SHIFT : 0;
- return HOTKEY (vk_code, w32_modifiers);
+ return HOTKEY (vk_code, w32_modifiers);
+ }
}
DEFUN ("w32-register-hot-key", Fw32_register_hot_key,
Sw32_register_hot_key, 1, 1, 0,
doc: /* Register KEY as a hot-key combination.
-Certain key combinations like Alt-Tab are reserved for system use on
-Windows, and therefore are normally intercepted by the system. However,
-most of these key combinations can be received by registering them as
-hot-keys, overriding their special meaning.
-
-KEY must be a one element key definition in vector form that would be
-acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
-modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
-is always interpreted as the Windows modifier keys.
-
-The return value is the hotkey-id if registered, otherwise nil. */)
+Certain key combinations like Alt-Tab and Win-R are reserved for
+system use on Windows, and therefore are normally intercepted by the
+system. These key combinations can be received by registering them
+as hot-keys, except for Win-L which always locks the computer.
+
+On Windows 98 and ME, KEY must be a one element key definition in
+vector form that would be acceptable to `define-key' (e.g. [A-tab] for
+Alt-Tab). The meta modifier is interpreted as Alt if
+`w32-alt-is-meta' is t, and hyper is always interpreted as the Windows
+modifier keys. The return value is the hotkey-id if registered, otherwise nil.
+
+On Windows versions since NT, KEY can also be specified as [M-], [s-] or
+[h-] to indicate that all combinations of that key should be processed
+by Emacs instead of the operating system. The super and hyper
+modifiers are interpreted according to the current values of
+`w32-lwindow-modifier' and `w32-rwindow-modifier'. For instance,
+setting `w32-lwindow-modifier' to `super' and then calling
+`(register-hot-key [s-])' grabs all combinations of the left Windows
+key to Emacs, but leaves the right Windows key free for the operating
+system keyboard shortcuts. The return value is t if the call affected
+any key combinations, otherwise nil. */)
(Lisp_Object key)
{
- key = w32_parse_hot_key (key);
+ key = w32_parse_and_hook_hot_key (key, 1);
- if (!NILP (key) && NILP (Fmemq (key, w32_grabbed_keys)))
+ if (!w32_kbdhook_active
+ && !NILP (key) && NILP (Fmemq (key, w32_grabbed_keys)))
{
/* Reuse an empty slot if possible. */
Lisp_Object item = Fmemq (Qnil, w32_grabbed_keys);
@@ -7767,7 +8222,10 @@ DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key,
Lisp_Object item;
if (!INTEGERP (key))
- key = w32_parse_hot_key (key);
+ key = w32_parse_and_hook_hot_key (key, 0);
+
+ if (w32_kbdhook_active)
+ return key;
item = Fmemq (key, w32_grabbed_keys);
@@ -8007,24 +8465,25 @@ and width values are in pixels.
Fcons (Qouter_size,
Fcons (make_number (right - left),
make_number (bottom - top))),
- Fcons (Qexternal_border_size,
+ Fcons (Qexternal_border_size,
Fcons (make_number (external_border_width),
make_number (external_border_height))),
Fcons (Qtitle_bar_size,
Fcons (make_number (title_bar_width),
make_number (title_bar_height))),
- Fcons (Qmenu_bar_external, Qt),
- Fcons (Qmenu_bar_size,
- Fcons (make_number
- (menu_bar.rcBar.right - menu_bar.rcBar.left),
- make_number (menu_bar_height))),
- Fcons (Qtool_bar_external, Qnil),
+ Fcons (Qmenu_bar_external, Qt),
+ Fcons (Qmenu_bar_size,
+ Fcons (make_number
+ (menu_bar.rcBar.right - menu_bar.rcBar.left),
+ make_number (menu_bar_height))),
+ Fcons (Qtool_bar_external, Qnil),
Fcons (Qtool_bar_position, tool_bar_height ? Qtop : Qnil),
- Fcons (Qtool_bar_size,
+ Fcons (Qtool_bar_size,
Fcons (make_number
(tool_bar_height
- ? right - left - 2 * internal_border_width
- : 0),
+ ? (right - left - 2 * external_border_width
+ - 2 * internal_border_width)
+ : 0),
make_number (tool_bar_height))),
Fcons (Qinternal_border_width,
make_number (internal_border_width)));
@@ -8229,7 +8688,7 @@ The following %-sequences are provided:
else
{
long m;
- float h;
+ double h;
char buffer[16];
snprintf (buffer, 16, "%ld", seconds_left);
seconds = build_string (buffer);
@@ -8522,7 +8981,7 @@ w32_strerror (int error_no)
--ret;
buf[ret] = '\0';
if (!ret)
- sprintf (buf, "w32 error %u", error_no);
+ sprintf (buf, "w32 error %d", error_no);
return buf;
}
@@ -8530,6 +8989,8 @@ w32_strerror (int error_no)
/* For convenience when debugging. (You cannot call GetLastError
directly from GDB: it will crash, because it uses the __stdcall
calling convention, not the _cdecl convention assumed by GDB.) */
+DWORD w32_last_error (void);
+
DWORD
w32_last_error (void)
{
@@ -9180,7 +9641,7 @@ usage: (w32-notification-notify &rest PARAMS) */)
EMACS_INT retval;
char *icon, *tip, *title, *msg;
enum NI_Severity severity;
- unsigned timeout;
+ unsigned timeout = 0;
if (nargs == 0)
return Qnil;
@@ -9192,14 +9653,14 @@ usage: (w32-notification-notify &rest PARAMS) */)
if (STRINGP (lres))
icon = SSDATA (ENCODE_FILE (Fexpand_file_name (lres, Qnil)));
else
- icon = "";
+ icon = (char *)"";
/* Tip. */
lres = Fplist_get (arg_plist, QCtip);
if (STRINGP (lres))
tip = SSDATA (code_convert_string_norecord (lres, Qutf_8, 1));
else
- tip = "Emacs notification";
+ tip = (char *)"Emacs notification";
/* Severity. */
lres = Fplist_get (arg_plist, QClevel);
@@ -9219,14 +9680,14 @@ usage: (w32-notification-notify &rest PARAMS) */)
if (STRINGP (lres))
title = SSDATA (code_convert_string_norecord (lres, Qutf_8, 1));
else
- title = "";
+ title = (char *)"";
/* Notification body text. */
lres = Fplist_get (arg_plist, QCbody);
if (STRINGP (lres))
msg = SSDATA (code_convert_string_norecord (lres, Qutf_8, 1));
else
- msg = "";
+ msg = (char *)"";
/* Do it! */
retval = add_tray_notification (f, icon, tip, severity, timeout, title, msg);
@@ -9296,6 +9757,7 @@ frame_parm_handler w32_frame_parm_handlers[] =
x_set_alpha,
0, /* x_set_sticky */
0, /* x_set_tool_bar_position */
+ 0, /* x_set_inhibit_double_buffering */
};
void
@@ -9315,12 +9777,13 @@ syms_of_w32fns (void)
DEFSYM (Qctrl, "ctrl");
DEFSYM (Qcontrol, "control");
DEFSYM (Qshift, "shift");
- DEFSYM (Qfont_param, "font-parameter");
+ DEFSYM (Qfont_parameter, "font-parameter");
DEFSYM (Qgeometry, "geometry");
DEFSYM (Qworkarea, "workarea");
DEFSYM (Qmm_size, "mm-size");
DEFSYM (Qframes, "frames");
DEFSYM (Qtip_frame, "tip-frame");
+ DEFSYM (Qassq_delete_all, "assq-delete-all");
DEFSYM (Qunicode_sip, "unicode-sip");
#if defined WINDOWSNT && !defined HAVE_DBUS
DEFSYM (QCicon, ":icon");
@@ -9333,10 +9796,10 @@ syms_of_w32fns (void)
#endif
/* Symbols used elsewhere, but only in MS-Windows-specific code. */
- DEFSYM (Qgnutls_dll, "gnutls");
- DEFSYM (Qlibxml2_dll, "libxml2");
+ DEFSYM (Qgnutls, "gnutls");
+ DEFSYM (Qlibxml2, "libxml2");
DEFSYM (Qserif, "serif");
- DEFSYM (Qzlib_dll, "zlib");
+ DEFSYM (Qzlib, "zlib");
Fput (Qundefined_color, Qerror_conditions,
listn (CONSTYPE_PURE, 2, Qundefined_color, Qerror));
@@ -9374,11 +9837,15 @@ When non-nil, the Start menu is opened by tapping the key.
If you set this to nil, the left \"Windows\" key is processed by Emacs
according to the value of `w32-lwindow-modifier', which see.
-Note that some combinations of the left \"Windows\" key with other keys are
-caught by Windows at low level, and so binding them in Emacs will have no
-effect. For example, <lwindow>-r always pops up the Windows Run dialog,
-<lwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
-the doc string of `w32-phantom-key-code'. */);
+Note that some combinations of the left \"Windows\" key with other
+keys are caught by Windows at low level. For example, <lwindow>-r
+pops up the Windows Run dialog, <lwindow>-<Pause> pops up the "System
+Properties" dialog, etc. On Windows 10, no \"Windows\" key
+combinations are normally handed to applications. To enable Emacs to
+process \"Windows\" key combinations, use the function
+`w32-register-hot-key`.
+
+For Windows 98/ME, see the doc string of `w32-phantom-key-code'. */);
Vw32_pass_lwindow_to_system = Qt;
DEFVAR_LISP ("w32-pass-rwindow-to-system",
@@ -9389,11 +9856,15 @@ When non-nil, the Start menu is opened by tapping the key.
If you set this to nil, the right \"Windows\" key is processed by Emacs
according to the value of `w32-rwindow-modifier', which see.
-Note that some combinations of the right \"Windows\" key with other keys are
-caught by Windows at low level, and so binding them in Emacs will have no
-effect. For example, <rwindow>-r always pops up the Windows Run dialog,
-<rwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
-the doc string of `w32-phantom-key-code'. */);
+Note that some combinations of the right \"Windows\" key with other
+keys are caught by Windows at low level. For example, <rwindow>-r
+pops up the Windows Run dialog, <rwindow>-<Pause> pops up the "System
+Properties" dialog, etc. On Windows 10, no \"Windows\" key
+combinations are normally handed to applications. To enable Emacs to
+process \"Windows\" key combinations, use the function
+`w32-register-hot-key`.
+
+For Windows 98/ME, see the doc string of `w32-phantom-key-code'. */);
Vw32_pass_rwindow_to_system = Qt;
DEFVAR_LISP ("w32-phantom-key-code",
@@ -9403,7 +9874,11 @@ Value is a number between 0 and 255.
Phantom key presses are generated in order to stop the system from
acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
-`w32-pass-rwindow-to-system' is nil. */);
+`w32-pass-rwindow-to-system' is nil.
+
+This variable is only used on Windows 98 and ME. For other Windows
+versions, see the documentation of the `w32-register-hot-key`
+function. */);
/* Although 255 is technically not a valid key code, it works and
means that this hack won't interfere with any real key code. */
XSETINT (Vw32_phantom_key_code, 255);
@@ -9433,7 +9908,9 @@ Any other value will cause the Scroll Lock key to be ignored. */);
doc: /* Modifier to use for the left \"Windows\" key.
The value can be hyper, super, meta, alt, control or shift for the
respective modifier, or nil to appear as the `lwindow' key.
-Any other value will cause the key to be ignored. */);
+Any other value will cause the key to be ignored.
+
+Also see the documentation of the `w32-register-hot-key` function. */);
Vw32_lwindow_modifier = Qnil;
DEFVAR_LISP ("w32-rwindow-modifier",
@@ -9441,7 +9918,9 @@ Any other value will cause the key to be ignored. */);
doc: /* Modifier to use for the right \"Windows\" key.
The value can be hyper, super, meta, alt, control or shift for the
respective modifier, or nil to appear as the `rwindow' key.
-Any other value will cause the key to be ignored. */);
+Any other value will cause the key to be ignored.
+
+Also see the documentation of the `w32-register-hot-key` function. */);
Vw32_rwindow_modifier = Qnil;
DEFVAR_LISP ("w32-apps-modifier",
@@ -9617,6 +10096,18 @@ Default is nil.
This variable has effect only on Windows Vista and later. */);
w32_disable_new_uniscribe_apis = 0;
+ DEFVAR_LISP ("w32-tooltip-extra-pixels",
+ Vw32_tooltip_extra_pixels,
+ doc: /* Number of pixels added after tooltip text.
+On Windows some fonts may cause the last character of a tooltip be
+truncated or wrapped around to the next line. Adding some extra space
+at the end of the toooltip works around this problem.
+
+This variable specifies the number of pixels that shall be added. The
+default value t means to add the width of one canonical character of the
+tip frame. */);
+ Vw32_tooltip_extra_pixels = Qt;
+
#if 0 /* TODO: Port to W32 */
defsubr (&Sx_change_window_property);
defsubr (&Sx_delete_window_property);
@@ -9787,7 +10278,7 @@ typedef USHORT (WINAPI * CaptureStackBackTrace_proc) (ULONG, ULONG, PVOID *,
#define BACKTRACE_LIMIT_MAX 62
-int
+static int
w32_backtrace (void **buffer, int limit)
{
static CaptureStackBackTrace_proc s_pfn_CaptureStackBackTrace = NULL;
@@ -9860,8 +10351,8 @@ emacs_abort (void)
but not on Windows 7. addr2line doesn't mind a missing
"0x", but will be confused by an extra one. */
if (except_addr)
- sprintf (buf, "\r\nException 0x%lx at this address:\r\n%p\r\n",
- except_code, except_addr);
+ sprintf (buf, "\r\nException 0x%x at this address:\r\n%p\r\n",
+ (unsigned int) except_code, except_addr);
if (stderr_fd >= 0)
{
if (except_addr)
diff --git a/src/w32font.c b/src/w32font.c
index 018e6572563..4d15cffb9f6 100644
--- a/src/w32font.c
+++ b/src/w32font.c
@@ -102,7 +102,6 @@ static void list_all_matching_fonts (struct font_callback_data *);
static BOOL g_b_init_get_outline_metrics_w;
static BOOL g_b_init_get_text_metrics_w;
static BOOL g_b_init_get_glyph_outline_w;
-static BOOL g_b_init_get_glyph_outline_w;
static BOOL g_b_init_get_char_width_32_w;
typedef UINT (WINAPI * GetOutlineTextMetricsW_Proc) (
@@ -1688,7 +1687,7 @@ w32_to_x_charset (int fncharset, char *matching)
/* Handle startup case of w32-charset-info-alist not
being set up yet. */
if (NILP (Vw32_charset_info_alist))
- return "iso8859-1";
+ return (char *)"iso8859-1";
charset_type = Qw32_charset_ansi;
break;
case DEFAULT_CHARSET:
@@ -1748,7 +1747,7 @@ w32_to_x_charset (int fncharset, char *matching)
default:
/* Encode numerical value of unknown charset. */
- sprintf (buf, "*-#%u", fncharset);
+ sprintf (buf, "*-#%d", fncharset);
return buf;
}
@@ -1835,7 +1834,7 @@ w32_to_x_charset (int fncharset, char *matching)
/* If no match, encode the numeric value. */
if (!best_match)
{
- sprintf (buf, "*-#%u", fncharset);
+ sprintf (buf, "*-#%d", fncharset);
return buf;
}
@@ -2355,7 +2354,7 @@ w32font_full_name (LOGFONT * font, Lisp_Object font_obj,
{
if (outline)
{
- float pointsize = height * 72.0 / one_w32_display_info.resy;
+ double pointsize = height * 72.0 / one_w32_display_info.resy;
/* Round to nearest half point. floor is used, since round is not
supported in MS library. */
pointsize = floor (pointsize * 2 + 0.5) / 2;
diff --git a/src/w32font.h b/src/w32font.h
index 728ad8be96c..0e2d0f79820 100644
--- a/src/w32font.h
+++ b/src/w32font.h
@@ -84,7 +84,6 @@ int uniscribe_check_otf (LOGFONT *font, Lisp_Object otf_spec);
Lisp_Object intern_font_name (char *);
-extern void syms_of_w32font (void);
extern void globals_of_w32font (void);
#endif
diff --git a/src/w32heap.c b/src/w32heap.c
index 3e628d54c42..26a04413df1 100644
--- a/src/w32heap.c
+++ b/src/w32heap.c
@@ -50,9 +50,11 @@
#include <errno.h>
#include <sys/mman.h>
+#include <sys/resource.h>
#include "w32common.h"
#include "w32heap.h"
#include "lisp.h"
+#include "w32.h" /* for FD_SETSIZE */
/* We chose to leave those declarations here. They are used only in
this file. The RtlCreateHeap is available since XP. It is located
@@ -114,7 +116,7 @@ typedef struct _RTL_HEAP_PARAMETERS {
to build only the first bootstrap-emacs.exe with the large size,
and reset that to a lower value afterwards. */
#if defined _WIN64 || defined WIDE_EMACS_INT
-# define DUMPED_HEAP_SIZE (20*1024*1024)
+# define DUMPED_HEAP_SIZE (21*1024*1024)
#else
# define DUMPED_HEAP_SIZE (12*1024*1024)
#endif
@@ -189,7 +191,7 @@ free_fn the_free_fn;
claims for new memory. Before dumping, we allocate space
from the fixed size dumped_data[] array.
*/
-NTSTATUS NTAPI
+static NTSTATUS NTAPI
dumped_data_commit (PVOID Base, PVOID *CommitAddress, PSIZE_T CommitSize)
{
/* This is used before dumping.
@@ -317,15 +319,18 @@ init_heap (void)
cache_system_info ();
}
+
+/* malloc, realloc, free. */
+
#undef malloc
#undef realloc
#undef free
/* FREEABLE_P checks if the block can be safely freed. */
#define FREEABLE_P(addr) \
- ((unsigned char *)(addr) > 0 \
- && ((unsigned char *)(addr) < dumped_data \
- || (unsigned char *)(addr) >= dumped_data + DUMPED_HEAP_SIZE))
+ ((DWORD_PTR)(unsigned char *)(addr) > 0 \
+ && ((unsigned char *)(addr) < dumped_data \
+ || (unsigned char *)(addr) >= dumped_data + DUMPED_HEAP_SIZE))
void *
malloc_after_dump (size_t size)
@@ -623,9 +628,12 @@ sbrk (ptrdiff_t increment)
return data_region_end;
}
-#define MAX_BUFFER_SIZE (512 * 1024 * 1024)
+
/* MMAP allocation for buffers. */
+
+#define MAX_BUFFER_SIZE (512 * 1024 * 1024)
+
void *
mmap_alloc (void **var, size_t nbytes)
{
@@ -708,7 +716,7 @@ mmap_realloc (void **var, size_t nbytes)
if (memInfo.RegionSize < nbytes)
{
memset (&m2, 0, sizeof (m2));
- if (VirtualQuery (*var + memInfo.RegionSize, &m2, sizeof(m2)) == 0)
+ if (VirtualQuery ((char *)*var + memInfo.RegionSize, &m2, sizeof(m2)) == 0)
DebPrint (("mmap_realloc: VirtualQuery error = %ld\n",
GetLastError ()));
/* If there is enough room in the current reserved area, then
@@ -778,7 +786,7 @@ mmap_realloc (void **var, size_t nbytes)
}
/* We still can decommit pages. */
- if (VirtualFree (*var + nbytes + get_page_size(),
+ if (VirtualFree ((char *)*var + nbytes + get_page_size(),
memInfo.RegionSize - nbytes - get_page_size(),
MEM_DECOMMIT) == 0)
DebPrint (("mmap_realloc: VirtualFree error %ld\n", GetLastError ()));
@@ -788,3 +796,78 @@ mmap_realloc (void **var, size_t nbytes)
/* Not enlarging, not shrinking by more than one page. */
return *var;
}
+
+
+/* Emulation of getrlimit and setrlimit. */
+
+int
+getrlimit (rlimit_resource_t rltype, struct rlimit *rlp)
+{
+ int retval = -1;
+
+ switch (rltype)
+ {
+ case RLIMIT_STACK:
+ {
+ MEMORY_BASIC_INFORMATION m;
+ /* Implementation note: Posix says that RLIMIT_STACK returns
+ information about the stack size for the main thread. The
+ implementation below returns the stack size for the calling
+ thread, so it's more like pthread_attr_getstacksize. But
+ Emacs clearly wants the latter, given how it uses the
+ results, so the implementation below is more future-proof,
+ if what's now the main thread will become some other thread
+ at some future point. */
+ if (!VirtualQuery ((LPCVOID) &m, &m, sizeof m))
+ errno = EPERM;
+ else
+ {
+ rlp->rlim_cur = (DWORD_PTR) &m - (DWORD_PTR) m.AllocationBase;
+ rlp->rlim_max =
+ (DWORD_PTR) m.BaseAddress + m.RegionSize
+ - (DWORD_PTR) m.AllocationBase;
+
+ /* The last page is the guard page, so subtract that. */
+ rlp->rlim_cur -= getpagesize ();
+ rlp->rlim_max -= getpagesize ();
+ retval = 0;
+ }
+ }
+ break;
+ case RLIMIT_NOFILE:
+ /* Implementation note: The real value is returned by
+ _getmaxstdio. But our FD_SETSIZE is smaller, to cater to
+ Windows 9X, and process.c includes some logic that's based on
+ the assumption that the handle resource is inherited to child
+ processes. We want to avoid that logic, so we tell process.c
+ our current limit is already equal to FD_SETSIZE. */
+ rlp->rlim_cur = FD_SETSIZE;
+ rlp->rlim_max = 2048; /* see _setmaxstdio documentation */
+ retval = 0;
+ break;
+ default:
+ /* Note: we could return meaningful results for other RLIMIT_*
+ requests, but Emacs doesn't currently need that, so we just
+ punt for them. */
+ errno = ENOSYS;
+ break;
+ }
+ return retval;
+}
+
+int
+setrlimit (rlimit_resource_t rltype, const struct rlimit *rlp)
+{
+ switch (rltype)
+ {
+ case RLIMIT_STACK:
+ case RLIMIT_NOFILE:
+ /* We cannot modfy these limits, so we always fail. */
+ errno = EPERM;
+ break;
+ default:
+ errno = ENOSYS;
+ break;
+ }
+ return -1;
+}
diff --git a/src/w32heap.h b/src/w32heap.h
index 523bcebe125..4f2d6c82a78 100644
--- a/src/w32heap.h
+++ b/src/w32heap.h
@@ -61,10 +61,10 @@ int open_output_file (file_data *p_file, char *name, unsigned long size);
void close_file_data (file_data *p_file);
/* Return pointer to section header for named section. */
-IMAGE_SECTION_HEADER * find_section (char * name, IMAGE_NT_HEADERS * nt_header);
+IMAGE_SECTION_HEADER * find_section (const char *, IMAGE_NT_HEADERS *);
/* Return pointer to section header for section containing the given
relative virtual address. */
-IMAGE_SECTION_HEADER * rva_to_section (DWORD_PTR rva, IMAGE_NT_HEADERS * nt_header);
+IMAGE_SECTION_HEADER * rva_to_section (DWORD_PTR, IMAGE_NT_HEADERS *);
#endif /* NTHEAP_H_ */
diff --git a/src/w32inevt.c b/src/w32inevt.c
index 867425f0bf2..2269d318051 100644
--- a/src/w32inevt.c
+++ b/src/w32inevt.c
@@ -41,6 +41,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "termchar.h" /* for Mouse_HLInfo, tty_display_info */
#include "w32term.h"
#include "w32inevt.h"
+#include "w32common.h"
/* stdin, from w32console.c */
extern HANDLE keyboard_handle;
@@ -148,10 +149,12 @@ key_event (KEY_EVENT_RECORD *event, struct input_event *emacs_ev, int *isdead)
switch (event->wVirtualKeyCode)
{
case VK_LWIN:
- mod_key_state &= ~LEFT_WIN_PRESSED;
+ if (!w32_kbdhook_active)
+ mod_key_state &= ~LEFT_WIN_PRESSED;
break;
case VK_RWIN:
- mod_key_state &= ~RIGHT_WIN_PRESSED;
+ if (!w32_kbdhook_active)
+ mod_key_state &= ~RIGHT_WIN_PRESSED;
break;
case VK_APPS:
mod_key_state &= ~APPS_PRESSED;
@@ -185,7 +188,8 @@ key_event (KEY_EVENT_RECORD *event, struct input_event *emacs_ev, int *isdead)
keybd_event (faked_key, (BYTE) MapVirtualKey (faked_key, 0), 0, 0);
}
}
- mod_key_state |= LEFT_WIN_PRESSED;
+ if (!w32_kbdhook_active)
+ mod_key_state |= LEFT_WIN_PRESSED;
if (!NILP (Vw32_lwindow_modifier))
return 0;
break;
@@ -201,7 +205,8 @@ key_event (KEY_EVENT_RECORD *event, struct input_event *emacs_ev, int *isdead)
keybd_event (faked_key, (BYTE) MapVirtualKey (faked_key, 0), 0, 0);
}
}
- mod_key_state |= RIGHT_WIN_PRESSED;
+ if (!w32_kbdhook_active)
+ mod_key_state |= RIGHT_WIN_PRESSED;
if (!NILP (Vw32_rwindow_modifier))
return 0;
break;
@@ -267,6 +272,13 @@ key_event (KEY_EVENT_RECORD *event, struct input_event *emacs_ev, int *isdead)
/* Recognize state of Windows and Apps keys. */
event->dwControlKeyState |= mod_key_state;
+ if (w32_kbdhook_active)
+ {
+ if (check_w32_winkey_state (VK_LWIN))
+ event->dwControlKeyState |= LEFT_WIN_PRESSED;
+ if (check_w32_winkey_state (VK_RWIN))
+ event->dwControlKeyState |= RIGHT_WIN_PRESSED;
+ }
/* Distinguish numeric keypad keys from extended keys. */
event->wVirtualKeyCode =
@@ -608,70 +620,89 @@ maybe_generate_resize_event (void)
int
handle_file_notifications (struct input_event *hold_quit)
{
- BYTE *p = file_notifications;
- FILE_NOTIFY_INFORMATION *fni = (PFILE_NOTIFY_INFORMATION)p;
- const DWORD min_size
- = offsetof (FILE_NOTIFY_INFORMATION, FileName) + sizeof(wchar_t);
- struct input_event inev;
+ struct notifications_set *ns = NULL;
int nevents = 0;
+ int done = 0;
/* We cannot process notification before Emacs is fully initialized,
since we need the UTF-16LE coding-system to be set up. */
if (!initialized)
{
- notification_buffer_in_use = 0;
return nevents;
}
- enter_crit ();
- if (notification_buffer_in_use)
+ while (!done)
{
- DWORD info_size = notifications_size;
- Lisp_Object cs = Qutf_16le;
- Lisp_Object obj = w32_get_watch_object (notifications_desc);
-
- /* notifications_size could be zero when the buffer of
- notifications overflowed on the OS level, or when the
- directory being watched was itself deleted. Do nothing in
- that case. */
- if (info_size
- && !NILP (obj) && CONSP (obj))
- {
- Lisp_Object callback = XCDR (obj);
+ ns = NULL;
- EVENT_INIT (inev);
+ /* Find out if there is a record available in the linked list of
+ notifications sets. If so, unlink te set from the linked list.
+ Use the critical section. */
+ enter_crit ();
+ if (notifications_set_head->next != notifications_set_head)
+ {
+ ns = notifications_set_head->next;
+ ns->prev->next = ns->next;
+ ns->next->prev = ns->prev;
+ }
+ else
+ done = 1;
+ leave_crit();
- while (info_size >= min_size)
+ if (ns)
+ {
+ BYTE *p = ns->notifications;
+ FILE_NOTIFY_INFORMATION *fni = (PFILE_NOTIFY_INFORMATION)p;
+ const DWORD min_size
+ = offsetof (FILE_NOTIFY_INFORMATION, FileName) + sizeof(wchar_t);
+ struct input_event inev;
+ DWORD info_size = ns->size;
+ Lisp_Object cs = Qutf_16le;
+ Lisp_Object obj = w32_get_watch_object (ns->desc);
+
+ /* notifications size could be zero when the buffer of
+ notifications overflowed on the OS level, or when the
+ directory being watched was itself deleted. Do nothing in
+ that case. */
+ if (info_size
+ && !NILP (obj) && CONSP (obj))
{
- Lisp_Object utf_16_fn
- = make_unibyte_string ((char *)fni->FileName,
- fni->FileNameLength);
- /* Note: mule-conf is preloaded, so utf-16le must
- already be defined at this point. */
- Lisp_Object fname
- = code_convert_string_norecord (utf_16_fn, cs, 0);
- Lisp_Object action = lispy_file_action (fni->Action);
-
- inev.kind = FILE_NOTIFY_EVENT;
- inev.timestamp = GetTickCount ();
- inev.modifiers = 0;
- inev.frame_or_window = callback;
- inev.arg = Fcons (action, fname);
- inev.arg = list3 (make_pointer_integer (notifications_desc),
- action, fname);
- kbd_buffer_store_event_hold (&inev, hold_quit);
- nevents++;
-
- if (!fni->NextEntryOffset)
- break;
- p += fni->NextEntryOffset;
- fni = (PFILE_NOTIFY_INFORMATION)p;
- info_size -= fni->NextEntryOffset;
+ Lisp_Object callback = XCDR (obj);
+
+ EVENT_INIT (inev);
+
+ while (info_size >= min_size)
+ {
+ Lisp_Object utf_16_fn
+ = make_unibyte_string ((char *)fni->FileName,
+ fni->FileNameLength);
+ /* Note: mule-conf is preloaded, so utf-16le must
+ already be defined at this point. */
+ Lisp_Object fname
+ = code_convert_string_norecord (utf_16_fn, cs, 0);
+ Lisp_Object action = lispy_file_action (fni->Action);
+
+ inev.kind = FILE_NOTIFY_EVENT;
+ inev.timestamp = GetTickCount ();
+ inev.modifiers = 0;
+ inev.frame_or_window = callback;
+ inev.arg = Fcons (action, fname);
+ inev.arg = list3 (make_pointer_integer (ns->desc),
+ action, fname);
+ kbd_buffer_store_event_hold (&inev, hold_quit);
+ nevents++;
+ if (!fni->NextEntryOffset)
+ break;
+ p += fni->NextEntryOffset;
+ fni = (PFILE_NOTIFY_INFORMATION)p;
+ info_size -= fni->NextEntryOffset;
+ }
}
+ /* Free this notification set. */
+ free (ns->notifications);
+ free (ns);
}
- notification_buffer_in_use = 0;
}
- leave_crit ();
return nevents;
}
#else /* !HAVE_W32NOTIFY */
diff --git a/src/w32menu.c b/src/w32menu.c
index d9ab8f5e518..7c66360becd 100644
--- a/src/w32menu.c
+++ b/src/w32menu.c
@@ -60,9 +60,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
HMENU current_popup_menu;
-void syms_of_w32menu (void);
-void globals_of_w32menu (void);
-
typedef BOOL (WINAPI * GetMenuItemInfoA_Proc) (
IN HMENU,
IN UINT,
@@ -80,10 +77,10 @@ typedef int (WINAPI * MessageBoxW_Proc) (
IN UINT type);
#ifdef NTGUI_UNICODE
-#define get_menu_item_info GetMenuItemInfoA
-#define set_menu_item_info SetMenuItemInfoA
-#define unicode_append_menu AppendMenuW
-#define unicode_message_box MessageBoxW
+GetMenuItemInfoA_Proc get_menu_item_info = GetMenuItemInfoA;
+SetMenuItemInfoA_Proc set_menu_item_info = SetMenuItemInfoA;
+AppendMenuW_Proc unicode_append_menu = AppendMenuW;
+MessageBoxW_Proc unicode_message_box = MessageBoxW;
#else /* !NTGUI_UNICODE */
GetMenuItemInfoA_Proc get_menu_item_info = NULL;
SetMenuItemInfoA_Proc set_menu_item_info = NULL;
@@ -91,8 +88,6 @@ AppendMenuW_Proc unicode_append_menu = NULL;
MessageBoxW_Proc unicode_message_box = NULL;
#endif /* NTGUI_UNICODE */
-void set_frame_menubar (struct frame *, bool, bool);
-
#ifdef HAVE_DIALOGS
static Lisp_Object w32_dialog_show (struct frame *, Lisp_Object, Lisp_Object, char **);
#else
@@ -172,6 +167,7 @@ x_activate_menubar (struct frame *f)
when the user makes a selection.
Figure out what the user chose
and put the appropriate events into the keyboard buffer. */
+void menubar_selection_callback (struct frame *, void *);
void
menubar_selection_callback (struct frame *f, void * client_data)
@@ -831,7 +827,7 @@ w32_menu_show (struct frame *f, int x, int y, int menuflags,
{
unblock_input ();
/* Make "Cancel" equivalent to C-g. */
- Fsignal (Qquit, Qnil);
+ quit ();
}
unblock_input ();
@@ -1023,7 +1019,7 @@ w32_dialog_show (struct frame *f, Lisp_Object title,
}
else
/* Make "Cancel" equivalent to C-g. */
- Fsignal (Qquit, Qnil);
+ quit ();
return Qnil;
}
@@ -1111,7 +1107,7 @@ simple_dialog_show (struct frame *f, Lisp_Object contents, Lisp_Object header)
}
else
{
- text = L"";
+ text = (WCHAR *)L"";
}
if (NILP (header))
@@ -1159,7 +1155,7 @@ simple_dialog_show (struct frame *f, Lisp_Object contents, Lisp_Object header)
else if (answer == IDNO)
lispy_answer = build_string ("No");
else
- Fsignal (Qquit, Qnil);
+ quit ();
for (temp = XCDR (contents); CONSP (temp); temp = XCDR (temp))
{
@@ -1181,8 +1177,7 @@ simple_dialog_show (struct frame *f, Lisp_Object contents, Lisp_Object header)
return value;
}
}
- Fsignal (Qquit, Qnil);
- return Qnil;
+ return quit ();
}
#endif /* !HAVE_DIALOGS */
@@ -1465,6 +1460,8 @@ fill_in_menu (HMENU menu, widget_value *wv)
/* Display help string for currently pointed to menu item. Not
supported on NT 3.51 and earlier, as GetMenuItemInfo is not
available. */
+void w32_menu_display_help (HWND, HMENU, UINT, UINT);
+
void
w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags)
{
diff --git a/src/w32notify.c b/src/w32notify.c
index 586c2062f62..32a03f70a66 100644
--- a/src/w32notify.c
+++ b/src/w32notify.c
@@ -22,27 +22,30 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
For each watch request, we launch a separate worker thread. The
worker thread runs the watch_worker function, which issues an
- asynchronous call to ReadDirectoryChangesW, and then waits in
- SleepEx for that call to complete. Waiting in SleepEx puts the
- thread in an "alertable" state, so it wakes up when either (a) the
- call to ReadDirectoryChangesW completes, or (b) the main thread
- instructs the worker thread to terminate by sending it an APC, see
- below.
+ asynchronous call to ReadDirectoryChangesW, and then calls
+ WaitForSingleObjectEx to wait that an event be signaled
+ to terminate the thread.
+ Waiting with WaitForSingleObjectEx puts the thread in an
+ "alertable" state, so it wakes up when either (a) the call to
+ ReadDirectoryChangesW completes, or (b) the main thread instructs
+ the worker thread to terminate by signaling an event, see below.
When the ReadDirectoryChangesW call completes, its completion
routine watch_completion is automatically called. watch_completion
- stashes the received file events in a buffer used to communicate
- them to the main thread (using a critical section, so that several
- threads could use the same buffer), posts a special message,
- WM_EMACS_FILENOTIFY, to the Emacs's message queue, and returns.
- That causes the SleepEx function call inside watch_worker to
- return, and watch_worker then issues another call to
- ReadDirectoryChangesW. (Except when it does not, see below.)
+ stashes the received file events in a linked list used to
+ communicate them to the main thread (using a critical section, so
+ that several threads could alter the same linked list), posts a
+ special message, WM_EMACS_FILENOTIFY, to the Emacs's message queue,
+ 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.)
In a GUI session, the WM_EMACS_FILENOTIFY message posted to the
message queue gets dispatched to the main Emacs window procedure,
which queues it for processing by w32_read_socket. When
- w32_read_socket sees this message, it accesses the buffer with file
+ w32_read_socket sees this message, it accesses the linked list with file
notifications (using a critical section), extracts the information,
converts it to a series of FILE_NOTIFY_EVENT events, and stuffs
them into the input event queue to be processed by keyboard.c input
@@ -53,7 +56,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
procedures in console programs. That message wakes up
MsgWaitForMultipleObjects inside sys_select, which then signals to
its caller that some keyboard input is available. This causes
- w32_console_read_socket to be called, which accesses the buffer
+ w32_console_read_socket to be called, which accesses the linked list
with file notifications and stuffs them into the input event queue
for keyboard.c to process.
@@ -62,30 +65,30 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
bound to a command. The default binding is file-notify-handle-event,
defined on subr.el.
- After w32_read_socket or w32_console_read_socket are done
- processing the notifications, they reset a flag signaling to all
- watch worker threads that the notifications buffer is available for
- more input.
+ Routines w32_read_socket or w32_console_read_socket process notifications
+ sets as long as some are available.
When the watch is removed by a call to w32notify-rm-watch, the main
- thread requests that the worker thread terminates by queuing an APC
- for the worker thread. The APC specifies the watch_end function to
- be called. watch_end calls CancelIo on the outstanding
- ReadDirectoryChangesW call and closes the handle on which the
- watched directory was open. When watch_end returns, the
- watch_completion function is called one last time with the
- ERROR_OPERATION_ABORTED status, which causes it to clean up and set
- a flag telling watch_worker to exit without issuing another
- ReadDirectoryChangesW call. Since watch_worker is the thread
- procedure of the worker thread, exiting it causes the thread to
- exit. The main thread waits for some time for the worker thread to
- exit, and if it doesn't, terminates it forcibly. */
+ thread requests that the worker thread terminates by signaling the
+ appropriate event and queuing an APC for the worker thread. The
+ APC specifies the watch_end function to be called. watch_end calls
+ CancelIo on the outstanding ReadDirectoryChangesW call. When
+ watch_end returns, the watch_completion function is called one last
+ time with the ERROR_OPERATION_ABORTED status, which causes it to
+ clean up and set a flag telling watch_worker to exit without
+ issuing another ReadDirectoryChangesW call. Since watch_worker is
+ the thread procedure of the worker thread, exiting it causes the
+ thread to exit. The main thread waits for some time for the worker
+ thread to exit, and if it doesn't, terminates it forcibly. */
+
+#define DEFER_MS_W32_H
+#include <config.h>
#include <stddef.h>
#include <errno.h>
-/* must include CRT headers *before* config.h */
-#include <config.h>
+/* Include CRT headers *before* ms-w32.h. */
+#include <ms-w32.h>
#include <windows.h>
@@ -98,6 +101,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "frame.h" /* needed by termhooks.h */
#include "termhooks.h" /* for FILE_NOTIFY_EVENT */
+#define DIRWATCH_BUFFER_SIZE 16384
#define DIRWATCH_SIGNATURE 0x01233210
struct notification {
@@ -108,73 +112,53 @@ struct notification {
char *watchee; /* the file we are interested in, UTF-8 encoded */
HANDLE dir; /* handle to the watched directory */
HANDLE thr; /* handle to the thread that watches */
- volatile int terminate; /* if non-zero, request for the thread to terminate */
+ HANDLE terminate; /* event signaling the thread to terminate */
unsigned signature;
};
/* Used for communicating notifications to the main thread. */
-volatile int notification_buffer_in_use;
-BYTE file_notifications[16384];
-DWORD notifications_size;
-void *notifications_desc;
+struct notifications_set *notifications_set_head;
static Lisp_Object watch_list;
/* Signal to the main thread that we have file notifications for it to
process. */
static void
-send_notifications (BYTE *info, DWORD info_size, void *desc,
- volatile int *terminate)
+send_notifications (struct notifications_set *ns)
{
- int done = 0;
struct frame *f = SELECTED_FRAME ();
- /* A single buffer is used to communicate all notifications to the
- main thread. Since both the main thread and several watcher
- threads could be active at the same time, we use a critical area
- and an "in-use" flag to synchronize them. A watcher thread can
- only put its notifications in the buffer if it acquires the
- critical area and finds the "in-use" flag reset. The main thread
- resets the flag after it is done processing notifications.
-
- FIXME: is there a better way of dealing with this? */
- while (!done && !*terminate)
- {
+ /* We add the current notification set to the linked list. Use the
+ critical section to make sure only one thread will access the
+ linked list. */
enter_crit ();
- if (!notification_buffer_in_use)
- {
- if (info_size)
- memcpy (file_notifications, info,
- min (info_size, sizeof (file_notifications)));
- notifications_size = min (info_size, sizeof (file_notifications));
- notifications_desc = desc;
- /* If PostMessage fails, the message queue is full. If that
- happens, the last thing they will worry about is file
- notifications. So we effectively discard the
- notification in that case. */
- if ((FRAME_TERMCAP_P (f)
- /* We send the message to the main (a.k.a. "Lisp")
- thread, where it will wake up MsgWaitForMultipleObjects
- inside sys_select, causing it to report that there's
- some keyboard input available. This will in turn cause
- w32_console_read_socket to be called, which will pick
- up the file notifications. */
- && PostThreadMessage (dwMainThreadId, WM_EMACS_FILENOTIFY, 0, 0))
- || (FRAME_W32_P (f)
- && PostMessage (FRAME_W32_WINDOW (f),
- WM_EMACS_FILENOTIFY, 0, 0))
- /* When we are running in batch mode, there's no one to
- send a message, so we just signal the data is
- available and hope sys_select will be called soon and
- will read the data. */
- || (FRAME_INITIAL_P (f) && noninteractive))
- notification_buffer_in_use = 1;
- done = 1;
- }
- leave_crit ();
- if (!done)
- Sleep (5);
- }
+ ns->next = notifications_set_head;
+ ns->prev = notifications_set_head->prev;
+ ns->prev->next = ns;
+ notifications_set_head->prev = ns;
+ leave_crit();
+
+ /* If PostMessage fails, the message queue is full. If that
+ happens, the last thing they will worry about is file
+ notifications. So we effectively discard the notification in
+ that case. */
+ if (FRAME_TERMCAP_P (f))
+ /* We send the message to the main (a.k.a. "Lisp") thread, where
+ it will wake up MsgWaitForMultipleObjects inside sys_select,
+ causing it to report that there's some keyboard input
+ available. This will in turn cause w32_console_read_socket to
+ be called, which will pick up the file notifications. */
+ PostThreadMessage (dwMainThreadId, WM_EMACS_FILENOTIFY, 0, 0);
+ else if (FRAME_W32_P (f))
+ PostMessage (FRAME_W32_WINDOW (f),
+ WM_EMACS_FILENOTIFY, 0, 0);
+ /* When we are running in batch mode, there's no one to send a
+ message, so we just signal the data is available and hope
+ sys_select will be called soon and will read the data. */
+#if 0
+ else if (FRAME_INITIAL_P (f) && noninteractive)
+ ;
+#endif
}
/* An APC routine to cancel outstanding directory watch. Invoked by
@@ -182,33 +166,40 @@ send_notifications (BYTE *info, DWORD info_size, void *desc,
thread that issued the ReadDirectoryChangesW call can call CancelIo
to cancel that. (CancelIoEx is only available since Vista, so we
cannot use it on XP.) */
+VOID CALLBACK watch_end (ULONG_PTR);
+
VOID CALLBACK
watch_end (ULONG_PTR arg)
{
HANDLE hdir = (HANDLE)arg;
if (hdir && hdir != INVALID_HANDLE_VALUE)
- {
- CancelIo (hdir);
- CloseHandle (hdir);
- }
+ CancelIo (hdir);
}
/* A completion routine (a.k.a. "APC function") for handling events
read by ReadDirectoryChangesW. Called by the OS when the thread
which issued the asynchronous ReadDirectoryChangesW call is in the
"alertable state", i.e. waiting inside SleepEx call. */
+VOID CALLBACK watch_completion (DWORD, DWORD, OVERLAPPED *);
+
VOID CALLBACK
watch_completion (DWORD status, DWORD bytes_ret, OVERLAPPED *io_info)
{
struct notification *dirwatch;
+ DWORD _bytes;
+ struct notifications_set *ns = NULL;
+ BOOL terminate = FALSE;
/* Who knows what happened? Perhaps the OVERLAPPED structure was
freed by someone already? In any case, we cannot do anything
with this request, so just punt and skip it. FIXME: should we
raise the 'terminate' flag in this case? */
if (!io_info)
- return;
+ {
+ DebPrint(("watch_completion: io_info is null.\n"));
+ return;
+ }
/* We have a pointer to our dirwatch structure conveniently stashed
away in the hEvent member of the OVERLAPPED struct. According to
@@ -216,26 +207,69 @@ watch_completion (DWORD status, DWORD bytes_ret, OVERLAPPED *io_info)
of the OVERLAPPED structure is not used by the system, so you can
use it yourself." */
dirwatch = (struct notification *)io_info->hEvent;
+
if (status == ERROR_OPERATION_ABORTED)
{
/* We've been called because the main thread told us to issue
CancelIo on the directory we watch, and watch_end did so.
- The directory handle is already closed. We should clean up
- and exit, signaling to the thread worker routine not to
- issue another call to ReadDirectoryChangesW. Note that we
- don't free the dirwatch object itself nor the memory consumed
- by its buffers; this is done by the main thread in
- remove_watch. Calling malloc/free from a thread other than
- the main thread is a no-no. */
- dirwatch->dir = NULL;
- dirwatch->terminate = 1;
+ We must exit, without issuing another call to
+ ReadDirectoryChangesW. */
+ return;
}
- else
+
+ /* We allocate a new set of notifications to be linked to the linked
+ list of notifications set. This will be processed by Emacs event
+ loop in the main thread. We need to duplicate the notifications
+ buffer, but not the dirwatch structure. */
+
+ /* Implementation note: In general, allocating memory in non-main
+ threads is a no-no in Emacs. We certainly cannot call xmalloc
+ and friends, because it can longjmp when allocation fails, which
+ will crash Emacs because the jmp_buf is set up to a location on
+ the main thread's stack. However, we can call 'malloc' directly,
+ since that is redirected to HeapAlloc that uses our private heap,
+ see w32heap.c, and that is thread-safe. */
+ ns = malloc (sizeof(struct notifications_set));
+ if (ns)
+ {
+ memset (ns, 0, sizeof(struct notifications_set));
+ ns->notifications = malloc (bytes_ret);
+ if (ns->notifications)
+ {
+ memcpy (ns->notifications, dirwatch->buf, bytes_ret);
+ ns->size = bytes_ret;
+ ns->desc = dirwatch;
+ }
+ else
+ {
+ free (ns);
+ ns = NULL;
+ }
+ }
+ if (ns == NULL)
+ DebPrint(("Out of memory. Notifications lost."));
+
+ /* Calling ReadDirectoryChangesW quickly to watch again for new
+ notifications. */
+ if (!ReadDirectoryChangesW (dirwatch->dir, dirwatch->buf,
+ DIRWATCH_BUFFER_SIZE, dirwatch->subtree,
+ dirwatch->filter, &_bytes, dirwatch->io_info,
+ watch_completion))
{
- /* Tell the main thread we have notifications for it. */
- send_notifications (dirwatch->buf, bytes_ret, dirwatch,
- &dirwatch->terminate);
+ DebPrint (("ReadDirectoryChangesW error: %lu\n", GetLastError ()));
+ /* If this call fails, it means that the directory is not
+ watchable any more. We need to terminate the worker thread.
+ Still, we will wait until the current notifications have been
+ sent to the main thread. */
+ terminate = TRUE;
}
+
+ if (ns)
+ send_notifications(ns);
+
+ /* If we were asked to terminate the thread, then fire the event. */
+ if (terminate)
+ SetEvent(dirwatch->terminate);
}
/* Worker routine for the watch thread. */
@@ -243,42 +277,43 @@ static DWORD WINAPI
watch_worker (LPVOID arg)
{
struct notification *dirwatch = (struct notification *)arg;
+ BOOL bErr;
+ DWORD _bytes = 0;
+ DWORD status;
+
+ if (dirwatch->dir)
+ {
+ bErr = ReadDirectoryChangesW (dirwatch->dir, dirwatch->buf,
+ DIRWATCH_BUFFER_SIZE, dirwatch->subtree,
+ dirwatch->filter, &_bytes,
+ dirwatch->io_info, watch_completion);
+ if (!bErr)
+ {
+ DebPrint (("ReadDirectoryChangesW: %lu\n", GetLastError ()));
+ /* We cannot remove the dirwatch object from watch_list,
+ because we are in a separate thread. For the same
+ reason, we also cannot free memory consumed by the
+ buffers allocated for the dirwatch object. So we close
+ the directory handle, but do not free the object itself
+ or its buffers. We also don't touch the signature. This
+ way, remove_watch can still identify the object, remove
+ it, and free its memory. */
+ CloseHandle (dirwatch->dir);
+ dirwatch->dir = NULL;
+ return 1;
+ }
+ }
do {
- BOOL status;
- DWORD bytes_ret = 0;
-
- if (dirwatch->dir)
- {
- status = ReadDirectoryChangesW (dirwatch->dir, dirwatch->buf, 16384,
- dirwatch->subtree, dirwatch->filter,
- &bytes_ret,
- dirwatch->io_info, watch_completion);
- if (!status)
- {
- DebPrint (("watch_worker, abnormal exit: %lu\n", GetLastError ()));
- /* We cannot remove the dirwatch object from watch_list,
- because we are in a separate thread. For the same
- reason, we also cannot free memory consumed by the
- buffers allocated for the dirwatch object. So we close
- the directory handle, but do not free the object itself
- or its buffers. We also don't touch the signature.
- This way, remove_watch can still identify the object,
- remove it, and free its memory. */
- CloseHandle (dirwatch->dir);
- dirwatch->dir = NULL;
- return 1;
- }
- }
- /* Sleep indefinitely until awoken by the I/O completion, which
- could be either a change notification or a cancellation of the
- watch. */
- SleepEx (INFINITE, TRUE);
- } while (!dirwatch->terminate);
+ status = WaitForSingleObjectEx(dirwatch->terminate, INFINITE, TRUE);
+ } while (status == WAIT_IO_COMPLETION);
+
+ /* The thread is about to terminate, so we clean up the dir handle. */
+ CloseHandle (dirwatch->dir);
+ dirwatch->dir = NULL;
return 0;
}
-
/* Launch a thread to watch changes to FILE in a directory open on
handle HDIR. */
static struct notification *
@@ -287,7 +322,7 @@ start_watching (const char *file, HANDLE hdir, BOOL subdirs, DWORD flags)
struct notification *dirwatch = xzalloc (sizeof (struct notification));
dirwatch->signature = DIRWATCH_SIGNATURE;
- dirwatch->buf = xmalloc (16384);
+ dirwatch->buf = xmalloc (DIRWATCH_BUFFER_SIZE);
dirwatch->io_info = xzalloc (sizeof(OVERLAPPED));
/* Stash a pointer to dirwatch structure for use by the completion
routine. According to MSDN documentation of ReadDirectoryChangesW:
@@ -297,7 +332,9 @@ start_watching (const char *file, HANDLE hdir, BOOL subdirs, DWORD flags)
dirwatch->subtree = subdirs;
dirwatch->filter = flags;
dirwatch->watchee = xstrdup (file);
- dirwatch->terminate = 0;
+
+ dirwatch->terminate = CreateEvent(NULL, FALSE, FALSE, NULL);
+
dirwatch->dir = hdir;
/* See w32proc.c where it calls CreateThread for the story behind
@@ -307,11 +344,11 @@ start_watching (const char *file, HANDLE hdir, BOOL subdirs, DWORD flags)
if (!dirwatch->thr)
{
+ CloseHandle(dirwatch->terminate);
xfree (dirwatch->buf);
xfree (dirwatch->io_info);
xfree (dirwatch->watchee);
xfree (dirwatch);
- dirwatch = NULL;
}
return dirwatch;
}
@@ -370,7 +407,10 @@ add_watch (const char *parent_dir, const char *file, BOOL subdirs, DWORD flags)
return NULL;
if ((dirwatch = start_watching (file, hdir, subdirs, flags)) == NULL)
- CloseHandle (hdir);
+ {
+ CloseHandle (hdir);
+ dirwatch->dir = NULL;
+ }
return dirwatch;
}
@@ -383,7 +423,7 @@ remove_watch (struct notification *dirwatch)
{
int i;
BOOL status;
- DWORD exit_code, err;
+ DWORD exit_code = 0, err;
/* Only the thread that issued the outstanding I/O call can call
CancelIo on it. (CancelIoEx is available only since Vista.)
@@ -391,12 +431,10 @@ remove_watch (struct notification *dirwatch)
to terminate. */
if (!QueueUserAPC (watch_end, dirwatch->thr, (ULONG_PTR)dirwatch->dir))
DebPrint (("QueueUserAPC failed (%lu)!\n", GetLastError ()));
- /* We also set the terminate flag, for when the thread is
- waiting on the critical section that never gets acquired.
- FIXME: is there a cleaner method? Using SleepEx there is a
- no-no, as that will lead to recursive APC invocations and
- stack overflow. */
- dirwatch->terminate = 1;
+
+ /* We also signal the thread that it can terminate. */
+ SetEvent(dirwatch->terminate);
+
/* Wait for the thread to exit. FIXME: is there a better method
that is not overly complex? */
for (i = 0; i < 50; i++)
@@ -406,11 +444,13 @@ remove_watch (struct notification *dirwatch)
break;
Sleep (10);
}
+
if ((status == FALSE && (err = GetLastError ()) == ERROR_INVALID_HANDLE)
|| exit_code == STILL_ACTIVE)
{
if (!(status == FALSE && err == ERROR_INVALID_HANDLE))
{
+ DebPrint(("Forcing thread termination.\n"));
TerminateThread (dirwatch->thr, 0);
if (dirwatch->dir)
CloseHandle (dirwatch->dir);
@@ -423,11 +463,11 @@ remove_watch (struct notification *dirwatch)
CloseHandle (dirwatch->thr);
dirwatch->thr = NULL;
}
+ CloseHandle(dirwatch->terminate);
xfree (dirwatch->buf);
xfree (dirwatch->io_info);
xfree (dirwatch->watchee);
xfree (dirwatch);
-
return 0;
}
else
diff --git a/src/w32proc.c b/src/w32proc.c
index 4a6f7862801..189034c4e2d 100644
--- a/src/w32proc.c
+++ b/src/w32proc.c
@@ -22,6 +22,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
Adapted from alarm.c by Tim Fleehart
*/
+#define DEFER_MS_W32_H
+#include <config.h>
+
#include <mingw_time.h>
#include <stdio.h>
#include <stdlib.h>
@@ -35,8 +38,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <mbstring.h>
#include <locale.h>
-/* must include CRT headers *before* config.h */
-#include <config.h>
+/* Include CRT headers *before* ms-w32.h. */
+#include <ms-w32.h>
#undef signal
#undef wait
@@ -45,11 +48,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#undef kill
#include <windows.h>
-#if defined(__GNUC__) && !defined(__MINGW64__)
-/* This definition is missing from mingw.org headers, but not MinGW64
- headers. */
-extern BOOL WINAPI IsValidLocale (LCID, DWORD);
-#endif
#ifdef HAVE_LANGINFO_CODESET
#include <nl_types.h>
@@ -70,6 +68,12 @@ extern BOOL WINAPI IsValidLocale (LCID, DWORD);
+ ((DWORD_PTR)(var) - (section)->VirtualAddress) \
+ (filedata).file_base))
+extern BOOL g_b_init_compare_string_w;
+extern BOOL g_b_init_debug_break_process;
+
+int sys_select (int, SELECT_TYPE *, SELECT_TYPE *, SELECT_TYPE *,
+ struct timespec *, void *);
+
/* Signal handlers...SIG_DFL == 0 so this is initialized correctly. */
static signal_handler sig_handlers[NSIG];
@@ -87,9 +91,9 @@ sys_signal (int sig, signal_handler handler)
/* SIGCHLD is needed for supporting subprocesses, see sys_kill
below. SIGALRM and SIGPROF are used by setitimer. All the
others are the only ones supported by the MS runtime. */
- if (!(sig == SIGCHLD || sig == SIGSEGV || sig == SIGILL
+ if (!(sig == SIGINT || sig == SIGSEGV || sig == SIGILL
|| sig == SIGFPE || sig == SIGABRT || sig == SIGTERM
- || sig == SIGALRM || sig == SIGPROF))
+ || sig == SIGCHLD || sig == SIGALRM || sig == SIGPROF))
{
errno = EINVAL;
return SIG_ERR;
@@ -225,7 +229,7 @@ sigismember (const sigset_t *set, int signo)
errno = EINVAL;
return -1;
}
- if (signo > sizeof (*set) * BITS_PER_CHAR)
+ if (signo > sizeof (*set) * CHAR_BIT)
emacs_abort ();
return (*set & (1U << signo)) != 0;
@@ -1728,7 +1732,7 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp)
are not expanded if we run the program directly without a shell.
Some extra whitespace characters need quoting in Cygwin/MSYS programs,
so this list is conditionally modified below. */
- char *sepchars = " \t*?";
+ const char *sepchars = " \t*?";
/* This is for native w32 apps; modified below for Cygwin/MSUS apps. */
char escape_char = '\\';
char cmdname_a[MAX_PATH];
@@ -2495,6 +2499,9 @@ find_child_console (HWND hwnd, LPARAM arg)
return TRUE;
}
+typedef BOOL (WINAPI * DebugBreakProcess_Proc) (
+ HANDLE hProcess);
+
/* Emulate 'kill', but only for other processes. */
int
sys_kill (pid_t pid, int sig)
@@ -2508,9 +2515,9 @@ sys_kill (pid_t pid, int sig)
if (pid < 0)
pid = -pid;
- /* Only handle signals that will result in the process dying */
+ /* Only handle signals that can be mapped to a similar behavior on Windows */
if (sig != 0
- && sig != SIGINT && sig != SIGKILL && sig != SIGQUIT && sig != SIGHUP)
+ && sig != SIGINT && sig != SIGKILL && sig != SIGQUIT && sig != SIGHUP && sig != SIGTRAP)
{
errno = EINVAL;
return -1;
@@ -2553,7 +2560,11 @@ sys_kill (pid_t pid, int sig)
close the selected frame, which does not necessarily
terminates Emacs. But then we are not supposed to call
sys_kill with our own PID. */
- proc_hand = OpenProcess (PROCESS_TERMINATE, 0, pid);
+
+ DWORD desiredAccess =
+ (sig == SIGTRAP) ? PROCESS_ALL_ACCESS : PROCESS_TERMINATE;
+
+ proc_hand = OpenProcess (desiredAccess, 0, pid);
if (proc_hand == NULL)
{
errno = EPERM;
@@ -2649,6 +2660,43 @@ sys_kill (pid_t pid, int sig)
rc = -1;
}
}
+ else if (sig == SIGTRAP)
+ {
+ static DebugBreakProcess_Proc s_pfn_Debug_Break_Process = NULL;
+
+ if (g_b_init_debug_break_process == 0)
+ {
+ g_b_init_debug_break_process = 1;
+ s_pfn_Debug_Break_Process = (DebugBreakProcess_Proc)
+ GetProcAddress (GetModuleHandle ("kernel32.dll"),
+ "DebugBreakProcess");
+ }
+
+ if (s_pfn_Debug_Break_Process == NULL)
+ {
+ errno = ENOTSUP;
+ rc = -1;
+ }
+ else if (!s_pfn_Debug_Break_Process (proc_hand))
+ {
+ DWORD err = GetLastError ();
+
+ DebPrint (("sys_kill.DebugBreakProcess return %d "
+ "for pid %lu\n", err, pid));
+
+ switch (err)
+ {
+ case ERROR_ACCESS_DENIED:
+ errno = EPERM;
+ break;
+ default:
+ errno = EINVAL;
+ break;
+ }
+
+ rc = -1;
+ }
+ }
else
{
if (NILP (Vw32_start_process_share_console) && cp && cp->hwnd)
@@ -2815,7 +2863,6 @@ set_process_dir (char * dir)
/* From w32.c */
extern HANDLE winsock_lib;
extern BOOL term_winsock (void);
-extern BOOL init_winsock (int load_now);
DEFUN ("w32-has-winsock", Fw32_has_winsock, Sw32_has_winsock, 0, 1, 0,
doc: /* Test for presence of the Windows socket library `winsock'.
@@ -3522,7 +3569,6 @@ w32_compare_strings (const char *s1, const char *s2, char *locname,
LCID lcid = GetThreadLocale ();
wchar_t *string1_w, *string2_w;
int val, needed;
- extern BOOL g_b_init_compare_string_w;
static CompareStringW_Proc pCompareStringW;
DWORD flags = 0;
diff --git a/src/w32reg.c b/src/w32reg.c
index a87381831e2..25d6bb83934 100644
--- a/src/w32reg.c
+++ b/src/w32reg.c
@@ -56,9 +56,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
*/
static char *
-w32_get_rdb_resource (char *rdb, const char *resource)
+w32_get_rdb_resource (const char *rdb, const char *resource)
{
- char *value = rdb;
+ char *value = (char *)rdb;
int len = strlen (resource);
while (*value)
diff --git a/src/w32select.c b/src/w32select.c
index 138fe853c4d..1754534c3d3 100644
--- a/src/w32select.c
+++ b/src/w32select.c
@@ -76,6 +76,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "lisp.h"
#include "w32common.h" /* os_subtype */
#include "w32term.h" /* for all of the w32 includes */
+#include "w32select.h"
#include "keyboard.h" /* for waiting_for_input */
#include "blockinput.h"
#include "coding.h"
@@ -256,7 +257,7 @@ render (Lisp_Object oformat)
switch (format)
{
case CF_UNICODETEXT:
- htext = convert_to_handle_as_coded (QUNICODE);
+ htext = convert_to_handle_as_coded (Qutf_16le_dos);
break;
case CF_TEXT:
case CF_OEMTEXT:
@@ -1051,6 +1052,113 @@ frame's display, or the first available X display. */)
return Qnil;
}
+/* Support enumerating available clipboard selection formats. */
+
+DEFUN ("w32-selection-targets", Fw32_selection_targets, Sw32_selection_targets,
+ 0, 2, 0,
+ doc: /* Return a vector of data formats available in the specified SELECTION.
+SELECTION should be the name of the selection in question, typically
+one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
+The symbol nil is the same as `PRIMARY', and t is the same as `SECONDARY'.
+
+TERMINAL should be a terminal object or a frame specifying the X
+server to query. If omitted or nil, that stands for the selected
+frame's display, or the first available X display.
+
+This function currently ignores TERMINAL, and only returns non-nil
+for `CLIPBOARD'. The return value is a vector of symbols, each symbol
+representing a data format that is currently available in the clipboard. */)
+ (Lisp_Object selection, Lisp_Object terminal)
+{
+ /* Xlib-like names for standard Windows clipboard data formats.
+ They are in upper-case to mimic xselect.c. A couple of the names
+ were changed to be more like their X counterparts. */
+ static const char *stdfmt_name[] = {
+ "UNDEFINED",
+ "STRING",
+ "BITMAP",
+ "METAFILE",
+ "SYMLINK",
+ "DIF",
+ "TIFF",
+ "OEM_STRING",
+ "DIB",
+ "PALETTE",
+ "PENDATA",
+ "RIFF",
+ "WAVE",
+ "UTF8_STRING",
+ "ENHMETAFILE",
+ "FILE_NAMES", /* DND */
+ "LOCALE", /* not used */
+ "DIBV5"
+ };
+ CHECK_SYMBOL (selection);
+
+ /* Return nil for PRIMARY and SECONDARY selections; for CLIPBOARD, check
+ if the clipboard currently has valid text format contents. */
+
+ if (EQ (selection, QCLIPBOARD))
+ {
+ Lisp_Object val = Qnil;
+
+ setup_config ();
+
+ if (OpenClipboard (NULL))
+ {
+ UINT format = 0;
+
+ /* Count how many formats are available. We ignore the
+ CF_LOCALE format, and don't put it into the vector we
+ return, because CF_LOCALE is automatically created by
+ Windows for any text in the clipboard, so its presence in
+ the value will simply confuse. */
+ int fmtcount = 0;
+ while ((format = EnumClipboardFormats (format)))
+ if (format != CF_LOCALE)
+ fmtcount++;
+
+ if (fmtcount > 0)
+ {
+ int i;
+
+ /* We generate a vector because that's what xselect.c
+ does in this case. */
+ val = Fmake_vector (make_number (fmtcount), Qnil);
+ /* Note: when stepping with GDB through this code, the
+ loop below terminates immediately because
+ EnumClipboardFormats for some reason returns with
+ "Thread does not have a clipboard open" error. */
+ for (i = 0, format = 0;
+ (format = EnumClipboardFormats (format)) != 0; )
+ {
+ const char *name;
+
+ if (format == CF_LOCALE)
+ continue;
+ else if (format < CF_MAX)
+ name = stdfmt_name[format];
+ else
+ {
+ char fmt_name[256];
+
+ if (!GetClipboardFormatName (format, fmt_name,
+ sizeof (fmt_name)))
+ continue;
+ name = fmt_name;
+ }
+ ASET (val, i, intern (name));
+ i++;
+ }
+ }
+ CloseClipboard ();
+ }
+ return val;
+ }
+ /* For PRIMARY and SECONDARY we cons the values in w32--get-selection. */
+ return Qnil;
+}
+
/* One-time init. Called in the un-dumped Emacs, but not in the
dumped version. */
@@ -1060,6 +1168,7 @@ syms_of_w32select (void)
defsubr (&Sw32_set_clipboard_data);
defsubr (&Sw32_get_clipboard_data);
defsubr (&Sw32_selection_exists_p);
+ defsubr (&Sw32_selection_targets);
DEFVAR_LISP ("selection-coding-system", Vselection_coding_system,
doc: /* Coding system for communicating with other programs.
@@ -1109,7 +1218,7 @@ After the communication, this variable is set to nil. */);
current_text = Qnil; staticpro (&current_text);
current_coding_system = Qnil; staticpro (&current_coding_system);
- DEFSYM (QUNICODE, "utf-16le-dos");
+ DEFSYM (Qutf_16le_dos, "utf-16le-dos");
QANSICP = Qnil; staticpro (&QANSICP);
QOEMCP = Qnil; staticpro (&QOEMCP);
}
@@ -1132,7 +1241,7 @@ globals_of_w32select (void)
QOEMCP = coding_from_cp (OEMCP);
if (os_subtype == OS_NT)
- Vselection_coding_system = QUNICODE;
+ Vselection_coding_system = Qutf_16le_dos;
else if (inhibit_window_system)
Vselection_coding_system = QOEMCP;
else
diff --git a/src/w32term.c b/src/w32term.c
index 51743f8f94d..e8d66c9e5a1 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -83,8 +83,6 @@ static int any_help_event_p;
extern unsigned int msh_mousewheel;
-extern void free_frame_menubar (struct frame *);
-
extern int w32_codepage_for_font (char *fontname);
extern Cursor w32_load_cursor (LPCTSTR name);
@@ -178,9 +176,7 @@ static void w32_define_cursor (Window, Cursor);
void x_lower_frame (struct frame *);
void x_scroll_bar_clear (struct frame *);
-void x_wm_set_size_hint (struct frame *, long, bool);
void x_raise_frame (struct frame *);
-void x_set_window_size (struct frame *, bool, int, int, bool);
void x_wm_set_window_state (struct frame *, int);
void x_wm_set_icon_pixmap (struct frame *, int);
static void w32_initialize (void);
@@ -248,7 +244,7 @@ record_event (char *locus, int type)
#endif /* 0 */
-void
+static void
XChangeGC (void *ignore, XGCValues *gc, unsigned long mask,
XGCValues *xgcv)
{
@@ -261,7 +257,7 @@ XChangeGC (void *ignore, XGCValues *gc, unsigned long mask,
}
XGCValues *
-XCreateGC (void *ignore, Window window, unsigned long mask, XGCValues *xgcv)
+XCreateGC (void *ignore, HWND wignore, unsigned long mask, XGCValues *xgcv)
{
XGCValues *gc = xzalloc (sizeof (XGCValues));
@@ -270,12 +266,14 @@ XCreateGC (void *ignore, Window window, unsigned long mask, XGCValues *xgcv)
return gc;
}
-void
+#if 0 /* unused for now, see x_draw_image_glyph_string below */
+static void
XGetGCValues (void *ignore, XGCValues *gc,
unsigned long mask, XGCValues *xgcv)
{
XChangeGC (ignore, xgcv, mask, gc);
}
+#endif
static void
w32_set_clip_rectangle (HDC hdc, RECT *rect)
@@ -321,7 +319,7 @@ w32_restore_glyph_string_clip (struct glyph_string *s)
*/
-void
+static void
w32_draw_underwave (struct glyph_string *s, COLORREF color)
{
int wave_height = 3, wave_length = 2;
@@ -384,7 +382,7 @@ w32_draw_underwave (struct glyph_string *s, COLORREF color)
}
/* Draw a hollow rectangle at the specified position. */
-void
+static void
w32_draw_rectangle (HDC hdc, XGCValues *gc, int x, int y,
int width, int height)
{
@@ -613,7 +611,7 @@ w32_draw_vertical_window_border (struct window *w, int x, int y0, int y1)
r.bottom = y1;
hdc = get_frame_dc (f);
- face = FACE_FROM_ID (f, VERTICAL_BORDER_FACE_ID);
+ face = FACE_FROM_ID_OR_NULL (f, VERTICAL_BORDER_FACE_ID);
if (face)
w32_fill_rect (f, hdc, face->foreground, &r);
else
@@ -630,9 +628,11 @@ w32_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1)
{
struct frame *f = XFRAME (WINDOW_FRAME (w));
HDC hdc = get_frame_dc (f);
- struct face *face = FACE_FROM_ID (f, WINDOW_DIVIDER_FACE_ID);
- struct face *face_first = FACE_FROM_ID (f, WINDOW_DIVIDER_FIRST_PIXEL_FACE_ID);
- struct face *face_last = FACE_FROM_ID (f, WINDOW_DIVIDER_LAST_PIXEL_FACE_ID);
+ struct face *face = FACE_FROM_ID_OR_NULL (f, WINDOW_DIVIDER_FACE_ID);
+ struct face *face_first
+ = FACE_FROM_ID_OR_NULL (f, WINDOW_DIVIDER_FIRST_PIXEL_FACE_ID);
+ struct face *face_last
+ = FACE_FROM_ID_OR_NULL (f, WINDOW_DIVIDER_LAST_PIXEL_FACE_ID);
unsigned long color = face ? face->foreground : FRAME_FOREGROUND_PIXEL (f);
unsigned long color_first = (face_first
? face_first->foreground
@@ -974,7 +974,7 @@ x_set_cursor_gc (struct glyph_string *s)
mask, &xgcv);
else
FRAME_DISPLAY_INFO (s->f)->scratch_cursor_gc
- = XCreateGC (NULL, s->window, mask, &xgcv);
+ = XCreateGC (NULL, FRAME_W32_WINDOW (s->f), mask, &xgcv);
s->gc = FRAME_DISPLAY_INFO (s->f)->scratch_cursor_gc;
}
@@ -991,7 +991,7 @@ x_set_mouse_face_gc (struct glyph_string *s)
/* What face has to be used last for the mouse face? */
face_id = MOUSE_HL_INFO (s->f)->mouse_face_face_id;
- face = FACE_FROM_ID (s->f, face_id);
+ face = FACE_FROM_ID_OR_NULL (s->f, face_id);
if (face == NULL)
face = FACE_FROM_ID (s->f, MOUSE_FACE_ID);
@@ -1023,7 +1023,7 @@ x_set_mouse_face_gc (struct glyph_string *s)
mask, &xgcv);
else
FRAME_DISPLAY_INFO (s->f)->scratch_cursor_gc
- = XCreateGC (NULL, s->window, mask, &xgcv);
+ = XCreateGC (NULL, FRAME_W32_WINDOW (s->f), mask, &xgcv);
s->gc = FRAME_DISPLAY_INFO (s->f)->scratch_cursor_gc;
}
@@ -1204,7 +1204,7 @@ x_draw_glyph_string_background (struct glyph_string *s, bool force_p)
{
/* Fill background with a stipple pattern. */
XSetFillStyle (s->display, s->gc, FillOpaqueStippled);
- XFillRectangle (s->display, s->window, s->gc, s->x,
+ XFillRectangle (s->display, FRAME_W32_WINDOW (s->f), s->gc, s->x,
s->y + box_line_width,
s->background_width,
s->height - 2 * box_line_width);
@@ -1434,7 +1434,7 @@ x_draw_glyphless_glyph_string_foreground (struct glyph_string *s)
{
sprintf ((char *) buf, "%0*X",
glyph->u.glyphless.ch < 0x10000 ? 4 : 6,
- glyph->u.glyphless.ch);
+ (unsigned int) glyph->u.glyphless.ch);
str = buf;
}
@@ -2061,7 +2061,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 (s->display, s->gc, FillOpaqueStippled);
- XFillRectangle (s->display, s->window, s->gc, x, y, w, h);
+ XFillRectangle (s->display, FRAME_W32_WINDOW (s->f), s->gc, x, y, w, h);
XSetFillStyle (s->display, s->gc, FillSolid);
}
else
@@ -2133,7 +2133,7 @@ x_draw_image_glyph_string (struct glyph_string *s)
int depth = DefaultDepthOfScreen (screen);
/* Create a pixmap as large as the glyph string. */
- pixmap = XCreatePixmap (s->display, s->window,
+ pixmap = XCreatePixmap (s->display, FRAME_W32_WINDOW (s->f),
s->background_width,
s->height, depth);
@@ -2275,7 +2275,7 @@ x_draw_stretch_glyph_string (struct glyph_string *s)
{
/* Fill background with a stipple pattern. */
XSetFillStyle (s->display, gc, FillOpaqueStippled);
- XFillRectangle (s->display, s->window, gc, x, y, w, h);
+ XFillRectangle (s->display, FRAME_W32_WINDOW (s->f), gc, x, y, w, h);
XSetFillStyle (s->display, gc, FillSolid);
}
else
@@ -2577,7 +2577,7 @@ x_draw_glyph_string (struct glyph_string *s)
/* Shift display to make room for inserted glyphs. */
-void
+static void
w32_shift_glyphs_for_insert (struct frame *f, int x, int y,
int width, int height, int shift_by)
{
@@ -2874,13 +2874,15 @@ w32_detect_focus_change (struct w32_display_info *dpyinfo, W32Msg *event,
}
+#if 0 /* unused */
/* Handle an event saying the mouse has moved out of an Emacs frame. */
-void
+static void
x_mouse_leave (struct w32_display_info *dpyinfo)
{
x_new_focus_frame (dpyinfo, dpyinfo->w32_focus_event_frame);
}
+#endif
/* The focus has changed, or we have redirected a frame's focus to
another frame (this happens when a frame uses a surrogate
@@ -3211,71 +3213,85 @@ static void
queue_notifications (struct input_event *event, W32Msg *msg, struct frame *f,
int *evcount)
{
- BYTE *p = file_notifications;
- FILE_NOTIFY_INFORMATION *fni = (PFILE_NOTIFY_INFORMATION)p;
- const DWORD min_size
- = offsetof (FILE_NOTIFY_INFORMATION, FileName) + sizeof(wchar_t);
+ struct notifications_set *ns = NULL;
Lisp_Object frame;
+ int done = 0;
/* We cannot process notification before Emacs is fully initialized,
since we need the UTF-16LE coding-system to be set up. */
if (!initialized)
- {
- notification_buffer_in_use = 0;
- return;
- }
+ return;
XSETFRAME (frame, f);
- enter_crit ();
- if (notification_buffer_in_use)
+ while (!done)
{
- DWORD info_size = notifications_size;
- Lisp_Object cs = Qutf_16le;
- Lisp_Object obj = w32_get_watch_object (notifications_desc);
-
- /* notifications_size could be zero when the buffer of
- notifications overflowed on the OS level, or when the
- directory being watched was itself deleted. Do nothing in
- that case. */
- if (info_size
- && !NILP (obj) && CONSP (obj))
+ ns = NULL;
+
+ /* Find out if there is a record available in the linked list of
+ notifications sets. If so, unlink the set from the linked
+ list. Use critical section. */
+ enter_crit ();
+ if (notifications_set_head->next != notifications_set_head)
{
- Lisp_Object callback = XCDR (obj);
+ ns = notifications_set_head->next;
+ ns->prev->next = ns->next;
+ ns->next->prev = ns->prev;
+ }
+ else
+ done = 1;
+ leave_crit();
- while (info_size >= min_size)
+ if (ns)
+ {
+ BYTE *p = ns->notifications;
+ FILE_NOTIFY_INFORMATION *fni = (PFILE_NOTIFY_INFORMATION)p;
+ const DWORD min_size
+ = offsetof (FILE_NOTIFY_INFORMATION, FileName) + sizeof(wchar_t);
+ DWORD info_size = ns->size;
+ Lisp_Object cs = Qutf_16le;
+ Lisp_Object obj = w32_get_watch_object (ns->desc);
+
+ /* notifications size could be zero when the buffer of
+ notifications overflowed on the OS level, or when the
+ directory being watched was itself deleted. Do nothing in
+ that case. */
+ if (info_size
+ && !NILP (obj) && CONSP (obj))
{
- Lisp_Object utf_16_fn
- = make_unibyte_string ((char *)fni->FileName,
- fni->FileNameLength);
- /* Note: mule-conf is preloaded, so utf-16le must
- already be defined at this point. */
- Lisp_Object fname
- = code_convert_string_norecord (utf_16_fn, cs, 0);
- Lisp_Object action = lispy_file_action (fni->Action);
-
- event->kind = FILE_NOTIFY_EVENT;
- event->timestamp = msg->msg.time;
- event->modifiers = 0;
- event->frame_or_window = callback;
- event->arg = list3 (make_pointer_integer (notifications_desc),
- action, fname);
- kbd_buffer_store_event (event);
- (*evcount)++;
-
- if (!fni->NextEntryOffset)
- break;
- p += fni->NextEntryOffset;
- fni = (PFILE_NOTIFY_INFORMATION)p;
- info_size -= fni->NextEntryOffset;
+ Lisp_Object callback = XCDR (obj);
+
+ while (info_size >= min_size)
+ {
+ Lisp_Object utf_16_fn
+ = make_unibyte_string ((char *)fni->FileName,
+ fni->FileNameLength);
+ /* Note: mule-conf is preloaded, so utf-16le must
+ already be defined at this point. */
+ Lisp_Object fname
+ = code_convert_string_norecord (utf_16_fn, cs, 0);
+ Lisp_Object action = lispy_file_action (fni->Action);
+
+ event->kind = FILE_NOTIFY_EVENT;
+ event->timestamp = msg->msg.time;
+ event->modifiers = 0;
+ event->frame_or_window = callback;
+ event->arg = list3 (make_pointer_integer (ns->desc),
+ action, fname);
+ kbd_buffer_store_event (event);
+ (*evcount)++;
+ if (!fni->NextEntryOffset)
+ break;
+ p += fni->NextEntryOffset;
+ fni = (PFILE_NOTIFY_INFORMATION)p;
+ info_size -= fni->NextEntryOffset;
+ }
}
+ /* Free this notifications set. */
+ xfree (ns->notifications);
+ xfree (ns);
}
- notification_buffer_in_use = 0;
}
- else
- DebPrint (("We were promised notifications, but in-use flag is zero!\n"));
- leave_crit ();
-
/* We've stuffed all the events ourselves, so w32_read_socket shouldn't. */
event->kind = NO_EVENT;
}
@@ -4182,6 +4198,7 @@ w32_scroll_bar_handle_click (struct scroll_bar *bar, W32Msg *msg,
y = si.nPos;
bar->dragging = 0;
+ struct frame *f; /* Value is not used. */
FRAME_DISPLAY_INFO (f)->last_mouse_scroll_bar_pos = msg->msg.wParam;
switch (sb_event)
@@ -4297,6 +4314,7 @@ w32_horizontal_scroll_bar_handle_click (struct scroll_bar *bar, W32Msg *msg,
y = si.nMax - si.nPage;
bar->dragging = 0;
+ struct frame *f; /* Value is not used. */
FRAME_DISPLAY_INFO (f)->last_mouse_scroll_bar_pos = msg->msg.wParam;
switch (sb_event)
@@ -4534,6 +4552,8 @@ static char dbcs_lead = 0;
recursively with different messages by the system.
*/
+extern void menubar_selection_callback (struct frame *, void *);
+
static int
w32_read_socket (struct terminal *terminal,
struct input_event *hold_quit)
@@ -5246,6 +5266,10 @@ w32_read_socket (struct terminal *terminal,
}
break;
+ case WM_ENDSESSION:
+ inev.kind = END_SESSION_EVENT;
+ break;
+
case WM_INITMENU:
f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
@@ -5261,8 +5285,6 @@ w32_read_socket (struct terminal *terminal,
if (f)
{
- extern void menubar_selection_callback
- (struct frame *f, void * client_data);
menubar_selection_callback (f, (void *)msg.msg.wParam);
}
@@ -5879,7 +5901,7 @@ xim_close_dpy (dpyinfo)
/* Calculate the absolute position in frame F
from its current recorded position values and gravity. */
-void
+static void
x_calc_absolute_position (struct frame *f)
{
int flags = f->size_hint_flags;
@@ -6555,7 +6577,7 @@ x_free_frame_resources (struct frame *f)
/* Destroy the window of frame F. */
-void
+static void
x_destroy_window (struct frame *f)
{
struct w32_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
@@ -6951,6 +6973,8 @@ w32_init_main_thread (void)
DuplicateHandle (GetCurrentProcess (), GetCurrentThread (),
GetCurrentProcess (), &hMainThread, 0, TRUE,
DUPLICATE_SAME_ACCESS);
+
+
}
DWORD WINAPI w32_msg_worker (void * arg);
diff --git a/src/w32term.h b/src/w32term.h
index 2fed56ed797..e29e99357e8 100644
--- a/src/w32term.h
+++ b/src/w32term.h
@@ -230,25 +230,14 @@ extern struct frame *x_window_to_frame (struct w32_display_info *, HWND);
struct w32_display_info *x_display_info_for_name (Lisp_Object);
-Lisp_Object display_x_get_resource (struct w32_display_info *,
- Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object);
-
/* also defined in xterm.h XXX: factor out to common header */
extern struct w32_display_info *w32_term_init (Lisp_Object,
char *, char *);
extern int w32_defined_color (struct frame *f, const char *color,
XColor *color_def, bool alloc_p);
-extern void x_set_window_size (struct frame *f, bool change_gravity,
- int width, int height, bool pixelwise);
extern int x_display_pixel_height (struct w32_display_info *);
extern int x_display_pixel_width (struct w32_display_info *);
-extern Lisp_Object x_get_focus_frame (struct frame *);
-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_frame_alpha (struct frame *f);
extern void x_set_menu_bar_lines (struct frame *, Lisp_Object, Lisp_Object);
extern void x_set_tool_bar_lines (struct frame *f,
Lisp_Object value,
@@ -256,19 +245,12 @@ extern void x_set_tool_bar_lines (struct frame *f,
extern void x_set_internal_border_width (struct frame *f,
Lisp_Object value,
Lisp_Object oldval);
-extern void x_activate_menubar (struct frame *);
-extern bool x_bitmap_icon (struct frame *, Lisp_Object);
extern void initialize_frame_menubar (struct frame *);
-extern void x_free_frame_resources (struct frame *);
-extern void x_real_positions (struct frame *, int *, int *);
/* w32inevt.c */
extern int w32_kbd_patch_key (KEY_EVENT_RECORD *event, int cpId);
extern int w32_kbd_mods_to_emacs (DWORD mods, WORD key);
-
-extern Lisp_Object x_get_focus_frame (struct frame *);
-
/* w32console.c */
extern void w32con_hide_cursor (void);
extern void w32con_show_cursor (void);
@@ -417,7 +399,7 @@ extern struct w32_output w32term_display;
#define FRAME_BASELINE_OFFSET(f) ((f)->output_data.w32->baseline_offset)
/* This gives the w32_display_info structure for the display F is on. */
-#define FRAME_DISPLAY_INFO(f) (&one_w32_display_info)
+#define FRAME_DISPLAY_INFO(f) ((void) (f), (&one_w32_display_info))
/* This is the `Display *' which frame F is on. */
#define FRAME_X_DISPLAY(f) (0)
@@ -727,10 +709,18 @@ extern void x_delete_display (struct w32_display_info *dpyinfo);
extern void x_query_color (struct frame *, XColor *);
-extern volatile int notification_buffer_in_use;
-extern BYTE file_notifications[16384];
-extern DWORD notifications_size;
-extern void *notifications_desc;
+#define FILE_NOTIFICATIONS_SIZE 16384
+/* Notifications come in sets. We use a doubly linked list with a
+ sentinel to communicate those sets from the watching threads to the
+ main thread. */
+struct notifications_set {
+ LPBYTE notifications;
+ DWORD size;
+ void *desc;
+ struct notifications_set *next;
+ struct notifications_set *prev;
+};
+extern struct notifications_set *notifications_set_head;
extern Lisp_Object w32_get_watch_object (void *);
extern Lisp_Object lispy_file_action (DWORD);
extern int handle_file_notifications (struct input_event *);
@@ -738,6 +728,16 @@ extern int handle_file_notifications (struct input_event *);
extern void w32_initialize_display_info (Lisp_Object);
extern void initialize_w32_display (struct terminal *, int *, int *);
+#ifdef WINDOWSNT
+/* Keyboard hooks. */
+extern void setup_w32_kbdhook (void);
+extern void remove_w32_kbdhook (void);
+extern int check_w32_winkey_state (int);
+#define w32_kbdhook_active (os_subtype != OS_9X)
+#else
+#define w32_kbdhook_active 0
+#endif
+
/* Keypad command key support. W32 doesn't have virtual keys defined
for the function keys on the keypad (they are mapped to the standard
function keys), so we define our own. */
@@ -790,7 +790,7 @@ typedef struct tagTRACKMOUSEEVENT
struct image;
struct face;
-XGCValues *XCreateGC (void *, Window, unsigned long, XGCValues *);
+XGCValues *XCreateGC (void *, HWND, unsigned long, XGCValues *);
typedef DWORD (WINAPI * ClipboardSequence_Proc) (void);
typedef BOOL (WINAPI * AppendMenuW_Proc) (
diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c
index ddca5f5ef52..5f91b5022dd 100644
--- a/src/w32uniscribe.c
+++ b/src/w32uniscribe.c
@@ -50,7 +50,7 @@ static int CALLBACK ALIGN_STACK add_opentype_font_name_to_list (ENUMLOGFONTEX *,
NEWTEXTMETRICEX *,
DWORD, LPARAM);
/* Used by uniscribe_otf_capability. */
-static Lisp_Object otf_features (HDC context, char *table);
+static Lisp_Object otf_features (HDC context, const char *table);
static int
memq_no_quit (Lisp_Object elt, Lisp_Object list)
@@ -1042,7 +1042,7 @@ uniscribe_check_otf (LOGFONT *font, Lisp_Object otf_spec)
}
static Lisp_Object
-otf_features (HDC context, char *table)
+otf_features (HDC context, const char *table)
{
Lisp_Object script_list = Qnil;
unsigned short scriptlist_table, n_scripts, feature_table;
@@ -1166,6 +1166,8 @@ struct font_driver uniscribe_font_driver =
/* Note that this should be called at every startup, not just when dumping,
as it needs to test for the existence of the Uniscribe library. */
+void syms_of_w32uniscribe (void);
+
void
syms_of_w32uniscribe (void)
{
diff --git a/src/w32xfns.c b/src/w32xfns.c
index 04bf5ce733e..b5b22c9aa52 100644
--- a/src/w32xfns.c
+++ b/src/w32xfns.c
@@ -48,6 +48,21 @@ init_crit (void)
when the input queue is empty, so make it a manual reset event. */
input_available = CreateEvent (NULL, TRUE, FALSE, NULL);
+#if HAVE_W32NOTIFY
+ /* Initialize the linked list of notifications sets that will be
+ used to communicate between the watching worker threads and the
+ main thread. */
+ notifications_set_head = malloc (sizeof(struct notifications_set));
+ if (notifications_set_head)
+ {
+ memset (notifications_set_head, 0, sizeof(struct notifications_set));
+ notifications_set_head->next
+ = notifications_set_head->prev = notifications_set_head;
+ }
+ else
+ DebPrint(("Out of memory: can't initialize notifications sets."));
+#endif
+
#ifdef WINDOWSNT
keyboard_handle = input_available;
#endif /* WINDOWSNT */
@@ -76,6 +91,23 @@ delete_crit (void)
CloseHandle (interrupt_handle);
interrupt_handle = NULL;
}
+
+#if HAVE_W32NOTIFY
+ if (notifications_set_head)
+ {
+ /* Free any remaining notifications set that could be left over. */
+ while (notifications_set_head->next != notifications_set_head)
+ {
+ struct notifications_set *ns = notifications_set_head->next;
+ notifications_set_head->next = ns->next;
+ ns->next->prev = notifications_set_head;
+ if (ns->notifications)
+ free (ns->notifications);
+ free (ns);
+ }
+ }
+ free (notifications_set_head);
+#endif
}
void
diff --git a/src/widget.c b/src/widget.c
index 28bb475ddfa..59ed431e23b 100644
--- a/src/widget.c
+++ b/src/widget.c
@@ -32,6 +32,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "widget.h"
#include <stdio.h>
+#include <stdlib.h>
#include "lisp.h"
#include "xterm.h"
diff --git a/src/window.c b/src/window.c
index 733cf75d132..acbefcdad16 100644
--- a/src/window.c
+++ b/src/window.c
@@ -57,6 +57,7 @@ static bool foreach_window_1 (struct window *,
static bool window_resize_check (struct window *, bool);
static void window_resize_apply (struct window *, bool);
static void select_window_1 (Lisp_Object, bool);
+static void run_window_configuration_change_hook (struct frame *);
static struct window *set_window_fringes (struct window *, Lisp_Object,
Lisp_Object, Lisp_Object);
@@ -720,6 +721,36 @@ the height of the screen areas spanned by its children. */)
return make_number (decode_valid_window (window)->pixel_height);
}
+DEFUN ("window-pixel-width-before-size-change",
+ Fwindow_pixel_width_before_size_change,
+ Swindow_pixel_width_before_size_change, 0, 1, 0,
+ doc: /* Return pixel width of window WINDOW before last size changes.
+WINDOW must be a valid window and defaults to the selected one.
+
+The return value is the pixel width of WINDOW at the last time
+`window-size-change-functions' was run. It's zero if WINDOW was made
+after that. */)
+ (Lisp_Object window)
+{
+ return (make_number
+ (decode_valid_window (window)->pixel_width_before_size_change));
+}
+
+DEFUN ("window-pixel-height-before-size-change",
+ Fwindow_pixel_height_before_size_change,
+ Swindow_pixel_height_before_size_change, 0, 1, 0,
+ doc: /* Return pixel height of window WINDOW before last size changes.
+WINDOW must be a valid window and defaults to the selected one.
+
+The return value is the pixel height of WINDOW at the last time
+`window-size-change-functions' was run. It's zero if WINDOW was made
+after that. */)
+ (Lisp_Object window)
+{
+ return (make_number
+ (decode_valid_window (window)->pixel_height_before_size_change));
+}
+
DEFUN ("window-total-height", Fwindow_total_height, Swindow_total_height, 0, 2, 0,
doc: /* Return the height of window WINDOW in lines.
WINDOW must be a valid window and defaults to the selected one.
@@ -2346,8 +2377,10 @@ candidate_window_p (Lisp_Object window, Lisp_Object owindow,
== FRAME_TERMINAL (XFRAME (selected_frame)));
}
else if (WINDOWP (all_frames))
- candidate_p = (EQ (FRAME_MINIBUF_WINDOW (f), all_frames)
- || EQ (XWINDOW (all_frames)->frame, w->frame)
+ /* To qualify as candidate, it's not sufficient for WINDOW's frame
+ to just share the minibuffer window - it must be active as well
+ (see Bug#24500). */
+ candidate_p = (EQ (XWINDOW (all_frames)->frame, w->frame)
|| EQ (XWINDOW (all_frames)->frame, FRAME_FOCUS_FRAME (f)));
else if (FRAMEP (all_frames))
candidate_p = EQ (all_frames, w->frame);
@@ -2828,32 +2861,27 @@ selected frame and no others. */)
static Lisp_Object
-resize_root_window (Lisp_Object window, Lisp_Object delta, Lisp_Object horizontal, Lisp_Object ignore, Lisp_Object pixelwise)
+resize_root_window (Lisp_Object window, Lisp_Object delta,
+ Lisp_Object horizontal, Lisp_Object ignore,
+ Lisp_Object pixelwise)
{
- return call5 (Qwindow_resize_root_window, window, delta, horizontal, ignore, pixelwise);
+ return call5 (Qwindow__resize_root_window, window, delta,
+ horizontal, ignore, pixelwise);
}
-/* Placeholder used by temacs -nw before window.el is loaded. */
-DEFUN ("window--sanitize-window-sizes", Fwindow__sanitize_window_sizes,
- Swindow__sanitize_window_sizes, 2, 2, 0,
- doc: /* */
- attributes: const)
- (Lisp_Object frame, Lisp_Object horizontal)
-{
- return Qnil;
-}
-
-Lisp_Object
-sanitize_window_sizes (Lisp_Object frame, Lisp_Object horizontal)
+void
+sanitize_window_sizes (Lisp_Object horizontal)
{
- return call2 (Qwindow_sanitize_window_sizes, frame, 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)
{
- return call2 (Qwindow_pixel_to_total, frame, horizontal);
+ return call2 (Qwindow__pixel_to_total, frame, horizontal);
}
@@ -2876,9 +2904,12 @@ window-start value is reasonable when this function is called. */)
{
struct window *w, *r, *s;
struct frame *f;
- Lisp_Object sibling, pwindow, swindow IF_LINT (= Qnil), delta;
- ptrdiff_t startpos IF_LINT (= 0), startbyte IF_LINT (= 0);
- int top IF_LINT (= 0), new_top;
+ Lisp_Object sibling, pwindow, delta;
+ Lisp_Object swindow UNINIT;
+ ptrdiff_t startpos UNINIT, startbyte UNINIT;
+ int top UNINIT;
+ int new_top;
+ bool resize_failed = false;
w = decode_valid_window (window);
XSETWINDOW (window, w);
@@ -2978,8 +3009,6 @@ window-start value is reasonable when this function is called. */)
fset_redisplay (f);
Vwindow_list = Qnil;
- FRAME_WINDOW_SIZES_CHANGED (f) = true;
- bool resize_failed = false;
if (!WINDOW_LEAF_P (w))
{
@@ -3157,7 +3186,7 @@ select_frame_norecord (Lisp_Object frame)
Fselect_frame (frame, Qt);
}
-void
+static void
run_window_configuration_change_hook (struct frame *f)
{
ptrdiff_t count = SPECPDL_INDEX ();
@@ -3229,6 +3258,76 @@ If WINDOW is omitted or nil, it defaults to the selected window. */)
return Qnil;
}
+
+/* Compare old and present pixel sizes of windows in tree rooted at W.
+ Return true iff any of these windows differs in size. */
+
+static bool
+window_size_changed (struct window *w)
+{
+ if (w->pixel_width != w->pixel_width_before_size_change
+ || w->pixel_height != w->pixel_height_before_size_change)
+ return true;
+
+ if (WINDOW_INTERNAL_P (w))
+ {
+ w = XWINDOW (w->contents);
+ while (w)
+ {
+ if (window_size_changed (w))
+ return true;
+
+ w = NILP (w->next) ? 0 : XWINDOW (w->next);
+ }
+ }
+
+ return false;
+}
+
+/* Set before size change pixel sizes of windows in tree rooted at W to
+ their present pixel sizes. */
+
+static void
+window_set_before_size_change_sizes (struct window *w)
+{
+ w->pixel_width_before_size_change = w->pixel_width;
+ w->pixel_height_before_size_change = w->pixel_height;
+
+ if (WINDOW_INTERNAL_P (w))
+ {
+ w = XWINDOW (w->contents);
+ while (w)
+ {
+ window_set_before_size_change_sizes (w);
+ w = NILP (w->next) ? 0 : XWINDOW (w->next);
+ }
+ }
+}
+
+
+void
+run_window_size_change_functions (Lisp_Object frame)
+{
+ struct frame *f = XFRAME (frame);
+ struct window *r = XWINDOW (FRAME_ROOT_WINDOW (f));
+ Lisp_Object functions = Vwindow_size_change_functions;
+
+ if (FRAME_WINDOW_CONFIGURATION_CHANGED (f)
+ || window_size_changed (r))
+ {
+ while (CONSP (functions))
+ {
+ if (!EQ (XCAR (functions), Qt))
+ safe_call1 (XCAR (functions), frame);
+ functions = XCDR (functions);
+ }
+
+ window_set_before_size_change_sizes (r);
+ FRAME_WINDOW_CONFIGURATION_CHANGED (f) = false;
+ }
+}
+
+
/* Make WINDOW display BUFFER. RUN_HOOKS_P means it's allowed
to run hooks. See make_frame for a case where it's not allowed.
KEEP_MARGINS_P means that the current margins, fringes, and
@@ -3263,15 +3362,9 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer,
if (!(keep_margins_p && samebuf))
{ /* If we're not actually changing the buffer, don't reset hscroll
- and vscroll. This case happens for example when called from
- change_frame_size_1, where we use a dummy call to
- Fset_window_buffer on the frame's selected window (and no
- other) just in order to run window-configuration-change-hook
- (no longer true since change_frame_size_1 directly calls
- run_window_configuration_change_hook). Resetting hscroll and
- vscroll here is problematic for things like image-mode and
- doc-view-mode since it resets the image's position whenever we
- resize the frame. */
+ and vscroll. Resetting hscroll and vscroll here is problematic
+ for things like image-mode and doc-view-mode since it resets
+ the image's position whenever we resize the frame. */
w->hscroll = w->min_hscroll = w->hscroll_whole = 0;
w->suspend_auto_hscroll = false;
w->vscroll = 0;
@@ -3283,10 +3376,8 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer,
w->start_at_line_beg = false;
w->force_start = false;
}
- /* Maybe we could move this into the `if' but it's not obviously safe and
- I doubt it's worth the trouble. */
- wset_redisplay (w);
+ wset_redisplay (w);
wset_update_mode_line (w);
/* We must select BUFFER to run the window-scroll-functions and to look up
@@ -3314,7 +3405,7 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer,
if (run_hooks_p)
{
- if (! NILP (Vwindow_scroll_functions))
+ if (!NILP (Vwindow_scroll_functions))
run_hook_with_args_2 (Qwindow_scroll_functions, window,
Fmarker_position (w->start));
if (!samebuf)
@@ -3559,6 +3650,8 @@ make_window (void)
w->phys_cursor_width = -1;
#endif
w->sequence_number = ++sequence_number;
+ w->pixel_width_before_size_change = 0;
+ w->pixel_height_before_size_change = 0;
w->scroll_bar_width = -1;
w->scroll_bar_height = -1;
w->column_number_displayed = -1;
@@ -3922,7 +4015,6 @@ be applied on the Elisp level. */)
window_resize_apply (r, horflag);
fset_redisplay (f);
- FRAME_WINDOW_SIZES_CHANGED (f) = true;
adjust_frame_glyphs (f);
unblock_input ();
@@ -4089,7 +4181,6 @@ resize_frame_windows (struct frame *f, int size, bool horflag, bool pixelwise)
}
}
- FRAME_WINDOW_SIZES_CHANGED (f) = true;
fset_redisplay (f);
}
@@ -4216,7 +4307,6 @@ set correctly. See the code of `split-window' for how this is done. */)
p = XWINDOW (o->parent);
fset_redisplay (f);
- FRAME_WINDOW_SIZES_CHANGED (f) = true;
new = make_window ();
n = XWINDOW (new);
wset_frame (n, frame);
@@ -4385,7 +4475,6 @@ Signal an error when WINDOW is the only window on its frame. */)
fset_redisplay (f);
Vwindow_list = Qnil;
- FRAME_WINDOW_SIZES_CHANGED (f) = true;
wset_next (w, Qnil); /* Don't delete w->next too. */
free_window_matrices (w);
@@ -4453,9 +4542,6 @@ Signal an error when WINDOW is the only window on its frame. */)
}
else
unblock_input ();
-
- /* Must be run by the caller:
- run_window_configuration_change_hook (f); */
}
else
/* We failed: Relink WINDOW into window tree. */
@@ -4498,7 +4584,7 @@ grow_mini_window (struct window *w, int delta, bool pixelwise)
{
root = FRAME_ROOT_WINDOW (f);
r = XWINDOW (root);
- height = call3 (Qwindow_resize_root_window_vertically,
+ height = call3 (Qwindow__resize_root_window_vertically,
root, make_number (- delta), pixelwise ? Qt : Qnil);
if (INTEGERP (height) && window_resize_check (r, false))
{
@@ -4529,10 +4615,12 @@ grow_mini_window (struct window *w, int delta, bool pixelwise)
/* Enforce full redisplay of the frame. */
/* FIXME: Shouldn't window--resize-root-window-vertically do it? */
fset_redisplay (f);
- FRAME_WINDOW_SIZES_CHANGED (f) = true;
adjust_frame_glyphs (f);
unblock_input ();
}
+ else
+ error ("Failed to grow minibuffer window");
+
}
}
@@ -4553,7 +4641,7 @@ shrink_mini_window (struct window *w, bool pixelwise)
{
root = FRAME_ROOT_WINDOW (f);
r = XWINDOW (root);
- delta = call3 (Qwindow_resize_root_window_vertically,
+ delta = call3 (Qwindow__resize_root_window_vertically,
root, make_number (height - unit),
pixelwise ? Qt : Qnil);
if (INTEGERP (delta) && window_resize_check (r, false))
@@ -4569,7 +4657,6 @@ shrink_mini_window (struct window *w, bool pixelwise)
/* Enforce full redisplay of the frame. */
/* FIXME: Shouldn't window--resize-root-window-vertically do it? */
fset_redisplay (f);
- FRAME_WINDOW_SIZES_CHANGED (f) = true;
adjust_frame_glyphs (f);
unblock_input ();
}
@@ -4577,6 +4664,8 @@ shrink_mini_window (struct window *w, bool pixelwise)
one window frame here. The same routine will be needed when
shrinking the frame (and probably when making the initial
*scratch* window). For the moment leave things as they are. */
+ else
+ error ("Failed to shrink minibuffer window");
}
}
@@ -4612,7 +4701,6 @@ DEFUN ("resize-mini-window-internal", Fresize_mini_window_internal, Sresize_mini
w->top_line = r->top_line + r->total_lines;
fset_redisplay (f);
- FRAME_WINDOW_SIZES_CHANGED (f) = true;
adjust_frame_glyphs (f);
unblock_input ();
return Qt;
@@ -4727,8 +4815,9 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror)
SET_TEXT_POS_FROM_MARKER (start, w->start);
/* Scrolling a minibuffer window via scroll bar when the echo area
shows long text sometimes resets the minibuffer contents behind
- our backs. */
- if (CHARPOS (start) > ZV)
+ our backs. Also, someone might narrow-to-region and immediately
+ call a scroll function. */
+ if (CHARPOS (start) > ZV || CHARPOS (start) < BEGV)
SET_TEXT_POS (start, BEGV, BEGV_BYTE);
/* If PT is not visible in WINDOW, move back one half of
@@ -5557,21 +5646,14 @@ displayed_window_lines (struct window *w)
bottom_y = line_bottom_y (&it);
bidi_unshelve_cache (itdata, false);
- /* rms: On a non-window display,
- the value of it.vpos at the bottom of the screen
- seems to be 1 larger than window_box_height (w).
- This kludge fixes a bug whereby (move-to-window-line -1)
- when ZV is on the last screen line
- moves to the previous screen line instead of the last one. */
- if (! FRAME_WINDOW_P (XFRAME (w->frame)))
- height++;
-
/* Add in empty lines at the bottom of the window. */
if (bottom_y < height)
{
int uy = FRAME_LINE_HEIGHT (it.f);
it.vpos += (height - bottom_y + uy - 1) / uy;
}
+ else if (bottom_y == height)
+ it.vpos++;
if (old_buffer)
set_buffer_internal (old_buffer);
@@ -5601,7 +5683,7 @@ and redisplay normally--don't erase and redraw the frame. */)
struct buffer *buf = XBUFFER (w->contents);
bool center_p = false;
ptrdiff_t charpos, bytepos;
- EMACS_INT iarg IF_LINT (= 0);
+ EMACS_INT iarg;
int this_scroll_margin;
if (buf != current_buffer)
@@ -5846,7 +5928,12 @@ DEFUN ("move-to-window-line", Fmove_to_window_line, Smove_to_window_line,
doc: /* Position point relative to window.
ARG nil means position point at center of window.
Else, ARG specifies vertical position within the window;
-zero means top of window, negative means relative to bottom of window. */)
+zero means top of window, negative means relative to bottom
+of window, -1 meaning the last fully visible display line
+of the window.
+
+Value is the screen line of the window point moved to, counting
+from the top of the window. */)
(Lisp_Object arg)
{
struct window *w = XWINDOW (selected_window);
@@ -5950,6 +6037,7 @@ struct saved_window
Lisp_Object window, buffer, start, pointm, old_pointm;
Lisp_Object pixel_left, pixel_top, pixel_height, pixel_width;
+ Lisp_Object pixel_height_before_size_change, pixel_width_before_size_change;
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;
@@ -6065,6 +6153,12 @@ the return value is nil. Otherwise the value is t. */)
struct window *root_window;
struct window **leaf_windows;
ptrdiff_t i, k, n_leaf_windows;
+ /* Records whether a window has been added or removed wrt the
+ original configuration. */
+ bool window_changed = false;
+ /* Records whether a window has changed its buffer wrt the
+ original configuration. */
+ bool buffer_changed = false;
/* Don't do this within the main loop below: This may call Lisp
code and is thus potentially unsafe while input is blocked. */
@@ -6073,6 +6167,12 @@ the return value is nil. Otherwise the value is t. */)
p = SAVED_WINDOW_N (saved_windows, k);
window = p->window;
w = XWINDOW (window);
+
+ if (NILP (w->contents))
+ /* A dead window that will be resurrected, the window
+ configuration will change. */
+ window_changed = true;
+
if (BUFFERP (w->contents)
&& !EQ (w->contents, p->buffer)
&& BUFFER_LIVE_P (XBUFFER (p->buffer)))
@@ -6102,7 +6202,6 @@ the return value is nil. Otherwise the value is t. */)
}
fset_redisplay (f);
- FRAME_WINDOW_SIZES_CHANGED (f) = true;
/* Problem: Freeing all matrices and later allocating them again
is a serious redisplay flickering problem. What we would
@@ -6158,6 +6257,10 @@ the return value is nil. Otherwise the value is t. */)
w->pixel_top = XFASTINT (p->pixel_top);
w->pixel_width = XFASTINT (p->pixel_width);
w->pixel_height = XFASTINT (p->pixel_height);
+ w->pixel_width_before_size_change
+ = XFASTINT (p->pixel_width_before_size_change);
+ w->pixel_height_before_size_change
+ = XFASTINT (p->pixel_height_before_size_change);
w->left_col = XFASTINT (p->left_col);
w->top_line = XFASTINT (p->top_line);
w->total_cols = XFASTINT (p->total_cols);
@@ -6205,6 +6308,9 @@ the return value is nil. Otherwise the value is t. */)
if (BUFFERP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer)))
/* If saved buffer is alive, install it. */
{
+ if (!EQ (w->contents, p->buffer))
+ /* Record buffer configuration change. */
+ buffer_changed = true;
wset_buffer (w, p->buffer);
w->start_at_line_beg = !NILP (p->start_at_line_beg);
set_marker_restricted (w->start, p->start, w->contents);
@@ -6238,6 +6344,8 @@ the return value is nil. Otherwise the value is t. */)
else if (!NILP (w->start))
/* Leaf window has no live buffer, get one. */
{
+ /* Record buffer configuration change. */
+ buffer_changed = true;
/* Get the buffer via other_buffer_safely in order to
avoid showing an unimportant buffer and, if necessary, to
recreate *scratch* in the course (part of Juanma's bs-show
@@ -6285,7 +6393,10 @@ the return value is nil. Otherwise the value is t. */)
/* Now, free glyph matrices in windows that were not reused. */
for (i = 0; i < n_leaf_windows; i++)
if (NILP (leaf_windows[i]->contents))
- free_window_matrices (leaf_windows[i]);
+ {
+ free_window_matrices (leaf_windows[i]);
+ window_changed = true;
+ }
/* Allow x_set_window_size again and apply frame size changes if
needed. */
@@ -6305,7 +6416,8 @@ the return value is nil. Otherwise the value is t. */)
/* Record the selected window's buffer here. The window should
already be the selected one from the call above. */
- select_window (data->current_window, Qnil, false);
+ if (WINDOW_LIVE_P (data->current_window))
+ select_window (data->current_window, Qnil, false);
/* Fselect_window will have made f the selected frame, so we
reselect the proper frame here. Fhandle_switch_frame will change the
@@ -6315,7 +6427,32 @@ the return value is nil. Otherwise the value is t. */)
if (FRAME_LIVE_P (XFRAME (data->selected_frame)))
do_switch_frame (data->selected_frame, 0, 0, Qnil);
- run_window_configuration_change_hook (f);
+ if (window_changed)
+ /* At least one window has been added or removed. Run
+ `window-configuration-change-hook' and make sure
+ `window-size-change-functions' get run later.
+
+ We have to do this in order to capture the following
+ scenario: Suppose our frame contains two live windows W1 and
+ W2 and ‘set-window-configuration’ replaces them by two
+ windows W3 and W4 that were dead the last time
+ run_window_size_change_functions was run. If W3 and W4 have
+ the same values for their old and new pixel sizes but these
+ values differ from those of W1 and W2, the sizes of our
+ frame's two live windows changed but window_size_changed has
+ no means to detect that fact.
+
+ Obviously, this will get us false positives, for example,
+ when we restore the original configuration with W1 and W2
+ before run_window_size_change_functions gets called. */
+ {
+ run_window_configuration_change_hook (f);
+ FRAME_WINDOW_CONFIGURATION_CHANGED (f) = true;
+ }
+ else if (buffer_changed)
+ /* At least one window has changed its buffer. Run
+ `window-configuration-change-hook' only. */
+ run_window_configuration_change_hook (f);
}
if (!NILP (new_current_buffer))
@@ -6466,6 +6603,10 @@ save_window_save (Lisp_Object window, struct Lisp_Vector *vector, ptrdiff_t i)
p->pixel_top = make_number (w->pixel_top);
p->pixel_width = make_number (w->pixel_width);
p->pixel_height = make_number (w->pixel_height);
+ p->pixel_width_before_size_change
+ = make_number (w->pixel_width_before_size_change);
+ p->pixel_height_before_size_change
+ = make_number (w->pixel_height_before_size_change);
p->left_col = make_number (w->left_col);
p->top_line = make_number (w->top_line);
p->total_cols = make_number (w->total_cols);
@@ -7166,10 +7307,11 @@ syms_of_window (void)
DEFSYM (Qwindow_valid_p, "window-valid-p");
DEFSYM (Qwindow_deletable_p, "window-deletable-p");
DEFSYM (Qdelete_window, "delete-window");
- DEFSYM (Qwindow_resize_root_window, "window--resize-root-window");
- DEFSYM (Qwindow_resize_root_window_vertically, "window--resize-root-window-vertically");
- DEFSYM (Qwindow_sanitize_window_sizes, "window--sanitize-window-sizes");
- DEFSYM (Qwindow_pixel_to_total, "window--pixel-to-total");
+ DEFSYM (Qwindow__resize_root_window, "window--resize-root-window");
+ DEFSYM (Qwindow__resize_root_window_vertically,
+ "window--resize-root-window-vertically");
+ 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");
DEFSYM (Qreplace_buffer_in_windows, "replace-buffer-in-windows");
@@ -7248,6 +7390,16 @@ selected; while the global part is run only once for the modified frame,
with the relevant frame selected. */);
Vwindow_configuration_change_hook = Qnil;
+ DEFVAR_LISP ("window-size-change-functions", Vwindow_size_change_functions,
+ doc: /* Functions called during redisplay, if window sizes have changed.
+The value should be a list of functions that take one argument.
+During the first part of redisplay, for each frame, if any of its windows
+have changed size since the last redisplay, or have been split or deleted,
+all the functions in the list are called, with the frame as argument.
+If redisplay decides to resize the minibuffer window, it calls these
+functions on behalf of that as well. */);
+ Vwindow_size_change_functions = Qnil;
+
DEFVAR_LISP ("recenter-redisplay", Vrecenter_redisplay,
doc: /* Non-nil means `recenter' redraws entire frame.
If this option is non-nil, then the `recenter' command with a nil
@@ -7376,6 +7528,8 @@ displayed after a scrolling operation to be somewhat inaccurate. */);
defsubr (&Swindow_use_time);
defsubr (&Swindow_pixel_width);
defsubr (&Swindow_pixel_height);
+ defsubr (&Swindow_pixel_width_before_size_change);
+ defsubr (&Swindow_pixel_height_before_size_change);
defsubr (&Swindow_total_width);
defsubr (&Swindow_total_height);
defsubr (&Swindow_normal_size);
@@ -7417,7 +7571,6 @@ displayed after a scrolling operation to be somewhat inaccurate. */);
defsubr (&Sset_window_display_table);
defsubr (&Snext_window);
defsubr (&Sprevious_window);
- defsubr (&Swindow__sanitize_window_sizes);
defsubr (&Sget_buffer_window);
defsubr (&Sdelete_other_windows_internal);
defsubr (&Sdelete_window_internal);
diff --git a/src/window.h b/src/window.h
index 4845f757e3b..a124b3311d0 100644
--- a/src/window.h
+++ b/src/window.h
@@ -214,6 +214,11 @@ struct window
int pixel_width;
int pixel_height;
+ /* The pixel sizes of the window at the last time
+ `window-size-change-functions' was run. */
+ int pixel_width_before_size_change;
+ int pixel_height_before_size_change;
+
/* The size of the window. */
int total_cols;
int total_lines;
@@ -499,15 +504,17 @@ wset_next_buffers (struct window *w, Lisp_Object val)
#define WINDOW_LEAF_P(W) \
(BUFFERP ((W)->contents))
-/* True if W is a member of horizontal combination. */
+/* Non-nil if W is internal. */
+#define WINDOW_INTERNAL_P(W) \
+ (WINDOWP ((W)->contents))
+/* True if W is a member of horizontal combination. */
#define WINDOW_HORIZONTAL_COMBINATION_P(W) \
- (WINDOWP ((W)->contents) && (W)->horizontal)
+ (WINDOW_INTERNAL_P (W) && (W)->horizontal)
/* True if W is a member of vertical combination. */
-
#define WINDOW_VERTICAL_COMBINATION_P(W) \
- (WINDOWP ((W)->contents) && !(W)->horizontal)
+ (WINDOW_INTERNAL_P (W) && !(W)->horizontal)
/* WINDOW's XFRAME. */
#define WINDOW_XFRAME(W) (XFRAME (WINDOW_FRAME ((W))))
@@ -786,7 +793,7 @@ wset_next_buffers (struct window *w, Lisp_Object val)
|| WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT (W))
#if (defined (HAVE_WINDOW_SYSTEM) \
- && ((defined (USE_TOOLKIT_SCROLL_BARS) && !defined (HAVE_NS)) \
+ && ((defined (USE_TOOLKIT_SCROLL_BARS)) \
|| defined (HAVE_NTGUI)))
# define USE_HORIZONTAL_SCROLL_BARS true
#else
@@ -1013,7 +1020,7 @@ extern void grow_mini_window (struct window *, int, bool);
extern void shrink_mini_window (struct window *, bool);
extern int window_relative_x_coord (struct window *, enum window_part, int);
-void run_window_configuration_change_hook (struct frame *f);
+void run_window_size_change_functions (Lisp_Object);
/* Make WINDOW display BUFFER. RUN_HOOKS_P means it's allowed
to run hooks. See make_frame for a case where it's not allowed. */
@@ -1098,7 +1105,7 @@ extern int window_body_width (struct window *w, bool);
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 Lisp_Object sanitize_window_sizes (Lisp_Object, Lisp_Object);
+extern void sanitize_window_sizes (Lisp_Object horizontal);
/* This looks like a setter, but it is a bit special. */
extern void wset_buffer (struct window *, Lisp_Object);
extern bool window_outdated (struct window *);
diff --git a/src/xdisp.c b/src/xdisp.c
index f575b27fec5..c045ced000b 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -288,6 +288,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
+#include <stdlib.h>
#include <limits.h>
#include "lisp.h"
@@ -1317,10 +1318,16 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y,
SET_TEXT_POS_FROM_MARKER (top, w->start);
/* Scrolling a minibuffer window via scroll bar when the echo area
shows long text sometimes resets the minibuffer contents behind
- our backs. */
- if (CHARPOS (top) > ZV)
+ our backs. Also, someone might narrow-to-region and immediately
+ call a scroll function. */
+ if (CHARPOS (top) > ZV || CHARPOS (top) < BEGV)
SET_TEXT_POS (top, BEGV, BEGV_BYTE);
+ /* If the top of the window is after CHARPOS, the latter is surely
+ not visible. */
+ if (charpos >= 0 && CHARPOS (top) > charpos)
+ return visible_p;
+
/* Compute exact mode line heights. */
if (WINDOW_WANTS_MODELINE_P (w))
w->mode_line_height
@@ -1813,7 +1820,7 @@ estimate_mode_line_height (struct frame *f, enum face_id face_id)
cache and mode line face are not yet initialized. */
if (FRAME_FACE_CACHE (f))
{
- struct face *face = FACE_FROM_ID (f, face_id);
+ struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
if (face)
{
if (face->font)
@@ -2232,7 +2239,7 @@ get_phys_cursor_geometry (struct window *w, struct glyph_row *row,
ascent = row->ascent;
if (row->ascent < glyph->ascent)
{
- y =- glyph->ascent - row->ascent;
+ y -= glyph->ascent - row->ascent;
ascent = glyph->ascent;
}
@@ -2494,7 +2501,7 @@ remember_mouse_glyph (struct frame *f, int gx, int gy, NativeRectangle *rect)
/* Visible feedback for debugging. */
#if false && defined HAVE_X_WINDOWS
- XDrawRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ XDrawRectangle (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
f->output_data.x->normal_gc,
gx, gy, width, height);
#endif
@@ -2918,7 +2925,7 @@ init_iterator (struct it *it, struct window *w,
/* If we have a boxed mode line, make the first character appear
with a left box line. */
- face = FACE_FROM_ID (it->f, remapped_base_face_id);
+ face = FACE_FROM_ID_OR_NULL (it->f, remapped_base_face_id);
if (face && face->box != FACE_NO_BOX)
it->start_of_box_run_p = true;
}
@@ -3877,9 +3884,9 @@ handle_face_prop (struct it *it)
{
struct face *new_face = FACE_FROM_ID (it->f, new_face_id);
/* If it->face_id is -1, old_face below will be NULL, see
- the definition of FACE_FROM_ID. This will happen if this
- is the initial call that gets the face. */
- struct face *old_face = FACE_FROM_ID (it->f, it->face_id);
+ the definition of FACE_FROM_ID_OR_NULL. This will happen
+ if this is the initial call that gets the face. */
+ struct face *old_face = FACE_FROM_ID_OR_NULL (it->f, it->face_id);
/* If the value of face_id of the iterator is -1, we have to
look in front of IT's position and see whether there is a
@@ -3888,7 +3895,7 @@ handle_face_prop (struct it *it)
{
int prev_face_id = face_before_it_pos (it);
- old_face = FACE_FROM_ID (it->f, prev_face_id);
+ old_face = FACE_FROM_ID_OR_NULL (it->f, prev_face_id);
}
/* If the new face has a box, but the old face does not,
@@ -3988,7 +3995,7 @@ handle_face_prop (struct it *it)
if (new_face_id != it->face_id)
{
struct face *new_face = FACE_FROM_ID (it->f, new_face_id);
- struct face *old_face = FACE_FROM_ID (it->f, it->face_id);
+ struct face *old_face = FACE_FROM_ID_OR_NULL (it->f, it->face_id);
/* If new face has a box but old face hasn't, this is the
start of a run of characters with box, i.e. it has a
@@ -4847,7 +4854,6 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
it->font_height = XCAR (XCDR (spec));
if (!NILP (it->font_height))
{
- struct face *face = FACE_FROM_ID (it->f, it->face_id);
int new_height = -1;
if (CONSP (it->font_height)
@@ -4866,6 +4872,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
{
/* Call function with current height as argument.
Value is the new height. */
+ struct face *face = FACE_FROM_ID (it->f, it->face_id);
Lisp_Object height;
height = safe_call1 (it->font_height,
face->lface[LFACE_HEIGHT_INDEX]);
@@ -4887,6 +4894,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 ();
+ struct face *face = FACE_FROM_ID (it->f, it->face_id);
specbind (Qheight, face->lface[LFACE_HEIGHT_INDEX]);
value = safe_eval (it->font_height);
@@ -5016,8 +5024,6 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
|| EQ (XCAR (spec), Qright_fringe))
&& CONSP (XCDR (spec)))
{
- int fringe_bitmap;
-
if (it)
{
if (!FRAME_WINDOW_P (it->f))
@@ -5042,8 +5048,8 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
#ifdef HAVE_WINDOW_SYSTEM
value = XCAR (XCDR (spec));
- if (!SYMBOLP (value)
- || !(fringe_bitmap = lookup_fringe_bitmap (value)))
+ int fringe_bitmap = SYMBOLP (value) ? lookup_fringe_bitmap (value) : 0;
+ if (! fringe_bitmap)
/* If we return here, POSITION has been advanced
across the text with this property. */
{
@@ -6096,7 +6102,7 @@ pop_it (struct it *it)
break;
case GET_FROM_STRING:
{
- struct face *face = FACE_FROM_ID (it->f, it->face_id);
+ struct face *face = FACE_FROM_ID_OR_NULL (it->f, it->face_id);
/* Restore the face_box_p flag, since it could have been
overwritten by the face of the object that we just finished
@@ -6778,7 +6784,8 @@ static next_element_function const get_next_element[NUM_IT_METHODS] =
|| ((IT)->cmp_it.stop_pos == (CHARPOS) \
&& composition_reseat_it (&(IT)->cmp_it, CHARPOS, BYTEPOS, \
END_CHARPOS, (IT)->w, \
- FACE_FROM_ID ((IT)->f, (IT)->face_id), \
+ FACE_FROM_ID_OR_NULL ((IT)->f, \
+ (IT)->face_id), \
(IT)->string)))
@@ -7081,6 +7088,19 @@ get_next_display_element (struct it *it)
goto display_control;
}
+ /* Handle non-ascii hyphens in the mode where it only
+ gets highlighting. */
+
+ if (nonascii_hyphen_p && EQ (Vnobreak_char_display, Qt))
+ {
+ /* Merge `nobreak-space' into the current face. */
+ face_id = merge_faces (it->f, Qnobreak_hyphen, 0,
+ it->face_id);
+ XSETINT (it->ctl_chars[0], '-');
+ ctl_len = 1;
+ goto display_control;
+ }
+
/* Handle sequences that start with the "escape glyph". */
/* the default escape glyph is \. */
@@ -7097,15 +7117,6 @@ get_next_display_element (struct it *it)
? merge_faces (it->f, Qt, lface_id, it->face_id)
: merge_escape_glyph_face (it));
- /* Draw non-ASCII hyphen with just highlighting: */
-
- if (nonascii_hyphen_p && EQ (Vnobreak_char_display, Qt))
- {
- XSETINT (it->ctl_chars[0], '-');
- ctl_len = 1;
- goto display_control;
- }
-
/* Draw non-ASCII space/hyphen with escape glyph: */
if (nonascii_space_p || nonascii_hyphen_p)
@@ -7203,7 +7214,7 @@ get_next_display_element (struct it *it)
if (it->method == GET_FROM_STRING && it->sp)
{
int face_id = underlying_face_id (it);
- struct face *face = FACE_FROM_ID (it->f, face_id);
+ struct face *face = FACE_FROM_ID_OR_NULL (it->f, face_id);
if (face)
{
@@ -7736,8 +7747,8 @@ next_element_from_display_vector (struct it *it)
/* Glyphs in the display vector could have the box face, so we
need to set the related flags in the iterator, as
appropriate. */
- this_face = FACE_FROM_ID (it->f, it->face_id);
- prev_face = FACE_FROM_ID (it->f, prev_face_id);
+ this_face = FACE_FROM_ID_OR_NULL (it->f, it->face_id);
+ prev_face = FACE_FROM_ID_OR_NULL (it->f, prev_face_id);
/* Is this character the first character of a box-face run? */
it->start_of_box_run_p = (this_face && this_face->box != FACE_NO_BOX
@@ -7762,7 +7773,7 @@ next_element_from_display_vector (struct it *it)
it->saved_face_id);
}
}
- next_face = FACE_FROM_ID (it->f, next_face_id);
+ next_face = FACE_FROM_ID_OR_NULL (it->f, next_face_id);
it->end_of_box_run_p = (this_face && this_face->box != FACE_NO_BOX
&& (!next_face
|| next_face->box == FACE_NO_BOX));
@@ -8554,7 +8565,8 @@ move_it_in_display_line_to (struct it *it,
void *ppos_data = NULL;
bool may_wrap = false;
enum it_method prev_method = it->method;
- ptrdiff_t closest_pos IF_LINT (= 0), prev_pos = IT_CHARPOS (*it);
+ ptrdiff_t closest_pos UNINIT;
+ ptrdiff_t prev_pos = IT_CHARPOS (*it);
bool saw_smaller_pos = prev_pos < to_charpos;
/* Don't produce glyphs in produce_glyphs. */
@@ -8605,8 +8617,7 @@ move_it_in_display_line_to (struct it *it,
&& it->dpvec + it->current.dpvec_index + 1 >= it->dpend)))
/* If there's a line-/wrap-prefix, handle it. */
- if (it->hpos == 0 && it->method == GET_FROM_BUFFER
- && it->current_y < it->last_visible_y)
+ if (it->hpos == 0 && it->method == GET_FROM_BUFFER)
handle_line_prefix (it);
if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos))
@@ -9033,6 +9044,11 @@ move_it_in_display_line_to (struct it *it,
}
else
result = MOVE_NEWLINE_OR_CR;
+ /* If we've processed the newline, make sure this flag is
+ reset, as it must only be set when the newline itself is
+ processed. */
+ if (result == MOVE_NEWLINE_OR_CR)
+ it->constrain_row_ascent_descent_p = false;
break;
}
@@ -9868,26 +9884,28 @@ the maximum pixel-height of all text lines.
The optional argument FROM, if non-nil, specifies the first text
position and defaults to the minimum accessible position of the buffer.
-If FROM is t, use the minimum accessible position that is not a newline
-character. TO, if non-nil, specifies the last text position and
+If FROM is t, use the minimum accessible position that starts a
+non-empty line. TO, if non-nil, specifies the last text position and
defaults to the maximum accessible position of the buffer. If TO is t,
-use the maximum accessible position that is not a newline character.
+use the maximum accessible position that ends a non-empty line.
The optional argument X-LIMIT, if non-nil, specifies the maximum text
width that can be returned. X-LIMIT nil or omitted, means to use the
-pixel-width of WINDOW's body; use this if you do not intend to change
-the width of WINDOW. Use the maximum width WINDOW may assume if you
-intend to change WINDOW's width. In any case, text whose x-coordinate
-is beyond X-LIMIT is ignored. Since calculating the width of long lines
-can take some time, it's always a good idea to make this argument as
-small as possible; in particular, if the buffer contains long lines that
-shall be truncated anyway.
+pixel-width of WINDOW's body; use this if you want to know how high
+WINDOW should be become in order to fit all of its buffer's text with
+the width of WINDOW unaltered. Use the maximum width WINDOW may assume
+if you intend to change WINDOW's width. In any case, text whose
+x-coordinate is beyond X-LIMIT is ignored. Since calculating the width
+of long lines can take some time, it's always a good idea to make this
+argument as small as possible; in particular, if the buffer contains
+long lines that shall be truncated anyway.
The optional argument Y-LIMIT, if non-nil, specifies the maximum text
-height that can be returned. Text lines whose y-coordinate is beyond
-Y-LIMIT are ignored. Since calculating the text height of a large
-buffer can take some time, it makes sense to specify this argument if
-the size of the buffer is unknown.
+height (excluding the height of the mode- or header-line, if any) that
+can be returned. Text lines whose y-coordinate is beyond Y-LIMIT are
+ignored. Since calculating the text height of a large buffer can take
+some time, it makes sense to specify this argument if the size of the
+buffer is large or unknown.
Optional argument MODE-AND-HEADER-LINE nil or omitted means do not
include the height of the mode- or header-line of WINDOW in the return
@@ -9905,7 +9923,7 @@ include the height of both, if present, in the return value. */)
ptrdiff_t start, end, pos;
struct text_pos startp;
void *itdata = NULL;
- int c, max_y = -1, x = 0, y = 0;
+ int c, max_x = 0, max_y = 0, x = 0, y = 0;
CHECK_BUFFER (buffer);
b = XBUFFER (buffer);
@@ -9950,11 +9968,13 @@ include the height of both, if present, in the return value. */)
end = max (start, min (XINT (to), ZV));
}
- if (!NILP (y_limit))
- {
- CHECK_NUMBER (y_limit);
- max_y = min (XINT (y_limit), INT_MAX);
- }
+ if (!NILP (x_limit) && RANGED_INTEGERP (0, x_limit, INT_MAX))
+ max_x = XINT (x_limit);
+
+ if (NILP (y_limit))
+ max_y = INT_MAX;
+ else if (RANGED_INTEGERP (0, y_limit, INT_MAX))
+ max_y = XINT (y_limit);
itdata = bidi_shelve_cache ();
SET_TEXT_POS (startp, start, CHAR_TO_BYTE (start));
@@ -9964,27 +9984,33 @@ include the height of both, if present, in the return value. */)
x = move_it_to (&it, end, -1, max_y, -1, MOVE_TO_POS | MOVE_TO_Y);
else
{
- CHECK_NUMBER (x_limit);
- it.last_visible_x = min (XINT (x_limit), INFINITY);
+ it.last_visible_x = max_x;
/* Actually, we never want move_it_to stop at to_x. But to make
sure that move_it_in_display_line_to always moves far enough,
we set it to INT_MAX and specify MOVE_TO_X. */
x = move_it_to (&it, end, INT_MAX, max_y, -1,
MOVE_TO_POS | MOVE_TO_X | MOVE_TO_Y);
+ /* Don't return more than X-LIMIT. */
+ if (x > max_x)
+ x = max_x;
}
- y = it.current_y + it.max_ascent + it.max_descent;
+ /* Subtract height of header-line which was counted automatically by
+ start_display. */
+ y = it.current_y + it.max_ascent + it.max_descent
+ - WINDOW_HEADER_LINE_HEIGHT (w);
+ /* Don't return more than Y-LIMIT. */
+ if (y > max_y)
+ y = max_y;
- if (!EQ (mode_and_header_line, Qheader_line)
- && !EQ (mode_and_header_line, Qt))
- /* Do not count the header-line which was counted automatically by
- start_display. */
- y = y - WINDOW_HEADER_LINE_HEIGHT (w);
+ if (EQ (mode_and_header_line, Qheader_line)
+ || EQ (mode_and_header_line, Qt))
+ /* Re-add height of header-line as requested. */
+ y = y + WINDOW_HEADER_LINE_HEIGHT (w);
if (EQ (mode_and_header_line, Qmode_line)
|| EQ (mode_and_header_line, Qt))
- /* Do count the mode-line which is not included automatically by
- start_display. */
+ /* Add height of mode-line as requested. */
y = y + WINDOW_MODE_LINE_HEIGHT (w);
bidi_unshelve_cache (itdata, false);
@@ -10562,25 +10588,21 @@ update_echo_area (void)
static void
ensure_echo_area_buffers (void)
{
- int i;
-
- for (i = 0; i < 2; ++i)
+ for (int i = 0; i < 2; i++)
if (!BUFFERP (echo_buffer[i])
|| !BUFFER_LIVE_P (XBUFFER (echo_buffer[i])))
{
- char name[30];
- Lisp_Object old_buffer;
- int j;
-
- old_buffer = echo_buffer[i];
- echo_buffer[i] = Fget_buffer_create
- (make_formatted_string (name, " *Echo Area %d*", i));
+ Lisp_Object old_buffer = echo_buffer[i];
+ static char const name_fmt[] = " *Echo Area %d*";
+ char name[sizeof name_fmt + INT_STRLEN_BOUND (int)];
+ AUTO_STRING_WITH_LEN (lname, name, sprintf (name, name_fmt, i));
+ echo_buffer[i] = Fget_buffer_create (lname);
bset_truncate_lines (XBUFFER (echo_buffer[i]), Qnil);
/* to force word wrap in echo area -
it was decided to postpone this*/
/* XBUFFER (echo_buffer[i])->word_wrap = Qt; */
- for (j = 0; j < 2; ++j)
+ for (int j = 0; j < 2; j++)
if (EQ (old_buffer, echo_area_buffer[j]))
echo_area_buffer[j] = echo_buffer[i];
}
@@ -11327,7 +11349,7 @@ clear_garbaged_frames (void)
fset_redisplay (f);
f->garbaged = false;
f->resized_p = false;
- }
+ }
}
frame_garbaged = false;
@@ -11725,6 +11747,12 @@ x_consider_frame_title (Lisp_Object frame)
record_unwind_protect (unwind_format_mode_line,
format_mode_line_unwind_data
(f, current_buffer, selected_window, false));
+ /* select-frame calls resize_mini_window, which could resize the
+ mini-window and by that undo the effect of this redisplay
+ cycle wrt minibuffer and echo-area display. Binding
+ inhibit-redisplay to t makes the call to resize_mini_window a
+ no-op, thus avoiding the adverse side effects. */
+ specbind (Qinhibit_redisplay, Qt);
Fselect_window (f->selected_window, Qt);
set_buffer_internal_1
@@ -11867,24 +11895,7 @@ prepare_menu_bars (void)
&& !XBUFFER (w->contents)->text->redisplay)
continue;
- /* If a window on this frame changed size, report that to
- the user and clear the size-change flag. */
- if (FRAME_WINDOW_SIZES_CHANGED (f))
- {
- Lisp_Object functions;
-
- /* Clear flag first in case we get an error below. */
- FRAME_WINDOW_SIZES_CHANGED (f) = false;
- functions = Vwindow_size_change_functions;
-
- while (CONSP (functions))
- {
- if (!EQ (XCAR (functions), Qt))
- call1 (XCAR (functions), frame);
- functions = XCDR (functions);
- }
- }
-
+ run_window_size_change_functions (frame);
menu_bar_hooks_run = update_menu_bar (f, false, menu_bar_hooks_run);
#ifdef HAVE_WINDOW_SYSTEM
update_tool_bar (f, false);
@@ -13517,6 +13528,12 @@ redisplay_internal (void)
bool polling_stopped_here = false;
Lisp_Object tail, frame;
+ /* Set a limit to the number of retries we perform due to horizontal
+ scrolling, this avoids getting stuck in an uninterruptible
+ infinite loop (Bug #24633). */
+ enum { MAX_HSCROLL_RETRIES = 16 };
+ int hscroll_retries = 0;
+
/* True means redisplay has to consider all windows on all
frames. False, only selected_window is considered. */
bool consider_all_windows_p;
@@ -13556,10 +13573,11 @@ redisplay_internal (void)
count = SPECPDL_INDEX ();
record_unwind_protect_void (unwind_redisplay);
redisplaying_p = true;
+ block_buffer_flips ();
specbind (Qinhibit_free_realized_faces, Qnil);
/* Record this function, so it appears on the profiler's backtraces. */
- record_in_backtrace (Qredisplay_internal, 0, 0);
+ record_in_backtrace (Qredisplay_internal_xC_functionx, 0, 0);
FOR_EACH_FRAME (tail, frame)
XFRAME (frame)->already_hscrolled_p = false;
@@ -13680,24 +13698,12 @@ redisplay_internal (void)
it's too late for the hooks in window-size-change-functions,
which have been examined already in prepare_menu_bars. So in
that case we call the hooks here only for the selected frame. */
- if (sf->redisplay && FRAME_WINDOW_SIZES_CHANGED (sf))
+ if (sf->redisplay)
{
- Lisp_Object functions;
ptrdiff_t count1 = SPECPDL_INDEX ();
record_unwind_save_match_data ();
-
- /* Clear flag first in case we get an error below. */
- FRAME_WINDOW_SIZES_CHANGED (sf) = false;
- functions = Vwindow_size_change_functions;
-
- while (CONSP (functions))
- {
- if (!EQ (XCAR (functions), Qt))
- call1 (XCAR (functions), selected_frame);
- functions = XCDR (functions);
- }
-
+ run_window_size_change_functions (selected_frame);
unbind_to (count1, Qnil);
}
@@ -13719,22 +13725,10 @@ redisplay_internal (void)
{
if (sf->redisplay)
{
- Lisp_Object functions;
ptrdiff_t count1 = SPECPDL_INDEX ();
record_unwind_save_match_data ();
-
- /* Clear flag first in case we get an error below. */
- FRAME_WINDOW_SIZES_CHANGED (sf) = false;
- functions = Vwindow_size_change_functions;
-
- while (CONSP (functions))
- {
- if (!EQ (XCAR (functions), Qt))
- call1 (XCAR (functions), selected_frame);
- functions = XCDR (functions);
- }
-
+ run_window_size_change_functions (selected_frame);
unbind_to (count1, Qnil);
}
@@ -14057,8 +14051,12 @@ redisplay_internal (void)
if (!f->already_hscrolled_p)
{
f->already_hscrolled_p = true;
- if (hscroll_windows (f->root_window))
- goto retry_frame;
+ if (hscroll_retries <= MAX_HSCROLL_RETRIES
+ && hscroll_windows (f->root_window))
+ {
+ hscroll_retries++;
+ goto retry_frame;
+ }
}
/* If the frame's redisplay flag was not set before
@@ -14073,7 +14071,23 @@ redisplay_internal (void)
use them in update_frame will segfault.
Therefore, we must redisplay this frame. */
if (!f_redisplay_flag && f->redisplay)
- goto retry_frame;
+ goto retry_frame;
+
+ /* In some case (e.g., window resize), we notice
+ only during window updating that the window
+ content changed unpredictably (e.g., a GTK
+ scrollbar moved) and that our previous estimation
+ of the frame content was garbage. We have to
+ start over. These cases should be rare, so going
+ all the way back to the top of redisplay should
+ be good enough.
+
+ Why FRAME_WINDOW_P? See
+ https://lists.gnu.org/archive/html/emacs-devel/2016-10/msg00957.html
+
+ */
+ if (FRAME_GARBAGED_P (f) && FRAME_WINDOW_P (f))
+ goto retry;
/* Prevent various kinds of signals during display
update. stdio is not robust about handling
@@ -14111,9 +14125,6 @@ redisplay_internal (void)
}
else if (FRAME_VISIBLE_P (sf) && !FRAME_OBSCURED_P (sf))
{
- Lisp_Object mini_window = FRAME_MINIBUF_WINDOW (sf);
- struct frame *mini_frame;
-
displayed_buffer = XBUFFER (XWINDOW (selected_window)->contents);
/* Use list_of_error, not Qerror, so that
we catch only errors and don't run the debugger. */
@@ -14121,8 +14132,8 @@ redisplay_internal (void)
list_of_error,
redisplay_window_error);
if (update_miniwindow_p)
- internal_condition_case_1 (redisplay_window_1, mini_window,
- list_of_error,
+ internal_condition_case_1 (redisplay_window_1,
+ FRAME_MINIBUF_WINDOW (sf), list_of_error,
redisplay_window_error);
/* Compare desired and current matrices, perform output. */
@@ -14159,8 +14170,12 @@ redisplay_internal (void)
if (FRAME_VISIBLE_P (sf) && !FRAME_OBSCURED_P (sf))
{
- if (hscroll_windows (selected_window))
- goto retry;
+ if (hscroll_retries <= MAX_HSCROLL_RETRIES
+ && hscroll_windows (selected_window))
+ {
+ hscroll_retries++;
+ goto retry;
+ }
XWINDOW (selected_window)->must_be_updated_p = true;
pending = update_frame (sf, false, false);
@@ -14172,16 +14187,20 @@ redisplay_internal (void)
have put text on a frame other than the selected one, so the
above call to update_frame would not have caught it. Catch
it here. */
- mini_window = FRAME_MINIBUF_WINDOW (sf);
- mini_frame = XFRAME (WINDOW_FRAME (XWINDOW (mini_window)));
+ Lisp_Object mini_window = FRAME_MINIBUF_WINDOW (sf);
+ struct frame *mini_frame = XFRAME (WINDOW_FRAME (XWINDOW (mini_window)));
if (mini_frame != sf && FRAME_WINDOW_P (mini_frame))
{
XWINDOW (mini_window)->must_be_updated_p = true;
pending |= update_frame (mini_frame, false, false);
mini_frame->cursor_type_changed = false;
- if (!pending && hscroll_windows (mini_window))
- goto retry;
+ if (!pending && hscroll_retries <= MAX_HSCROLL_RETRIES
+ && hscroll_windows (mini_window))
+ {
+ hscroll_retries++;
+ goto retry;
+ }
}
}
@@ -14295,6 +14314,11 @@ redisplay_internal (void)
RESUME_POLLING;
}
+static void
+unwind_redisplay_preserve_echo_area (void)
+{
+ unblock_buffer_flips ();
+}
/* Redisplay, but leave alone any recent echo area message unless
another message has been requested in its place.
@@ -14312,6 +14336,12 @@ redisplay_preserve_echo_area (int from_where)
{
TRACE ((stderr, "redisplay_preserve_echo_area (%d)\n", from_where));
+ block_input ();
+ ptrdiff_t count = SPECPDL_INDEX ();
+ record_unwind_protect_void (unwind_redisplay_preserve_echo_area);
+ block_buffer_flips ();
+ unblock_input ();
+
if (!NILP (echo_area_buffer[1]))
{
/* We have a previously displayed message, but no current
@@ -14324,6 +14354,7 @@ redisplay_preserve_echo_area (int from_where)
redisplay_internal ();
flush_frame (SELECTED_FRAME ());
+ unbind_to (count, Qnil);
}
@@ -14333,6 +14364,7 @@ static void
unwind_redisplay (void)
{
redisplaying_p = false;
+ unblock_buffer_flips ();
}
@@ -14442,6 +14474,38 @@ disp_char_vector (struct Lisp_Char_Table *dp, int c)
return val;
}
+static int buffer_flip_blocked_depth;
+
+void
+block_buffer_flips(void)
+{
+ eassert (buffer_flip_blocked_depth >= 0);
+ buffer_flip_blocked_depth++;
+}
+
+void
+unblock_buffer_flips(void)
+{
+ eassert (buffer_flip_blocked_depth > 0);
+ if (--buffer_flip_blocked_depth == 0)
+ {
+ Lisp_Object tail, frame;
+ block_input ();
+ FOR_EACH_FRAME (tail, frame)
+ {
+ struct frame *f = XFRAME (frame);
+ if (FRAME_TERMINAL (f)->buffer_flipping_unblocked_hook)
+ (*FRAME_TERMINAL (f)->buffer_flipping_unblocked_hook) (f);
+ }
+ unblock_input ();
+ }
+}
+
+bool
+buffer_flipping_blocked_p (void)
+{
+ return buffer_flip_blocked_depth > 0;
+}
/***********************************************************************
@@ -15338,6 +15402,40 @@ try_scrolling (Lisp_Object window, bool just_this_one_p,
if (dy > 0)
scroll_down_p = true;
}
+ else if (PT == IT_CHARPOS (it)
+ && IT_CHARPOS (it) < ZV
+ && it.method == GET_FROM_STRING
+ && arg_scroll_conservatively > scroll_limit
+ && it.current_x == 0)
+ {
+ enum move_it_result skip;
+ int y1 = it.current_y;
+ int vpos;
+
+ /* A before-string that includes newlines and is displayed
+ on the last visible screen line could fail us under
+ scroll-conservatively > 100, because we will be unable to
+ position the cursor on that last visible line. Try to
+ recover by finding the first screen line that has some
+ glyphs coming from the buffer text. */
+ do {
+ skip = move_it_in_display_line_to (&it, ZV, -1, MOVE_TO_POS);
+ if (skip != MOVE_NEWLINE_OR_CR
+ || IT_CHARPOS (it) != PT
+ || it.method == GET_FROM_BUFFER)
+ break;
+ vpos = it.vpos;
+ move_it_to (&it, -1, -1, -1, vpos + 1, MOVE_TO_VPOS);
+ } while (it.vpos > vpos);
+
+ dy = it.current_y - y1;
+
+ if (dy > scroll_max)
+ return SCROLLING_FAILED;
+
+ if (dy > 0)
+ scroll_down_p = true;
+ }
}
if (scroll_down_p)
@@ -15542,12 +15640,14 @@ try_scrolling (Lisp_Object window, bool just_this_one_p,
The new window start will be computed, based on W's width, starting
from the start of the continued line. It is the start of the
- screen line with the minimum distance from the old start W->start. */
+ screen line with the minimum distance from the old start W->start,
+ which is still before point (otherwise point will definitely not
+ be visible in the window). */
static bool
compute_window_start_on_continuation_line (struct window *w)
{
- struct text_pos pos, start_pos;
+ struct text_pos pos, start_pos, pos_before_pt;
bool window_start_changed_p = false;
SET_TEXT_POS_FROM_MARKER (start_pos, w->start);
@@ -15575,10 +15675,14 @@ compute_window_start_on_continuation_line (struct window *w)
reseat_at_previous_visible_line_start (&it);
/* If the line start is "too far" away from the window start,
- say it takes too much time to compute a new window start. */
- if (CHARPOS (start_pos) - IT_CHARPOS (it)
- /* PXW: Do we need upper bounds here? */
- < WINDOW_TOTAL_LINES (w) * WINDOW_TOTAL_COLS (w))
+ say it takes too much time to compute a new window start.
+ Also, give up if the line start is after point, as in that
+ case point will not be visible with any window start we
+ compute. */
+ if (IT_CHARPOS (it) <= PT
+ || (CHARPOS (start_pos) - IT_CHARPOS (it)
+ /* PXW: Do we need upper bounds here? */
+ < WINDOW_TOTAL_LINES (w) * WINDOW_TOTAL_COLS (w)))
{
int min_distance, distance;
@@ -15588,12 +15692,14 @@ compute_window_start_on_continuation_line (struct window *w)
decreased, the new window start will be < the old start.
So, we're looking for the display line start with the
minimum distance from the old window start. */
- pos = it.current.pos;
+ pos_before_pt = pos = it.current.pos;
min_distance = INFINITY;
while ((distance = eabs (CHARPOS (start_pos) - IT_CHARPOS (it))),
distance < min_distance)
{
min_distance = distance;
+ if (CHARPOS (pos) <= PT)
+ pos_before_pt = pos;
pos = it.current.pos;
if (it.line_wrap == WORD_WRAP)
{
@@ -15616,6 +15722,13 @@ compute_window_start_on_continuation_line (struct window *w)
move_it_by_lines (&it, 1);
}
+ /* It makes very little sense to make the new window start
+ after point, as point won't be visible. If that's what
+ the loop above finds, fall back on the candidate before
+ or at point that is closest to the old window start. */
+ if (CHARPOS (pos) > PT)
+ pos = pos_before_pt;
+
/* Set the window start there. */
SET_MARKER_FROM_TEXT_POS (w->start, pos);
window_start_changed_p = true;
@@ -16163,6 +16276,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
bool last_line_misfit = false;
ptrdiff_t beg_unchanged, end_unchanged;
int frame_line_height;
+ bool use_desired_matrix;
void *itdata = NULL;
SET_TEXT_POS (lpoint, PT, PT_BYTE);
@@ -16891,7 +17005,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
itdata = bidi_shelve_cache ();
/* Redisplay the window. */
- bool use_desired_matrix = false;
+ use_desired_matrix = false;
if (!current_matrix_up_to_date_p
|| windows_or_buffers_changed
|| f->cursor_type_changed
@@ -16931,6 +17045,27 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
move_it_by_lines (&it, -1);
try_window (window, it.current.pos, 0);
}
+ else if (scroll_conservatively > SCROLL_LIMIT
+ && (it.method == GET_FROM_STRING
+ || overlay_touches_p (IT_CHARPOS (it)))
+ && IT_CHARPOS (it) < ZV)
+ {
+ /* If the window starts with a before-string that spans more
+ than one screen line, using that position to display the
+ window might fail to bring point into the view, because
+ start_display will always start by displaying the string,
+ whereas the code above determines where to set w->start
+ by the buffer position of the place where it takes screen
+ coordinates. Try to recover by finding the next screen
+ line that displays buffer text. */
+ ptrdiff_t pos0 = IT_CHARPOS (it);
+
+ clear_glyph_matrix (w->desired_matrix);
+ do {
+ move_it_by_lines (&it, 1);
+ } while (IT_CHARPOS (it) == pos0);
+ try_window (window, it.current.pos, 0);
+ }
else
{
/* Not much we can do about it. */
@@ -17131,16 +17266,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
ignore_mouse_drag_p = true;
#endif
}
- ptrdiff_t count1 = SPECPDL_INDEX ();
- /* x_consider_frame_title calls select-frame, which calls
- resize_mini_window, which could resize the mini-window and by
- that undo the effect of this redisplay cycle wrt minibuffer
- and echo-area display. Binding inhibit-redisplay to t makes
- the call to resize_mini_window a no-op, thus avoiding the
- adverse side effects. */
- specbind (Qinhibit_redisplay, Qt);
x_consider_frame_title (w->frame);
- unbind_to (count1, Qnil);
#endif
}
@@ -18747,7 +18873,7 @@ try_window_id (struct window *w)
eassert (MATRIX_ROW_DISPLAYS_TEXT_P (first_unchanged_at_end_row));
row = find_last_row_displaying_text (w->current_matrix, &it,
first_unchanged_at_end_row);
- eassert (row && MATRIX_ROW_DISPLAYS_TEXT_P (row));
+ eassume (row && MATRIX_ROW_DISPLAYS_TEXT_P (row));
adjust_window_ends (w, row, true);
eassert (w->window_end_bytepos >= 0);
IF_DEBUG (debug_method_add (w, "A"));
@@ -18777,10 +18903,9 @@ try_window_id (struct window *w)
struct glyph_row *current_row = current_matrix->rows + vpos;
struct glyph_row *desired_row = desired_matrix->rows + vpos;
- for (row = NULL;
- row == NULL && vpos >= first_vpos;
- --vpos, --current_row, --desired_row)
+ for (row = NULL; !row; --vpos, --current_row, --desired_row)
{
+ eassert (first_vpos <= vpos);
if (desired_row->enabled_p)
{
if (MATRIX_ROW_DISPLAYS_TEXT_P (desired_row))
@@ -18790,7 +18915,6 @@ try_window_id (struct window *w)
row = current_row;
}
- eassert (row != NULL);
w->window_end_vpos = vpos + 1;
w->window_end_pos = Z - MATRIX_ROW_END_CHARPOS (row);
w->window_end_bytepos = Z_BYTE - MATRIX_ROW_END_BYTEPOS (row);
@@ -19554,7 +19678,6 @@ append_space_for_newline (struct it *it, bool default_face_p)
struct text_pos saved_pos;
Lisp_Object saved_object;
struct face *face;
- struct glyph *g;
saved_object = it->object;
saved_pos = it->position;
@@ -19590,7 +19713,7 @@ append_space_for_newline (struct it *it, bool default_face_p)
/* Make sure this space glyph has the right ascent and
descent values, or else cursor at end of line will look
funny, and height of empty lines will be incorrect. */
- g = it->glyph_row->glyphs[TEXT_AREA] + n;
+ struct glyph *g = it->glyph_row->glyphs[TEXT_AREA] + n;
struct font *font = face->font ? face->font : FRAME_FONT (it->f);
if (n == 0)
{
@@ -19715,15 +19838,15 @@ extend_face_to_end_of_line (struct it *it)
return;
/* The default face, possibly remapped. */
- default_face = FACE_FROM_ID (f, lookup_basic_face (f, DEFAULT_FACE_ID));
+ default_face = FACE_FROM_ID_OR_NULL (f,
+ lookup_basic_face (f, DEFAULT_FACE_ID));
/* Face extension extends the background and box of IT->face_id
to the end of the line. If the background equals the background
of the frame, we don't have to do anything. */
- if (it->face_before_selective_p)
- face = FACE_FROM_ID (f, it->saved_face_id);
- else
- face = FACE_FROM_ID (f, it->face_id);
+ face = FACE_FROM_ID (f, (it->face_before_selective_p
+ ? it->saved_face_id
+ : it->face_id));
if (FRAME_WINDOW_P (f)
&& MATRIX_ROW_DISPLAYS_TEXT_P (it->glyph_row)
@@ -20463,16 +20586,16 @@ display_line (struct it *it)
struct it wrap_it;
void *wrap_data = NULL;
bool may_wrap = false;
- int wrap_x IF_LINT (= 0);
+ int wrap_x UNINIT;
int wrap_row_used = -1;
- int wrap_row_ascent IF_LINT (= 0), wrap_row_height IF_LINT (= 0);
- int wrap_row_phys_ascent IF_LINT (= 0), wrap_row_phys_height IF_LINT (= 0);
- int wrap_row_extra_line_spacing IF_LINT (= 0);
- ptrdiff_t wrap_row_min_pos IF_LINT (= 0), wrap_row_min_bpos IF_LINT (= 0);
- ptrdiff_t wrap_row_max_pos IF_LINT (= 0), wrap_row_max_bpos IF_LINT (= 0);
+ int wrap_row_ascent UNINIT, wrap_row_height UNINIT;
+ int wrap_row_phys_ascent UNINIT, wrap_row_phys_height UNINIT;
+ int wrap_row_extra_line_spacing UNINIT;
+ ptrdiff_t wrap_row_min_pos UNINIT, wrap_row_min_bpos UNINIT;
+ ptrdiff_t wrap_row_max_pos UNINIT, wrap_row_max_bpos UNINIT;
int cvpos;
ptrdiff_t min_pos = ZV + 1, max_pos = 0;
- ptrdiff_t min_bpos IF_LINT (= 0), max_bpos IF_LINT (= 0);
+ ptrdiff_t min_bpos UNINIT, max_bpos UNINIT;
bool pending_handle_line_prefix = false;
/* We always start displaying at hpos zero even if hscrolled. */
@@ -21889,7 +22012,6 @@ Value is the new character position of point. */)
}
/* Move to the target X coordinate. */
-#ifdef HAVE_WINDOW_SYSTEM
/* On GUI frames, as we don't know the X coordinate of the
character to the left of point, moving point to the left
requires walking, one grapheme cluster at a time, until we
@@ -21946,9 +22068,7 @@ Value is the new character position of point. */)
new_pos.bytepos = CHAR_TO_BYTE (new_pos.charpos);
it.current.pos = new_pos;
}
- else
-#endif
- if (it.current_x != target_x)
+ else if (it.current_x != target_x)
move_it_in_display_line_to (&it, ZV, target_x, MOVE_TO_POS | MOVE_TO_X);
/* If we ended up in a display string that covers point, move to
@@ -23410,6 +23530,16 @@ decode_mode_spec_coding (Lisp_Object coding_system, char *buf, bool eol_flag)
return buf;
}
+/* Return the approximate percentage N is of D (rounding upward), or 99,
+ whichever is less. Assume 0 < D and 0 <= N <= D * INT_MAX / 100. */
+
+static int
+percent99 (ptrdiff_t n, ptrdiff_t d)
+{
+ int percent = (d - 1 + 100.0 * n) / d;
+ return min (percent, 99);
+}
+
/* Return a string for the output of a mode line %-spec for window W,
generated by character C. FIELD_WIDTH > 0 means pad the string
returned with spaces to that value. Return a Lisp string in
@@ -23697,29 +23827,17 @@ decode_mode_spec (struct window *w, register int c, int field_width,
case 'p':
{
ptrdiff_t pos = marker_position (w->start);
- ptrdiff_t total = BUF_ZV (b) - BUF_BEGV (b);
+ ptrdiff_t begv = BUF_BEGV (b);
+ ptrdiff_t zv = BUF_ZV (b);
- if (w->window_end_pos <= BUF_Z (b) - BUF_ZV (b))
- {
- if (pos <= BUF_BEGV (b))
- return "All";
- else
- return "Bottom";
- }
- else if (pos <= BUF_BEGV (b))
+ if (w->window_end_pos <= BUF_Z (b) - zv)
+ return pos <= begv ? "All" : "Bottom";
+ else if (pos <= begv)
return "Top";
else
{
- if (total > 1000000)
- /* Do it differently for a large value, to avoid overflow. */
- total = ((pos - BUF_BEGV (b)) + (total / 100) - 1) / (total / 100);
- else
- total = ((pos - BUF_BEGV (b)) * 100 + total - 1) / total;
- /* We can't normally display a 3-digit number,
- so get us a 2-digit number that is close. */
- if (total == 100)
- total = 99;
- sprintf (decode_mode_spec_buf, "%2"pD"d%%", total);
+ sprintf (decode_mode_spec_buf, "%2d%%",
+ percent99 (pos - begv, zv - begv));
return decode_mode_spec_buf;
}
}
@@ -23729,30 +23847,16 @@ decode_mode_spec (struct window *w, register int c, int field_width,
{
ptrdiff_t toppos = marker_position (w->start);
ptrdiff_t botpos = BUF_Z (b) - w->window_end_pos;
- ptrdiff_t total = BUF_ZV (b) - BUF_BEGV (b);
+ ptrdiff_t begv = BUF_BEGV (b);
+ ptrdiff_t zv = BUF_ZV (b);
- if (botpos >= BUF_ZV (b))
- {
- if (toppos <= BUF_BEGV (b))
- return "All";
- else
- return "Bottom";
- }
+ if (zv <= botpos)
+ return toppos <= begv ? "All" : "Bottom";
else
{
- if (total > 1000000)
- /* Do it differently for a large value, to avoid overflow. */
- total = ((botpos - BUF_BEGV (b)) + (total / 100) - 1) / (total / 100);
- else
- total = ((botpos - BUF_BEGV (b)) * 100 + total - 1) / total;
- /* We can't normally display a 3-digit number,
- so get us a 2-digit number that is close. */
- if (total == 100)
- total = 99;
- if (toppos <= BUF_BEGV (b))
- sprintf (decode_mode_spec_buf, "Top%2"pD"d%%", total);
- else
- sprintf (decode_mode_spec_buf, "%2"pD"d%%", total);
+ sprintf (decode_mode_spec_buf,
+ &"Top%2d%%"[begv < toppos ? sizeof "Top" - 1 : 0],
+ percent99 (botpos - begv, zv - begv));
return decode_mode_spec_buf;
}
}
@@ -24584,7 +24688,6 @@ init_glyph_string (struct glyph_string *s,
s->hdc = hdc;
#endif
s->display = FRAME_X_DISPLAY (s->f);
- s->window = FRAME_X_WINDOW (s->f);
s->char2b = char2b;
s->hl = hl;
s->row = row;
@@ -24697,7 +24800,6 @@ get_glyph_face_and_encoding (struct frame *f, struct glyph *glyph,
face = FACE_FROM_ID (f, glyph->face_id);
/* Make sure X resources of the face are allocated. */
- eassert (face != NULL);
prepare_face_for_display (f, face);
if (face->font)
@@ -25422,7 +25524,7 @@ compute_overhangs_and_x (struct glyph_string *s, int x, bool backward_p)
#define BUILD_COMPOSITE_GLYPH_STRING(START, END, HEAD, TAIL, HL, X, LAST_X) \
do { \
int face_id = (row)->glyphs[area][START].face_id; \
- struct face *base_face = FACE_FROM_ID (f, face_id); \
+ struct face *base_face = FACE_FROM_ID (f, face_id); \
ptrdiff_t cmp_id = (row)->glyphs[area][START].u.cmp.id; \
struct composition *cmp = composition_table[cmp_id]; \
XChar2b *char2b; \
@@ -25643,7 +25745,7 @@ draw_glyphs (struct window *w, int x, struct glyph_row *row,
{
struct glyph_string *h, *t;
Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
- int mouse_beg_col IF_LINT (= 0), mouse_end_col IF_LINT (= 0);
+ int mouse_beg_col UNINIT, mouse_end_col UNINIT;
bool check_mouse_face = false;
int dummy_x = 0;
@@ -26045,7 +26147,6 @@ produce_image_glyph (struct it *it)
eassert (it->what == IT_IMAGE);
face = FACE_FROM_ID (it->f, it->face_id);
- eassert (face);
/* Make sure X resources of the face is loaded. */
prepare_face_for_display (it->f, face);
@@ -26060,7 +26161,6 @@ produce_image_glyph (struct it *it)
}
img = IMAGE_FROM_ID (it->f, it->image_id);
- eassert (img);
/* Make sure X resources of the image is loaded. */
prepare_image_for_display (it->f, img);
@@ -26216,7 +26316,6 @@ produce_xwidget_glyph (struct it *it)
eassert (it->what == IT_XWIDGET);
struct face *face = FACE_FROM_ID (it->f, it->face_id);
- eassert (face);
/* Make sure X resources of the face is loaded. */
prepare_face_for_display (it->f, face);
@@ -26742,12 +26841,8 @@ calc_line_height_property (struct it *it, Lisp_Object val, struct font *font,
struct face *face;
face_id = lookup_named_face (it->f, face_name, false);
- if (face_id < 0)
- return make_number (-1);
-
- face = FACE_FROM_ID (it->f, face_id);
- font = face->font;
- if (font == NULL)
+ face = FACE_FROM_ID_OR_NULL (it->f, face_id);
+ if (face == NULL || ((font = face->font) == NULL))
return make_number (-1);
boff = font->baseline_offset;
if (font->vertical_centering)
@@ -26897,7 +26992,7 @@ produce_glyphless_glyph (struct it *it, bool for_no_font, Lisp_Object acronym)
}
else if (it->glyphless_method == GLYPHLESS_DISPLAY_EMPTY_BOX)
{
- width = CHAR_WIDTH (it->c);
+ width = CHARACTER_WIDTH (it->c);
if (width == 0)
width = 1;
else if (width > 4)
@@ -27393,18 +27488,21 @@ x_produce_glyphs (struct it *it)
int leftmost, rightmost, lowest, highest;
int lbearing, rbearing;
int i, width, ascent, descent;
- int c IF_LINT (= 0); /* cmp->glyph_len can't be zero; see Bug#8512 */
+ int c;
XChar2b char2b;
struct font_metrics *pcm;
ptrdiff_t pos;
- for (glyph_len = cmp->glyph_len; glyph_len > 0; glyph_len--)
- if ((c = COMPOSITION_GLYPH (cmp, glyph_len - 1)) != '\t')
- break;
+ eassume (0 < glyph_len); /* See Bug#8512. */
+ do
+ c = COMPOSITION_GLYPH (cmp, glyph_len - 1);
+ while (c == '\t' && 0 < --glyph_len);
+
bool right_padded = glyph_len < cmp->glyph_len;
for (i = 0; i < glyph_len; i++)
{
- if ((c = COMPOSITION_GLYPH (cmp, i)) != '\t')
+ c = COMPOSITION_GLYPH (cmp, i);
+ if (c != '\t')
break;
cmp->offsets[i * 2] = cmp->offsets[i * 2 + 1] = 0;
}
@@ -28103,7 +28201,7 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width,
/* Using a block cursor on large images can be very annoying.
So use a hollow cursor for "large" images.
If image is not transparent (no mask), also use hollow cursor. */
- struct image *img = IMAGE_FROM_ID (f, glyph->u.img_id);
+ struct image *img = IMAGE_OPT_FROM_ID (f, glyph->u.img_id);
if (img != NULL && IMAGEP (img->spec))
{
/* Arbitrarily, interpret "Large" as >32x32 and >NxN
@@ -28727,12 +28825,12 @@ show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw)
}
}
-#ifdef HAVE_WINDOW_SYSTEM
/* When we've written over the cursor, arrange for it to
be displayed again. */
if (FRAME_WINDOW_P (f)
&& phys_cursor_on_p && !w->phys_cursor_on_p)
{
+#ifdef HAVE_WINDOW_SYSTEM
int hpos = w->phys_cursor.hpos;
/* When the window is hscrolled, cursor hpos can legitimately be
@@ -28747,8 +28845,8 @@ show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw)
display_and_set_cursor (w, true, hpos, w->phys_cursor.vpos,
w->phys_cursor.x, w->phys_cursor.y);
unblock_input ();
- }
#endif /* HAVE_WINDOW_SYSTEM */
+ }
}
#ifdef HAVE_WINDOW_SYSTEM
@@ -29688,12 +29786,17 @@ Returns the alist element for the first matching AREA in MAP. */)
clip_to_bounds (INT_MIN, XINT (x), INT_MAX),
clip_to_bounds (INT_MIN, XINT (y), INT_MAX));
}
+#endif /* HAVE_WINDOW_SYSTEM */
/* Display frame CURSOR, optionally using shape defined by POINTER. */
static void
define_frame_cursor1 (struct frame *f, Cursor cursor, Lisp_Object pointer)
{
+#ifdef HAVE_WINDOW_SYSTEM
+ if (!FRAME_WINDOW_P (f))
+ return;
+
/* Do not change cursor shape while dragging mouse. */
if (EQ (do_mouse_tracking, Qdragging))
return;
@@ -29710,10 +29813,10 @@ define_frame_cursor1 (struct frame *f, Cursor cursor, Lisp_Object pointer)
cursor = FRAME_X_OUTPUT (f)->horizontal_drag_cursor;
else if (EQ (pointer, intern ("nhdrag")))
cursor = FRAME_X_OUTPUT (f)->vertical_drag_cursor;
-#ifdef HAVE_X_WINDOWS
+# ifdef HAVE_X_WINDOWS
else if (EQ (pointer, intern ("vdrag")))
cursor = FRAME_DISPLAY_INFO (f)->vertical_scroll_bar_cursor;
-#endif
+# endif
else if (EQ (pointer, intern ("hourglass")))
cursor = FRAME_X_OUTPUT (f)->hourglass_cursor;
else if (EQ (pointer, Qmodeline))
@@ -29724,10 +29827,9 @@ define_frame_cursor1 (struct frame *f, Cursor cursor, Lisp_Object pointer)
if (cursor != No_Cursor)
FRAME_RIF (f)->define_frame_cursor (f, cursor);
+#endif
}
-#endif /* HAVE_WINDOW_SYSTEM */
-
/* Take proper action when mouse has moved to the mode or header line
or marginal area AREA of window W, x-position X and y-position Y.
X is relative to the start of the text display area of W, so the
@@ -29749,12 +29851,11 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y,
int dx, dy, width, height;
ptrdiff_t charpos;
Lisp_Object string, object = Qnil;
- Lisp_Object pos IF_LINT (= Qnil), help;
-
+ Lisp_Object pos UNINIT;
Lisp_Object mouse_face;
int original_x_pixel = x;
struct glyph * glyph = NULL, * row_start_glyph = NULL;
- struct glyph_row *row IF_LINT (= 0);
+ struct glyph_row *row UNINIT;
if (area == ON_MODE_LINE || area == ON_HEADER_LINE)
{
@@ -29794,7 +29895,7 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y,
&object, &dx, &dy, &width, &height);
}
- help = Qnil;
+ Lisp_Object help = Qnil;
#ifdef HAVE_WINDOW_SYSTEM
if (IMAGEP (object))
@@ -30042,10 +30143,7 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y,
if ((area == ON_MODE_LINE || area == ON_HEADER_LINE) && !mouse_face_shown)
clear_mouse_face (hlinfo);
-#ifdef HAVE_WINDOW_SYSTEM
- if (FRAME_WINDOW_P (f))
- define_frame_cursor1 (f, cursor, pointer);
-#endif
+ define_frame_cursor1 (f, cursor, pointer);
}
@@ -30189,7 +30287,7 @@ note_mouse_highlight (struct frame *f, int x, int y)
/* Look for :pointer property on image. */
if (glyph != NULL && glyph->type == IMAGE_GLYPH)
{
- struct image *img = IMAGE_FROM_ID (f, glyph->u.img_id);
+ struct image *img = IMAGE_OPT_FROM_ID (f, glyph->u.img_id);
if (img != NULL && IMAGEP (img->spec))
{
Lisp_Object image_map, hotspot;
@@ -30250,15 +30348,15 @@ note_mouse_highlight (struct frame *f, int x, int y)
{
if (clear_mouse_face (hlinfo))
cursor = No_Cursor;
-#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f) && NILP (pointer))
{
+#ifdef HAVE_WINDOW_SYSTEM
if (area != TEXT_AREA)
cursor = FRAME_X_OUTPUT (f)->nontext_cursor;
else
pointer = Vvoid_text_area_pointer;
- }
#endif
+ }
goto set_cursor;
}
@@ -30369,8 +30467,8 @@ note_mouse_highlight (struct frame *f, int x, int y)
{
/* The mouse-highlighting, if any, comes from an overlay
or text property in the buffer. */
- Lisp_Object buffer IF_LINT (= Qnil);
- Lisp_Object disp_string IF_LINT (= Qnil);
+ Lisp_Object buffer UNINIT;
+ Lisp_Object disp_string UNINIT;
if (STRINGP (object))
{
@@ -30570,15 +30668,7 @@ note_mouse_highlight (struct frame *f, int x, int y)
}
set_cursor:
-
-#ifdef HAVE_WINDOW_SYSTEM
- if (FRAME_WINDOW_P (f))
- define_frame_cursor1 (f, cursor, pointer);
-#else
- /* This is here to prevent a compiler error, about "label at end of
- compound statement". */
- return;
-#endif
+ define_frame_cursor1 (f, cursor, pointer);
}
@@ -31215,7 +31305,7 @@ syms_of_xdisp (void)
/* Non-nil means don't actually do any redisplay. */
DEFSYM (Qinhibit_redisplay, "inhibit-redisplay");
- DEFSYM (Qredisplay_internal, "redisplay_internal (C function)");
+ DEFSYM (Qredisplay_internal_xC_functionx, "redisplay_internal (C function)");
DEFVAR_BOOL("inhibit-message", inhibit_message,
doc: /* Non-nil means calls to `message' are not displayed.
@@ -31286,8 +31376,10 @@ They are still logged to the *Messages* buffer. */);
/* Name and number of the face used to highlight escape glyphs. */
DEFSYM (Qescape_glyph, "escape-glyph");
- /* Name and number of the face used to highlight non-breaking spaces. */
+ /* Name and number of the face used to highlight non-breaking
+ spaces/hyphens. */
DEFSYM (Qnobreak_space, "nobreak-space");
+ DEFSYM (Qnobreak_hyphen, "nobreak-hyphen");
/* The symbol 'image' which is the car of the lists used to represent
images in Lisp. Also a tool bar style. */
@@ -31399,7 +31491,7 @@ The face used for trailing whitespace is `trailing-whitespace'. */);
doc: /* Control highlighting of non-ASCII space and hyphen chars.
If the value is t, Emacs highlights non-ASCII chars which have the
same appearance as an ASCII space or hyphen, using the `nobreak-space'
-or `escape-glyph' face respectively.
+or `nobreak-hyphen' face respectively.
U+00A0 (no-break space), U+00AD (soft hyphen), U+2010 (hyphen), and
U+2011 (non-breaking hyphen) are affected.
@@ -31552,16 +31644,6 @@ If nil, disable message logging. If t, log messages but don't truncate
the buffer when it becomes large. */);
Vmessage_log_max = make_number (1000);
- DEFVAR_LISP ("window-size-change-functions", Vwindow_size_change_functions,
- doc: /* Functions called during redisplay, if window sizes have changed.
-The value should be a list of functions that take one argument.
-During the first part of redisplay, for each frame, if any of its windows
-have changed size since the last redisplay, or have been split or deleted,
-all the functions in the list are called, with the frame as argument.
-If redisplay decides to resize the minibuffer window, it calls these
-functions on behalf of that as well. */);
- Vwindow_size_change_functions = Qnil;
-
DEFVAR_LISP ("window-scroll-functions", Vwindow_scroll_functions,
doc: /* List of functions to call before redisplaying a window with scrolling.
Each function is called with two arguments, the window and its new
diff --git a/src/xfaces.c b/src/xfaces.c
index 5077cb2d944..accb98bf4c7 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -200,6 +200,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
used to fill in unspecified attributes of the default face. */
#include <config.h>
+#include <stdlib.h>
#include "sysstdio.h"
#include <sys/types.h>
#include <sys/stat.h>
@@ -221,7 +222,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include TERM_HEADER
#include "fontset.h"
#ifdef HAVE_NTGUI
-#define x_display_info w32_display_info
#define GCGraphicsExposures 0
#endif /* HAVE_NTGUI */
@@ -495,7 +495,7 @@ x_create_gc (struct frame *f, unsigned long mask, XGCValues *xgcv)
{
GC gc;
block_input ();
- gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), mask, xgcv);
+ gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), mask, xgcv);
unblock_input ();
IF_DEBUG (++ngcs);
return gc;
@@ -738,8 +738,7 @@ the pixmap. Bits are stored row by row, each row occupies
&& RANGED_INTEGERP (1, width, INT_MAX)
&& RANGED_INTEGERP (1, height, INT_MAX))
{
- int bytes_per_row = ((XINT (width) + BITS_PER_CHAR - 1)
- / BITS_PER_CHAR);
+ int bytes_per_row = (XINT (width) + CHAR_BIT - 1) / CHAR_BIT;
if (XINT (height) <= SBYTES (data) / bytes_per_row)
pixmap_p = true;
}
@@ -1520,7 +1519,7 @@ the WIDTH times as wide as FACE on FRAME. */)
Lisp_Object maximum, Lisp_Object width)
{
struct frame *f;
- int size, avgwidth IF_LINT (= 0);
+ int size, avgwidth;
check_window_system (NULL);
CHECK_STRING (pattern);
@@ -1553,9 +1552,7 @@ the WIDTH times as wide as FACE on FRAME. */)
/* This is of limited utility since it works with character
widths. Keep it for compatibility. --gerd. */
int face_id = lookup_named_face (f, face, false);
- struct face *width_face = (face_id < 0
- ? NULL
- : FACE_FROM_ID (f, face_id));
+ struct face *width_face = FACE_FROM_ID_OR_NULL (f, face_id);
if (width_face && width_face->font)
{
@@ -3695,7 +3692,7 @@ Default face attributes override any local face attributes. */)
if (EQ (face, Qdefault))
{
struct face_cache *c = FRAME_FACE_CACHE (f);
- struct face *newface, *oldface = FACE_FROM_ID (f, DEFAULT_FACE_ID);
+ struct face *newface, *oldface = FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID);
Lisp_Object attrs[LFACE_VECTOR_SIZE];
/* This can be NULL (e.g., in batch mode). */
@@ -3778,7 +3775,7 @@ return the font name used for CHARACTER. */)
{
struct frame *f = decode_live_frame (frame);
int face_id = lookup_named_face (f, face, true);
- struct face *fface = FACE_FROM_ID (f, face_id);
+ struct face *fface = FACE_FROM_ID_OR_NULL (f, face_id);
if (! fface)
return Qnil;
@@ -3787,9 +3784,9 @@ return the font name used for CHARACTER. */)
{
CHECK_CHARACTER (character);
face_id = FACE_FOR_CHAR (f, fface, XINT (character), -1, Qnil);
- fface = FACE_FROM_ID (f, face_id);
+ fface = FACE_FROM_ID_OR_NULL (f, face_id);
}
- return (fface->font
+ return ((fface && fface->font)
? fface->font->props[FONT_NAME_INDEX]
: Qnil);
#else /* !HAVE_WINDOW_SYSTEM */
@@ -4377,7 +4374,7 @@ lookup_face (struct frame *f, Lisp_Object *attr)
face = realize_face (cache, attr, -1);
#ifdef GLYPH_DEBUG
- eassert (face == FACE_FROM_ID (f, face->id));
+ eassert (face == FACE_FROM_ID_OR_NULL (f, face->id));
#endif /* GLYPH_DEBUG */
return face->id;
@@ -4430,15 +4427,13 @@ lookup_named_face (struct frame *f, Lisp_Object symbol, bool signal_p)
{
Lisp_Object attrs[LFACE_VECTOR_SIZE];
Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE];
- struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
+ struct face *default_face = FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID);
if (default_face == NULL)
{
if (!realize_basic_faces (f))
return -1;
default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
- if (default_face == NULL)
- emacs_abort (); /* realize_basic_faces must have set it up */
}
if (! get_lface_attributes (f, symbol, symbol_attrs, signal_p, 0))
@@ -4599,14 +4594,12 @@ lookup_derived_face (struct frame *f, Lisp_Object symbol, int face_id,
{
Lisp_Object attrs[LFACE_VECTOR_SIZE];
Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE];
- struct face *default_face = FACE_FROM_ID (f, face_id);
-
- if (!default_face)
- emacs_abort ();
+ struct face *default_face;
if (!get_lface_attributes (f, symbol, symbol_attrs, signal_p, 0))
return -1;
+ default_face = FACE_FROM_ID (f, face_id);
memcpy (attrs, default_face->lface, sizeof attrs);
merge_face_vectors (f, symbol_attrs, attrs, 0);
return lookup_face (f, attrs);
@@ -4707,7 +4700,7 @@ x_supports_face_attributes_p (struct frame *f,
merge_face_vectors (f, attrs, merged_attrs, 0);
face_id = lookup_face (f, merged_attrs);
- face = FACE_FROM_ID (f, face_id);
+ face = FACE_FROM_ID_OR_NULL (f, face_id);
if (! face)
error ("Cannot make face");
@@ -4977,14 +4970,12 @@ face for italic. */)
attrs[i] = Qunspecified;
merge_face_ref (f, attributes, attrs, true, 0);
- def_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
+ def_face = FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID);
if (def_face == NULL)
{
if (! realize_basic_faces (f))
error ("Cannot realize default face");
def_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
- if (def_face == NULL)
- emacs_abort (); /* realize_basic_faces must have set it up */
}
/* Dispatch to the appropriate handler. */
@@ -5206,7 +5197,6 @@ realize_default_face (struct frame *f)
struct face_cache *c = FRAME_FACE_CACHE (f);
Lisp_Object lface;
Lisp_Object attrs[LFACE_VECTOR_SIZE];
- struct face *face;
/* If the `default' face is not yet known, create it. */
lface = lface_from_face_name (f, Qdefault, false);
@@ -5296,10 +5286,11 @@ realize_default_face (struct frame *f)
eassert (lface_fully_specified_p (XVECTOR (lface)->contents));
check_lface (lface);
memcpy (attrs, XVECTOR (lface)->contents, sizeof attrs);
- face = realize_face (c, attrs, DEFAULT_FACE_ID);
+ struct face *face = realize_face (c, attrs, DEFAULT_FACE_ID);
-#ifdef HAVE_WINDOW_SYSTEM
-#ifdef HAVE_X_WINDOWS
+#ifndef HAVE_WINDOW_SYSTEM
+ (void) face;
+#else
if (FRAME_X_P (f) && face->font != FRAME_FONT (f))
{
/* This can happen when making a frame on a display that does
@@ -5313,8 +5304,7 @@ realize_default_face (struct frame *f)
font. */
x_set_font (f, LFACE_FONT (lface), Qnil);
}
-#endif /* HAVE_X_WINDOWS */
-#endif /* HAVE_WINDOW_SYSTEM */
+#endif
return true;
}
@@ -5454,7 +5444,7 @@ realize_x_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE])
/* Determine the font to use. Most of the time, the font will be
the same as the font of the default face, so try that first. */
- default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
+ default_face = FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID);
if (default_face
&& lface_same_font_attributes_p (default_face->lface, attrs))
{
@@ -6094,7 +6084,6 @@ face_at_string_position (struct window *w, Lisp_Object string,
*endptr = -1;
base_face = FACE_FROM_ID (f, base_face_id);
- eassert (base_face);
/* Optimize the default case that there is no face property. */
if (NILP (prop)
@@ -6103,7 +6092,7 @@ face_at_string_position (struct window *w, Lisp_Object string,
if we don't have fonts, so we can stop here if not working
on a window-system frame. */
|| !FRAME_WINDOW_P (f)
- || FACE_SUITABLE_FOR_ASCII_CHAR_P (base_face, 0)))
+ || FACE_SUITABLE_FOR_ASCII_CHAR_P (base_face)))
return base_face->id;
/* Begin with attributes from the base face. */
@@ -6141,7 +6130,7 @@ merge_faces (struct frame *f, Lisp_Object face_name, int face_id,
Lisp_Object attrs[LFACE_VECTOR_SIZE];
struct face *base_face;
- base_face = FACE_FROM_ID (f, base_face_id);
+ base_face = FACE_FROM_ID_OR_NULL (f, base_face_id);
if (!base_face)
return base_face_id;
@@ -6169,7 +6158,7 @@ merge_faces (struct frame *f, Lisp_Object face_name, int face_id,
struct face *face;
if (face_id < 0)
return base_face_id;
- face = FACE_FROM_ID (f, face_id);
+ face = FACE_FROM_ID_OR_NULL (f, face_id);
if (!face)
return base_face_id;
merge_face_vectors (f, face->lface, attrs, 0);
@@ -6289,7 +6278,7 @@ DEFUN ("dump-face", Fdump_face, Sdump_face, 0, 1, 0, doc: /* */)
{
struct face *face;
CHECK_NUMBER (n);
- face = FACE_FROM_ID (SELECTED_FRAME (), XINT (n));
+ face = FACE_FROM_ID_OR_NULL (SELECTED_FRAME (), XINT (n));
if (face == NULL)
error ("Not a valid face");
dump_realized_face (face);
diff --git a/src/xfns.c b/src/xfns.c
index 7c1bb1c2819..3438c8ef5b4 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -19,6 +19,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
+#include <stdlib.h>
#include <math.h>
#include <unistd.h>
@@ -52,6 +53,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "gtkutil.h"
#endif
+#ifdef HAVE_XDBE
+#include <X11/extensions/Xdbe.h>
+#endif
+
#ifdef USE_X_TOOLKIT
#include <X11/Shell.h>
@@ -91,11 +96,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "../lwlib/xlwmenu.h"
#endif
-#if !defined (NO_EDITRES)
-#define HACK_EDITRES
-extern void _XEditResCheckMessages (Widget, XtPointer, XEvent *, Boolean *);
-#endif /* not defined NO_EDITRES */
-
/* Unique id counter for widgets created by the Lucid Widget Library. */
extern LWLIB_ID widget_id_tick;
@@ -118,6 +118,7 @@ static int dpyinfo_refcount;
#endif
static struct x_display_info *x_display_info_for_name (Lisp_Object);
+static void set_up_x_back_buffer (struct frame *f);
/* Let the user specify an X display with a Lisp object.
OBJECT may be nil, a frame or a terminal object.
@@ -705,6 +706,35 @@ x_set_tool_bar_position (struct frame *f,
wrong_choice (choice, new_value);
}
+static void
+x_set_inhibit_double_buffering (struct frame *f,
+ Lisp_Object new_value,
+ Lisp_Object old_value)
+{
+ block_input ();
+ 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. */
+ if (want_double_buffering != was_double_buffered)
+ font_drop_xrender_surfaces (f);
+ 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)
+ set_up_x_back_buffer (f);
+ if (FRAME_X_DOUBLE_BUFFERED_P (f) != was_double_buffered)
+ {
+ SET_FRAME_GARBAGED (f);
+ font_drop_xrender_surfaces (f);
+ }
+ }
+ unblock_input ();
+}
+
#ifdef USE_GTK
/* Set icon from FILE for frame F. By using GTK functions the icon
@@ -1313,7 +1343,6 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
}
#endif /* not USE_X_TOOLKIT && not USE_GTK */
adjust_frame_glyphs (f);
- run_window_configuration_change_hook (f);
}
@@ -1435,7 +1464,7 @@ x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldva
if (border != FRAME_INTERNAL_BORDER_WIDTH (f))
{
- FRAME_INTERNAL_BORDER_WIDTH (f) = border;
+ f->internal_border_width = border;
#ifdef USE_X_TOOLKIT
if (FRAME_X_OUTPUT (f)->edit_widget)
@@ -2488,6 +2517,72 @@ 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))
+ FRAME_X_NEED_BUFFER_FLIP (f) = true;
+}
+
+static void
+set_up_x_back_buffer (struct frame *f)
+{
+#ifdef HAVE_XDBE
+ block_input ();
+ if (FRAME_X_WINDOW (f) && !FRAME_X_DOUBLE_BUFFERED_P (f))
+ {
+ FRAME_X_RAW_DRAWABLE (f) = FRAME_X_WINDOW (f);
+ if (FRAME_DISPLAY_INFO (f)->supports_xdbe)
+ {
+ /* If allocating a back buffer fails, either because the
+ 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);
+ if (x_had_errors_p (FRAME_X_DISPLAY (f)))
+ FRAME_X_RAW_DRAWABLE (f) = FRAME_X_WINDOW (f);
+ x_uncatch_errors_after_check ();
+ }
+ }
+ unblock_input ();
+#endif
+}
+
+void
+tear_down_x_back_buffer (struct frame *f)
+{
+#ifdef HAVE_XDBE
+ block_input ();
+ if (FRAME_X_WINDOW (f) && FRAME_X_DOUBLE_BUFFERED_P (f))
+ {
+ if (FRAME_X_DOUBLE_BUFFERED_P (f))
+ {
+ XdbeDeallocateBackBufferName (FRAME_X_DISPLAY (f),
+ FRAME_X_DRAWABLE (f));
+ FRAME_X_RAW_DRAWABLE (f) = FRAME_X_WINDOW (f);
+ }
+ }
+ unblock_input ();
+#endif
+}
+
+/* Set up double buffering if the frame parameters don't prohibit
+ it. */
+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))))
+ set_up_x_back_buffer (f);
+ unblock_input ();
+}
+
#ifdef USE_X_TOOLKIT
/* Create and set up the X widget for frame F. */
@@ -2643,7 +2738,7 @@ x_window (struct frame *f, long window_prompting)
f->output_data.x->parent_desc, 0, 0);
FRAME_X_WINDOW (f) = XtWindow (frame_widget);
-
+ initial_set_up_x_back_buffer (f);
validate_x_resource_name ();
class_hints.res_name = SSDATA (Vx_resource_name);
@@ -2663,7 +2758,7 @@ x_window (struct frame *f, long window_prompting)
hack_wm_protocols (f, shell_widget);
-#ifdef HACK_EDITRES
+#ifdef X_TOOLKIT_EDITRES
XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
#endif
@@ -2789,7 +2884,8 @@ x_window (struct frame *f)
CopyFromParent, /* depth */
InputOutput, /* class */
FRAME_X_VISUAL (f),
- attribute_mask, &attributes);
+ attribute_mask, &attributes);
+ initial_set_up_x_back_buffer (f);
#ifdef HAVE_X_I18N
if (use_xim)
@@ -2943,7 +3039,7 @@ x_make_gc (struct frame *f)
gc_values.line_width = 0; /* Means 1 using fast algorithm. */
f->output_data.x->normal_gc
= XCreateGC (FRAME_X_DISPLAY (f),
- FRAME_X_WINDOW (f),
+ FRAME_X_DRAWABLE (f),
GCLineWidth | GCForeground | GCBackground,
&gc_values);
@@ -2952,7 +3048,7 @@ x_make_gc (struct frame *f)
gc_values.background = FRAME_FOREGROUND_PIXEL (f);
f->output_data.x->reverse_gc
= XCreateGC (FRAME_X_DISPLAY (f),
- FRAME_X_WINDOW (f),
+ FRAME_X_DRAWABLE (f),
GCForeground | GCBackground | GCLineWidth,
&gc_values);
@@ -2961,7 +3057,7 @@ x_make_gc (struct frame *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_WINDOW (f),
+ = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
(GCForeground | GCBackground
| GCFillStyle | GCLineWidth),
&gc_values);
@@ -3129,7 +3225,7 @@ x_default_font_parameter (struct frame *f, Lisp_Object parms)
{
/* Remember the explicit font parameter, so we can re-apply it after
we've applied the `default' face settings. */
- AUTO_FRAME_ARG (arg, Qfont_param, font_param);
+ AUTO_FRAME_ARG (arg, Qfont_parameter, font_param);
x_set_frame_parameters (f, arg);
}
@@ -3468,6 +3564,9 @@ This function is an internal primitive--use `make-frame' instead. */)
"waitForWM", "WaitForWM", RES_TYPE_BOOLEAN);
x_default_parameter (f, parms, Qtool_bar_position,
FRAME_TOOL_BAR_POSITION (f), 0, 0, RES_TYPE_SYMBOL);
+ x_default_parameter (f, parms, Qinhibit_double_buffering, Qnil,
+ "inhibitDoubleBuffering", "InhibitDoubleBuffering",
+ RES_TYPE_BOOLEAN);
/* Compute the size of the X window. */
window_prompting = x_figure_window_size (f, parms, true, &x_width, &x_height);
@@ -4296,8 +4395,8 @@ x_get_monitor_attributes_xrandr (struct x_display_info *dpyinfo)
{
XRROutputInfo *info = XRRGetOutputInfo (dpy, resources,
resources->outputs[i]);
- Connection conn = info ? info->connection : RR_Disconnected;
- RRCrtc id = info ? info->crtc : None;
+ if (!info)
+ continue;
if (strcmp (info->name, "default") == 0)
{
@@ -4308,9 +4407,9 @@ x_get_monitor_attributes_xrandr (struct x_display_info *dpyinfo)
return Qnil;
}
- if (conn != RR_Disconnected && id != None)
+ if (info->connection != RR_Disconnected && info->crtc != None)
{
- XRRCrtcInfo *crtc = XRRGetCrtcInfo (dpy, resources, id);
+ XRRCrtcInfo *crtc = XRRGetCrtcInfo (dpy, resources, info->crtc);
struct MonitorInfo *mi = &monitors[i];
XRectangle workarea_r;
@@ -4632,7 +4731,9 @@ frame_geometry (Lisp_Object frame, Lisp_Object attribute)
}
#else
tool_bar_height = FRAME_TOOL_BAR_HEIGHT (f);
- tool_bar_width = tool_bar_height ? native_width : 0;
+ tool_bar_width = (tool_bar_height
+ ? native_width - 2 * internal_border_width
+ : 0);
inner_top += tool_bar_height;
#endif
@@ -5112,11 +5213,18 @@ FRAME. Default is to change on the edit X window. */)
}
else
{
+ ptrdiff_t elsize;
+
CHECK_STRING (value);
data = SDATA (value);
if (INT_MAX < SBYTES (value))
error ("VALUE too long");
- nelements = SBYTES (value);
+
+ /* See comment above about longs and format=32 */
+ elsize = element_format == 32 ? sizeof (long) : element_format >> 3;
+ if (SBYTES (value) % elsize != 0)
+ error ("VALUE must contain an integral number of octets for FORMAT");
+ nelements = SBYTES (value) / elsize;
}
block_input ();
@@ -5216,7 +5324,7 @@ x_window_property_intern (struct frame *f,
property and those are indeed in 32 bit quantities if format is
32. */
- if (BITS_PER_LONG > 32 && actual_format == 32)
+ if (LONG_WIDTH > 32 && actual_format == 32)
{
unsigned long i;
int *idata = (int *) tmp_data;
@@ -5227,7 +5335,8 @@ x_window_property_intern (struct frame *f,
}
if (NILP (vector_ret_p))
- prop_value = make_string ((char *) tmp_data, actual_size);
+ prop_value = make_string ((char *) tmp_data,
+ (actual_format >> 3) * actual_size);
else
prop_value = x_property_data_to_lisp (f,
tmp_data,
@@ -5314,12 +5423,81 @@ no value of TYPE (always string in the MS Windows case). */)
return prop_value;
}
+DEFUN ("x-window-property-attributes", Fx_window_property_attributes, Sx_window_property_attributes,
+ 1, 3, 0,
+ doc: /* Retrieve metadata about window property PROP on FRAME.
+If FRAME is nil or omitted, use the selected frame.
+If SOURCE is non-nil, get the property on that window instead of from
+FRAME. The number 0 denotes the root window.
+
+Return value is nil if FRAME hasn't a property with name PROP.
+Otherwise, the return value is a vector with the following fields:
+
+0. The property type, as an integer. The symbolic name of
+ the type can be obtained with `x-get-atom-name'.
+1. The format of each element; one of 8, 16, or 32.
+2. The length of the property, in number of elements. */)
+ (Lisp_Object prop, Lisp_Object frame, Lisp_Object source)
+{
+ struct frame *f = decode_window_system_frame (frame);
+ Window target_window = FRAME_X_WINDOW (f);
+ Atom prop_atom;
+ Lisp_Object prop_attr = Qnil;
+ Atom actual_type;
+ int actual_format;
+ unsigned long actual_size, bytes_remaining;
+ unsigned char *tmp_data = NULL;
+ int rc;
+
+ CHECK_STRING (prop);
+
+ if (! NILP (source))
+ {
+ CONS_TO_INTEGER (source, Window, target_window);
+ if (! target_window)
+ target_window = FRAME_DISPLAY_INFO (f)->root_window;
+ }
+
+ block_input ();
+
+ prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (prop), False);
+ rc = XGetWindowProperty (FRAME_X_DISPLAY (f), target_window,
+ prop_atom, 0, 0, False, AnyPropertyType,
+ &actual_type, &actual_format, &actual_size,
+ &bytes_remaining, &tmp_data);
+ if (rc == Success /* no invalid params */
+ && actual_format == 0 /* but prop not found */
+ && NILP (source)
+ && target_window != FRAME_OUTER_WINDOW (f))
+ {
+ /* analogous behavior to x-window-property: if property isn't found
+ on the frame's inner window and no alternate window id was
+ provided, try the frame's outer window. */
+ target_window = FRAME_OUTER_WINDOW (f);
+ rc = XGetWindowProperty (FRAME_X_DISPLAY (f), target_window,
+ prop_atom, 0, 0, False, AnyPropertyType,
+ &actual_type, &actual_format, &actual_size,
+ &bytes_remaining, &tmp_data);
+ }
+
+ if (rc == Success && actual_format != 0)
+ {
+ XFree (tmp_data);
+
+ prop_attr = make_uninit_vector (3);
+ ASET (prop_attr, 0, make_number (actual_type));
+ ASET (prop_attr, 1, make_number (actual_format));
+ ASET (prop_attr, 2, make_number (bytes_remaining / (actual_format >> 3)));
+ }
+
+ unblock_input ();
+ return prop_attr;
+}
+
/***********************************************************************
Tool tips
***********************************************************************/
-static Lisp_Object x_create_tip_frame (struct x_display_info *,
- Lisp_Object, Lisp_Object);
static void compute_tip_xy (struct frame *, Lisp_Object, Lisp_Object,
Lisp_Object, int, int, int *, int *);
@@ -5363,9 +5541,7 @@ unwind_create_tip_frame (Lisp_Object frame)
when this happens. */
static Lisp_Object
-x_create_tip_frame (struct x_display_info *dpyinfo,
- Lisp_Object parms,
- Lisp_Object text)
+x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms)
{
struct frame *f;
Lisp_Object frame;
@@ -5373,8 +5549,6 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
int width, height;
ptrdiff_t count = SPECPDL_INDEX ();
bool face_change_before = face_change;
- Lisp_Object buffer;
- struct buffer *old_buffer;
int x_width = 0, x_height = 0;
if (!dpyinfo->terminal->name)
@@ -5390,23 +5564,9 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
error ("Invalid frame name--not a string or nil");
frame = Qnil;
- f = make_frame (true);
+ f = make_frame (false);
+ f->wants_modeline = false;
XSETFRAME (frame, f);
-
- AUTO_STRING (tip, " *tip*");
- buffer = Fget_buffer_create (tip);
- /* Use set_window_buffer instead of Fset_window_buffer (see
- discussion of bug#11984, bug#12025, bug#12026). */
- set_window_buffer (FRAME_ROOT_WINDOW (f), buffer, false, false);
- old_buffer = current_buffer;
- set_buffer_internal_1 (XBUFFER (buffer));
- bset_truncate_lines (current_buffer, Qnil);
- specbind (Qinhibit_read_only, Qt);
- specbind (Qinhibit_modification_hooks, Qt);
- Ferase_buffer ();
- Finsert (1, &text);
- set_buffer_internal_1 (old_buffer);
-
record_unwind_protect (unwind_create_tip_frame, frame);
f->terminal = dpyinfo->terminal;
@@ -5580,7 +5740,8 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
/* Border. */
f->border_width,
CopyFromParent, InputOutput, CopyFromParent,
- mask, &attrs);
+ mask, &attrs);
+ initial_set_up_x_back_buffer (f);
XChangeProperty (FRAME_X_DISPLAY (f), tip_window,
FRAME_DISPLAY_INFO (f)->Xatom_net_window_type,
XA_ATOM, 32, PropModeReplace,
@@ -5648,8 +5809,6 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
{
Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
- /* Set tip_frame here, so that */
- tip_frame = frame;
call2 (Qface_set_after_frame_default, frame, Qnil);
if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
@@ -5788,6 +5947,85 @@ compute_tip_xy (struct frame *f, Lisp_Object parms, Lisp_Object dx, Lisp_Object
}
+/* Hide tooltip. Delete its frame if DELETE is true. */
+static Lisp_Object
+x_hide_tip (bool delete)
+{
+ if (!NILP (tip_timer))
+ {
+ call1 (Qcancel_timer, tip_timer);
+ tip_timer = Qnil;
+ }
+
+
+ if (NILP (tip_frame)
+ || (!delete && FRAMEP (tip_frame)
+ && !FRAME_VISIBLE_P (XFRAME (tip_frame))))
+ return Qnil;
+ else
+ {
+ ptrdiff_t count;
+ Lisp_Object was_open = Qnil;
+
+ count = SPECPDL_INDEX ();
+ specbind (Qinhibit_redisplay, Qt);
+ specbind (Qinhibit_quit, Qt);
+
+#ifdef USE_GTK
+ {
+ /* When using system tooltip, tip_frame is the Emacs frame on
+ which the tip is shown. */
+ struct frame *f = XFRAME (tip_frame);
+
+ if (FRAME_LIVE_P (f) && xg_hide_tooltip (f))
+ {
+ tip_frame = Qnil;
+ was_open = Qt;
+ }
+ }
+#endif
+
+ if (FRAMEP (tip_frame))
+ {
+ if (delete)
+ {
+ delete_frame (tip_frame, Qnil);
+ tip_frame = Qnil;
+ }
+ else
+ x_make_frame_invisible (XFRAME (tip_frame));
+
+ was_open = Qt;
+
+#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 */
+ }
+ else
+ tip_frame = Qnil;
+
+ return unbind_to (count, was_open);
+ }
+}
+
DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
doc: /* Show STRING in a "tooltip" window on frame FRAME.
A tooltip window is a small X window displaying a string.
@@ -5820,15 +6058,17 @@ A tooltip's maximum size is specified by `x-max-tooltip-size'.
Text larger than the specified size is clipped. */)
(Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
{
- struct frame *f;
+ struct frame *f, *tip_f;
struct window *w;
int root_x, root_y;
struct buffer *old_buffer;
struct text_pos pos;
- int i, width, height;
- bool seen_reversed_p;
+ int width, height;
int old_windows_or_buffers_changed = windows_or_buffers_changed;
ptrdiff_t count = SPECPDL_INDEX ();
+ ptrdiff_t count_1;
+ Lisp_Object window, size;
+ AUTO_STRING (tip, " *tip*");
specbind (Qinhibit_redisplay, Qt);
@@ -5877,22 +6117,23 @@ Text larger than the specified size is clipped. */)
if (NILP (last_show_tip_args))
last_show_tip_args = Fmake_vector (make_number (3), Qnil);
- if (!NILP (tip_frame))
+ if (FRAMEP (tip_frame) && FRAME_LIVE_P (XFRAME (tip_frame)))
{
Lisp_Object last_string = AREF (last_show_tip_args, 0);
Lisp_Object last_frame = AREF (last_show_tip_args, 1);
Lisp_Object last_parms = AREF (last_show_tip_args, 2);
- if (EQ (frame, last_frame)
- && !NILP (Fequal (last_string, string))
+ if (FRAME_VISIBLE_P (XFRAME (tip_frame))
+ && EQ (frame, last_frame)
+ && !NILP (Fequal_including_properties (last_string, string))
&& !NILP (Fequal (last_parms, parms)))
{
- struct frame *tip_f = XFRAME (tip_frame);
-
/* Only DX and DY have changed. */
+ tip_f = XFRAME (tip_frame);
if (!NILP (tip_timer))
{
Lisp_Object timer = tip_timer;
+
tip_timer = Qnil;
call1 (Qcancel_timer, timer);
}
@@ -5903,41 +6144,102 @@ Text larger than the specified size is clipped. */)
XMoveWindow (FRAME_X_DISPLAY (tip_f), FRAME_X_WINDOW (tip_f),
root_x, root_y);
unblock_input ();
+
goto start_timer;
}
- }
+ else if (tooltip_reuse_hidden_frame && EQ (frame, last_frame))
+ {
+ bool delete = false;
+ Lisp_Object tail, elt, parm, last;
+
+ /* Check if every parameter in PARMS has the same value in
+ last_parms unless it should be ignored by means of
+ Vtooltip_reuse_hidden_frame_parameters. This may destruct
+ 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, last_parms);
+ if (NILP (Fequal (Fcdr (elt), Fcdr (last))))
+ {
+ /* We lost, delete the old tooltip. */
+ delete = true;
+ break;
+ }
+ else
+ last_parms = call2 (Qassq_delete_all, parm, last_parms);
+ }
+ else
+ last_parms = call2 (Qassq_delete_all, parm, last_parms);
+ }
- /* Hide a previous tip, if any. */
- Fx_hide_tip ();
+ /* Now check if every parameter in what is left of last_parms
+ with a non-nil value has an association in PARMS unless it
+ should be ignored by means of
+ Vtooltip_reuse_hidden_frame_parameters. */
+ for (tail = 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);
ASET (last_show_tip_args, 0, string);
ASET (last_show_tip_args, 1, frame);
ASET (last_show_tip_args, 2, parms);
- /* 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_number (3)), parms);
- if (NILP (Fassq (Qborder_width, parms)))
- parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
- if (NILP (Fassq (Qbottom_divider_width, parms)))
- parms = Fcons (Fcons (Qbottom_divider_width, make_number (0)), parms);
- if (NILP (Fassq (Qright_divider_width, parms)))
- parms = Fcons (Fcons (Qright_divider_width, make_number (0)), 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. */
- frame = x_create_tip_frame (FRAME_DISPLAY_INFO (f), parms, string);
- f = XFRAME (frame);
-
- /* Set up the frame's root window. */
- w = XWINDOW (FRAME_ROOT_WINDOW (f));
+ if (!FRAMEP (tip_frame) || !FRAME_LIVE_P (XFRAME (tip_frame)))
+ {
+ /* Add default values to frame parameters. */
+ if (NILP (Fassq (Qname, parms)))
+ parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
+ if (NILP (Fassq (Qinternal_border_width, parms)))
+ parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
+ if (NILP (Fassq (Qborder_width, parms)))
+ parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
+ if (NILP (Fassq (Qborder_color, parms)))
+ parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
+ if (NILP (Fassq (Qbackground_color, parms)))
+ parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
+ parms);
+
+ /* Create a frame for the tooltip, and record it in the global
+ variable tip_frame. */
+ if (NILP (tip_frame = x_create_tip_frame (FRAME_DISPLAY_INFO (f), parms)))
+ /* Creating the tip frame failed. */
+ return unbind_to (count, Qnil);
+ }
+
+ tip_f = XFRAME (tip_frame);
+ window = FRAME_ROOT_WINDOW (tip_f);
+ set_window_buffer (window, Fget_buffer_create (tip), false, false);
+ w = XWINDOW (window);
+ w->pseudo_window_p = true;
+
+ /* Set up the frame's root window. Note: The following code does not
+ try to size the window or its frame correctly. Its only purpose is
+ to make the subsequent text size calculations work. The right
+ sizes should get installed when the toolkit gets back to us. */
w->left_col = 0;
w->top_line = 0;
w->pixel_left = 0;
@@ -5956,130 +6258,47 @@ Text larger than the specified size is clipped. */)
w->total_lines = 40;
}
- w->pixel_width = w->total_cols * FRAME_COLUMN_WIDTH (f);
- w->pixel_height = w->total_lines * FRAME_LINE_HEIGHT (f);
-
- FRAME_TOTAL_COLS (f) = w->total_cols;
- adjust_frame_glyphs (f);
- w->pseudo_window_p = true;
+ 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);
- /* Display the tooltip text in a temporary buffer. */
+ /* 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 (XWINDOW (FRAME_ROOT_WINDOW (f))->contents));
+ 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 (FRAME_ROOT_WINDOW (f), pos, TRY_WINDOW_IGNORE_FONTS_CHANGE);
-
- /* Compute width and height of the tooltip. */
- width = height = 0;
- seen_reversed_p = false;
- for (i = 0; i < w->desired_matrix->nrows; ++i)
- {
- struct glyph_row *row = &w->desired_matrix->rows[i];
- struct glyph *last;
- int row_width;
-
- /* Stop at the first empty row at the end. */
- if (!row->enabled_p || !MATRIX_ROW_DISPLAYS_TEXT_P (row))
- break;
-
- /* Let the row go over the full width of the frame. */
- row->full_width_p = true;
-
- row_width = row->pixel_width;
- if (row->used[TEXT_AREA])
- {
- /* There's a glyph at the end of rows that is used to place
- the cursor there. Don't include the width of this glyph. */
- if (!row->reversed_p)
- {
- last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
- if (NILP (last->object))
- row_width -= last->pixel_width;
- }
- else
- {
- /* There could be a stretch glyph at the beginning of R2L
- rows that is produced by extend_face_to_end_of_line.
- Don't count that glyph. */
- struct glyph *g = row->glyphs[TEXT_AREA];
-
- if (g->type == STRETCH_GLYPH && NILP (g->object))
- {
- row_width -= g->pixel_width;
- seen_reversed_p = true;
- }
- }
- }
-
- height += row->height;
- width = max (width, row_width);
- }
-
- /* If we've seen partial-length R2L rows, we need to re-adjust the
- tool-tip frame width and redisplay it again, to avoid over-wide
- tips due to the stretch glyph that extends R2L lines to full
- width of the frame. */
- if (seen_reversed_p)
- {
- /* w->total_cols and FRAME_TOTAL_COLS want the width in columns,
- not in pixels. */
- w->pixel_width = width;
- width /= WINDOW_FRAME_COLUMN_WIDTH (w);
- w->total_cols = width;
- FRAME_TOTAL_COLS (f) = width;
- SET_FRAME_WIDTH (f, width);
- adjust_frame_glyphs (f);
- clear_glyph_matrix (w->desired_matrix);
- clear_glyph_matrix (w->current_matrix);
- try_window (FRAME_ROOT_WINDOW (f), pos, 0);
- width = height = 0;
- /* Recompute width and height of the tooltip. */
- for (i = 0; i < w->desired_matrix->nrows; ++i)
- {
- struct glyph_row *row = &w->desired_matrix->rows[i];
- struct glyph *last;
- int row_width;
-
- if (!row->enabled_p || !MATRIX_ROW_DISPLAYS_TEXT_P (row))
- break;
- row->full_width_p = true;
- row_width = row->pixel_width;
- if (row->used[TEXT_AREA] && !row->reversed_p)
- {
- last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
- if (NILP (last->object))
- row_width -= last->pixel_width;
- }
-
- height += row->height;
- width = max (width, row_width);
- }
- }
-
- /* Add the frame's internal border to the width and height the X
- window should have. */
- height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
- width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
-
- /* Move the tooltip window where the mouse pointer is. Resize and
- show it. */
- compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
-
+ try_window (window, pos, TRY_WINDOW_IGNORE_FONTS_CHANGE);
+ /* Calculate size of tooltip window. */
+ size = Fwindow_text_pixel_size (window, Qnil, Qnil, Qnil,
+ make_number (w->pixel_height), Qnil);
+ /* Add the frame's internal border to calculated size. */
+ width = XINT (Fcar (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f);
+ height = XINT (Fcdr (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f);
+
+ /* Calculate position of tooltip frame. */
+ compute_tip_xy (tip_f, parms, dx, dy, width, height, &root_x, &root_y);
+
+ /* Show tooltip frame. */
block_input ();
- XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ XMoveResizeWindow (FRAME_X_DISPLAY (tip_f), FRAME_X_WINDOW (tip_f),
root_x, root_y, width, height);
- XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
+ XMapRaised (FRAME_X_DISPLAY (tip_f), FRAME_X_WINDOW (tip_f));
unblock_input ();
- /* Draw into the window. */
w->must_be_updated_p = true;
update_single_window (w);
-
- /* Restore original current buffer. */
set_buffer_internal_1 (old_buffer);
+ unbind_to (count_1, Qnil);
windows_or_buffers_changed = old_windows_or_buffers_changed;
start_timer:
@@ -6096,65 +6315,17 @@ DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
Value is t if tooltip was open, nil otherwise. */)
(void)
{
- ptrdiff_t count;
- Lisp_Object deleted, frame, timer;
-
- /* Return quickly if nothing to do. */
- if (NILP (tip_timer) && NILP (tip_frame))
- return Qnil;
-
- frame = tip_frame;
- timer = tip_timer;
- tip_frame = tip_timer = deleted = Qnil;
-
- count = SPECPDL_INDEX ();
- specbind (Qinhibit_redisplay, Qt);
- specbind (Qinhibit_quit, Qt);
-
- if (!NILP (timer))
- call1 (Qcancel_timer, timer);
-
-#ifdef USE_GTK
- {
- /* When using system tooltip, tip_frame is the Emacs frame on which
- the tip is shown. */
- struct frame *f = XFRAME (frame);
- if (FRAME_LIVE_P (f) && xg_hide_tooltip (f))
- frame = Qnil;
- }
-#endif
-
- if (FRAMEP (frame))
- {
- delete_frame (frame, Qnil);
- deleted = Qt;
-
-#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 */
- }
-
- return unbind_to (count, deleted);
+ return x_hide_tip (!tooltip_reuse_hidden_frame);
}
+DEFUN ("x-double-buffered-p", Fx_double_buffered_p, Sx_double_buffered_p,
+ 0, 1, 0,
+ doc: /* Return t if FRAME is being double buffered. */)
+ (Lisp_Object frame)
+{
+ struct frame *f = decode_live_frame (frame);
+ return FRAME_X_DOUBLE_BUFFERED_P (f) ? Qt : Qnil;
+}
/***********************************************************************
@@ -6371,7 +6542,7 @@ value of DIR as in previous invocations; this is standard Windows behavior. */)
/* Make "Cancel" equivalent to C-g. */
if (NILP (file))
- Fsignal (Qquit, Qnil);
+ quit ();
decoded_file = DECODE_FILE (file);
@@ -6443,7 +6614,7 @@ value of DIR as in previous invocations; this is standard Windows behavior. */)
/* Make "Cancel" equivalent to C-g. */
if (NILP (file))
- Fsignal (Qquit, Qnil);
+ quit ();
decoded_file = DECODE_FILE (file);
@@ -6483,7 +6654,7 @@ nil, it defaults to the selected frame. */)
default_name = xlispstrdup (font_param);
else
{
- font_param = Fframe_parameter (frame, Qfont_param);
+ font_param = Fframe_parameter (frame, Qfont_parameter);
if (STRINGP (font_param))
default_name = xlispstrdup (font_param);
}
@@ -6494,7 +6665,7 @@ nil, it defaults to the selected frame. */)
unblock_input ();
if (NILP (font))
- Fsignal (Qquit, Qnil);
+ quit ();
return unbind_to (count, font);
}
@@ -6807,6 +6978,7 @@ frame_parm_handler x_frame_parm_handlers[] =
x_set_alpha,
x_set_sticky,
x_set_tool_bar_position,
+ x_set_inhibit_double_buffering,
};
void
@@ -6815,8 +6987,9 @@ syms_of_xfns (void)
DEFSYM (Qundefined_color, "undefined-color");
DEFSYM (Qcompound_text, "compound-text");
DEFSYM (Qcancel_timer, "cancel-timer");
- DEFSYM (Qfont_param, "font-parameter");
+ DEFSYM (Qfont_parameter, "font-parameter");
DEFSYM (Qmono, "mono");
+ DEFSYM (Qassq_delete_all, "assq-delete-all");
#ifdef USE_CAIRO
DEFSYM (Qpdf, "pdf");
@@ -6988,6 +7161,7 @@ When using Gtk+ tooltips, the tooltip face is not used. */);
defsubr (&Sx_change_window_property);
defsubr (&Sx_delete_window_property);
defsubr (&Sx_window_property);
+ defsubr (&Sx_window_property_attributes);
defsubr (&Sxw_display_color_p);
defsubr (&Sx_display_grayscale_p);
@@ -7021,6 +7195,7 @@ When using Gtk+ tooltips, the tooltip face is not used. */);
defsubr (&Sx_show_tip);
defsubr (&Sx_hide_tip);
+ defsubr (&Sx_double_buffered_p);
tip_timer = Qnil;
staticpro (&tip_timer);
tip_frame = Qnil;
diff --git a/src/xfont.c b/src/xfont.c
index 0ef64bef10e..c2b73173968 100644
--- a/src/xfont.c
+++ b/src/xfont.c
@@ -21,6 +21,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
+#include <stdlib.h>
#include <X11/Xlib.h>
#include "lisp.h"
@@ -635,7 +636,7 @@ xfont_list_family (struct frame *f)
char **names;
int num_fonts, i;
Lisp_Object list;
- char *last_family IF_LINT (= 0);
+ char *last_family UNINIT;
int last_len;
block_input ();
@@ -1056,20 +1057,20 @@ xfont_draw (struct glyph_string *s, int from, int to, int x, int y,
{
if (s->padding_p)
for (i = 0; i < len; i++)
- XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
+ XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_DRAWABLE (s->f),
gc, x + i, y, str + i, 1);
else
- XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
+ XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_DRAWABLE (s->f),
gc, x, y, str, len);
}
else
{
if (s->padding_p)
for (i = 0; i < len; i++)
- XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
+ XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_DRAWABLE (s->f),
gc, x + i, y, str + i, 1);
else
- XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
+ XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_DRAWABLE (s->f),
gc, x, y, str, len);
}
unblock_input ();
@@ -1082,20 +1083,20 @@ xfont_draw (struct glyph_string *s, int from, int to, int x, int y,
{
if (s->padding_p)
for (i = 0; i < len; i++)
- XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
+ XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_DRAWABLE (s->f),
gc, x + i, y, s->char2b + from + i, 1);
else
- XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
+ XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_DRAWABLE (s->f),
gc, x, y, s->char2b + from, len);
}
else
{
if (s->padding_p)
for (i = 0; i < len; i++)
- XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
+ XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_DRAWABLE (s->f),
gc, x + i, y, s->char2b + from + i, 1);
else
- XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
+ XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_DRAWABLE (s->f),
gc, x, y, s->char2b + from, len);
}
unblock_input ();
diff --git a/src/xftfont.c b/src/xftfont.c
index 34c6f7d3e42..861ad80da5c 100644
--- a/src/xftfont.c
+++ b/src/xftfont.c
@@ -586,7 +586,7 @@ xftfont_get_xft_draw (struct frame *f)
{
block_input ();
xft_draw= XftDrawCreate (FRAME_X_DISPLAY (f),
- FRAME_X_WINDOW (f),
+ FRAME_X_DRAWABLE (f),
FRAME_X_VISUAL (f),
FRAME_X_COLORMAP (f));
unblock_input ();
@@ -600,6 +600,8 @@ static int
xftfont_draw (struct glyph_string *s, int from, int to, int x, int y,
bool with_background)
{
+ block_input ();
+
struct frame *f = s->f;
struct face *face = s->face;
struct xftfont_info *xftfont_info = (struct xftfont_info *) s->font;
@@ -614,7 +616,6 @@ xftfont_draw (struct glyph_string *s, int from, int to, int x, int y,
xftface_info = (struct xftface_info *) face->extra;
xftfont_get_colors (f, face, s->gc, xftface_info,
&fg, with_background ? &bg : NULL);
- block_input ();
if (s->num_clips > 0)
XftDrawSetClipRectangles (xft_draw, 0, 0, s->clip, s->num_clips);
else
@@ -652,9 +653,12 @@ xftfont_draw (struct glyph_string *s, int from, int to, int x, int y,
x + i, y, code + i, 1);
else
XftDrawGlyphs (xft_draw, &fg, xftfont_info->xftfont,
- x, y, code, len);
+ x, y, code, len);
+ /* Need to explicitly mark the frame dirty because we didn't call
+ FRAME_X_DRAWABLE in order to draw: we cached the drawable in the
+ XftDraw structure. */
+ x_mark_frame_dirty (f);
unblock_input ();
-
return len;
}
@@ -678,13 +682,10 @@ xftfont_shape (Lisp_Object lgstring)
static int
xftfont_end_for_frame (struct frame *f)
{
+ block_input ();
XftDraw *xft_draw;
- /* Don't do anything if display is dead */
- if (FRAME_X_DISPLAY (f) == NULL) return 0;
-
xft_draw = font_get_frame_data (f, Qxft);
-
if (xft_draw)
{
block_input ();
@@ -692,9 +693,19 @@ xftfont_end_for_frame (struct frame *f)
unblock_input ();
font_put_frame_data (f, Qxft, NULL);
}
+ unblock_input ();
return 0;
}
+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 ();
+}
+
static bool
xftfont_cached_font_ok (struct frame *f, Lisp_Object font_object,
Lisp_Object entity)
@@ -777,6 +788,10 @@ This is needed with some fonts to correct vertical overlap of glyphs. */);
#if defined (HAVE_M17N_FLT) && defined (HAVE_LIBOTF)
xftfont_driver.shape = xftfont_shape;
#endif
+ /* When using X double buffering, the XftDraw structure we build
+ seems to be useless once a frame is resized, so recreate it on
+ ConfigureNotify and in some other cases. */
+ xftfont_driver.drop_xrender_surfaces = xftfont_drop_xrender_surfaces;
register_font_driver (&xftfont_driver, NULL);
}
diff --git a/src/xgselect.c b/src/xgselect.c
index ac88afdd54b..7850a16e9c0 100644
--- a/src/xgselect.c
+++ b/src/xgselect.c
@@ -25,7 +25,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <glib.h>
#include <errno.h>
-#include <stdbool.h>
#include "blockinput.h"
#include "systime.h"
diff --git a/src/xmenu.c b/src/xmenu.c
index 9e1a817946a..9ab7bdf971f 100644
--- a/src/xmenu.c
+++ b/src/xmenu.c
@@ -1649,7 +1649,7 @@ x_menu_show (struct frame *f, int x, int y, int menuflags,
{
unblock_input ();
/* Make "Cancel" equivalent to C-g. */
- Fsignal (Qquit, Qnil);
+ quit ();
}
unblock_input ();
@@ -1913,7 +1913,7 @@ x_dialog_show (struct frame *f, Lisp_Object title,
}
else
/* Make "Cancel" equivalent to C-g. */
- Fsignal (Qquit, Qnil);
+ quit ();
return Qnil;
}
@@ -2304,7 +2304,7 @@ x_menu_show (struct frame *f, int x, int y, int menuflags,
if (!(menuflags & MENU_FOR_CLICK))
{
unblock_input ();
- Fsignal (Qquit, Qnil);
+ quit ();
}
break;
}
diff --git a/src/xml.c b/src/xml.c
index 612b16c4c53..7d61dc7413e 100644
--- a/src/xml.c
+++ b/src/xml.c
@@ -45,7 +45,7 @@ DEF_DLL_FN (void, xmlCheckVersion, (int));
static bool
libxml2_loaded_p (void)
{
- Lisp_Object found = Fassq (Qlibxml2_dll, Vlibrary_cache);
+ Lisp_Object found = Fassq (Qlibxml2, Vlibrary_cache);
return CONSP (found) && EQ (XCDR (found), Qt);
}
@@ -96,7 +96,7 @@ init_libxml2_functions (void)
{
HMODULE library;
- if (!(library = w32_delayed_load (Qlibxml2_dll)))
+ if (!(library = w32_delayed_load (Qlibxml2)))
{
message1 ("libxml2 library not found");
return false;
@@ -105,12 +105,12 @@ init_libxml2_functions (void)
if (! load_dll_functions (library))
goto bad_library;
- Vlibrary_cache = Fcons (Fcons (Qlibxml2_dll, Qt), Vlibrary_cache);
+ Vlibrary_cache = Fcons (Fcons (Qlibxml2, Qt), Vlibrary_cache);
return true;
}
bad_library:
- Vlibrary_cache = Fcons (Fcons (Qlibxml2_dll, Qnil), Vlibrary_cache);
+ Vlibrary_cache = Fcons (Fcons (Qlibxml2, Qnil), Vlibrary_cache);
return false;
#else /* !WINDOWSNT */
diff --git a/src/xselect.c b/src/xselect.c
index ff6dc3287cf..b997cc887ef 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -215,7 +215,7 @@ symbol_to_x_atom (struct x_display_info *dpyinfo, Lisp_Object sym)
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, QEMACS_TMP)) return dpyinfo->Xatom_EMACS_TMP;
+ 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 ();
@@ -273,7 +273,7 @@ x_atom_to_symbol (struct x_display_info *dpyinfo, Atom atom)
if (atom == dpyinfo->Xatom_INCR)
return QINCR;
if (atom == dpyinfo->Xatom_EMACS_TMP)
- return QEMACS_TMP;
+ return Q_EMACS_TMP_;
if (atom == dpyinfo->Xatom_TARGETS)
return QTARGETS;
if (atom == dpyinfo->Xatom_NULL)
@@ -1318,7 +1318,7 @@ x_get_window_property (Display *display, Window window, Atom property,
data = data1;
}
- if (BITS_PER_LONG > 32 && *actual_format_ret == 32)
+ if (LONG_WIDTH > 32 && *actual_format_ret == 32)
{
unsigned long i;
int *idata = (int *) (data + offset);
@@ -1613,11 +1613,24 @@ selection_data_to_lisp_data (struct x_display_info *dpyinfo,
/* 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 cons of integers, 16 bits in each half.
+
+ INTEGER is a signed type, CARDINAL is unsigned.
+ Assume any other types are unsigned as well.
*/
else if (format == 32 && size == sizeof (int))
- return INTEGER_TO_CONS (((int *) data) [0]);
+ {
+ if (type == XA_INTEGER)
+ return INTEGER_TO_CONS (((int *) data) [0]);
+ else
+ return INTEGER_TO_CONS (((unsigned int *) data) [0]);
+ }
else if (format == 16 && size == sizeof (short))
- return make_number (((short *) data) [0]);
+ {
+ if (type == XA_INTEGER)
+ return make_number (((short *) data) [0]);
+ else
+ return make_number (((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.)
@@ -1627,11 +1640,22 @@ selection_data_to_lisp_data (struct x_display_info *dpyinfo,
ptrdiff_t i;
Lisp_Object v = make_uninit_vector (size / 2);
- for (i = 0; i < size / 2; i++)
- {
- short j = ((short *) data) [i];
- ASET (v, i, make_number (j));
- }
+ if (type == XA_INTEGER)
+ {
+ for (i = 0; i < size / 2; i++)
+ {
+ short j = ((short *) data) [i];
+ ASET (v, i, make_number (j));
+ }
+ }
+ else
+ {
+ for (i = 0; i < size / 2; i++)
+ {
+ unsigned short j = ((unsigned short *) data) [i];
+ ASET (v, i, make_number (j));
+ }
+ }
return v;
}
else
@@ -1639,11 +1663,22 @@ selection_data_to_lisp_data (struct x_display_info *dpyinfo,
ptrdiff_t i;
Lisp_Object v = make_uninit_vector (size / X_LONG_SIZE);
- for (i = 0; i < size / X_LONG_SIZE; i++)
- {
- int j = ((int *) data) [i];
- ASET (v, i, INTEGER_TO_CONS (j));
- }
+ if (type == XA_INTEGER)
+ {
+ for (i = 0; i < size / X_LONG_SIZE; i++)
+ {
+ int j = ((int *) data) [i];
+ ASET (v, i, INTEGER_TO_CONS (j));
+ }
+ }
+ else
+ {
+ for (i = 0; i < size / X_LONG_SIZE; i++)
+ {
+ unsigned int j = ((unsigned int *) data) [i];
+ ASET (v, i, INTEGER_TO_CONS (j));
+ }
+ }
return v;
}
}
@@ -2297,13 +2332,13 @@ x_fill_property_data (Display *dpy, Lisp_Object data, void *ret, int format)
if (format == 8)
{
if ((1 << 8) < val && val <= X_ULONG_MAX - (1 << 7))
- error ("Out of 'char' range");
+ error ("Out of `char' range");
*d08++ = val;
}
else if (format == 16)
{
if ((1 << 16) < val && val <= X_ULONG_MAX - (1 << 15))
- error ("Out of 'short' range");
+ error ("Out of `short' range");
*d16++ = val;
}
else
@@ -2439,7 +2474,7 @@ x_handle_dnd_message (struct frame *f, const XClientMessageEvent *event,
function expects them to be of size int (i.e. 32). So to be able to
use that function, put the data in the form it expects if format is 32. */
- if (BITS_PER_LONG > 32 && event->format == 32)
+ if (LONG_WIDTH > 32 && event->format == 32)
{
for (i = 0; i < 5; ++i) /* There are only 5 longs in a ClientMessage. */
idata[i] = event->data.l[i];
@@ -2680,7 +2715,7 @@ A value of 0 means wait as long as necessary. This is initialized from the
DEFSYM (QDELETE, "DELETE");
DEFSYM (QMULTIPLE, "MULTIPLE");
DEFSYM (QINCR, "INCR");
- DEFSYM (QEMACS_TMP, "_EMACS_TMP_");
+ DEFSYM (Q_EMACS_TMP_, "_EMACS_TMP_");
DEFSYM (QTARGETS, "TARGETS");
DEFSYM (QATOM, "ATOM");
DEFSYM (QCLIPBOARD_MANAGER, "CLIPBOARD_MANAGER");
diff --git a/src/xsmfns.c b/src/xsmfns.c
index d54a94df877..95ede642130 100644
--- a/src/xsmfns.c
+++ b/src/xsmfns.c
@@ -204,7 +204,7 @@ smc_save_yourself_CB (SmcConn smcConn,
props[props_idx]->vals[0].value = SDATA (user_login_name);
++props_idx;
- char *cwd = get_current_dir_name ();
+ char *cwd = emacs_get_current_dir_name ();
if (cwd)
{
props[props_idx] = &prop_ptr[props_idx];
@@ -401,7 +401,7 @@ x_session_initialize (struct x_display_info *dpyinfo)
ptrdiff_t name_len = 0;
/* libSM seems to crash if pwd is missing - see bug#18851. */
- if (! get_current_dir_name ())
+ if (! emacs_get_current_dir_name ())
{
fprintf (stderr, "Disabling session management due to pwd error: %s\n",
emacs_strerror (errno));
diff --git a/src/xterm.c b/src/xterm.c
index 213a527d55d..bdc21e6de02 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -22,6 +22,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
+#include <stdlib.h>
#ifdef USE_CAIRO
#include <math.h>
#endif
@@ -44,6 +45,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <X11/extensions/Xrender.h>
#endif
+#ifdef HAVE_XDBE
+#include <X11/extensions/Xdbe.h>
+#endif
+
/* Load sys/types.h if not already loaded.
In some systems loading it twice is suicidal. */
#ifndef makedev
@@ -95,10 +100,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#endif
#ifdef USE_X_TOOLKIT
-#if !defined (NO_EDITRES)
-#define HACK_EDITRES
-extern void _XEditResCheckMessages (Widget, XtPointer, XEvent *, Boolean *);
-#endif /* not NO_EDITRES */
/* Include toolkit specific headers for the scroll bar widget. */
@@ -363,7 +364,7 @@ x_begin_cr_clip (struct frame *f, GC gc)
{
cairo_surface_t *surface;
surface = cairo_xlib_surface_create (FRAME_X_DISPLAY (f),
- FRAME_X_WINDOW (f),
+ FRAME_X_DRAWABLE (f),
FRAME_DISPLAY_INFO (f)->visual,
FRAME_PIXEL_WIDTH (f),
FRAME_PIXEL_HEIGHT (f));
@@ -725,7 +726,7 @@ x_fill_rectangle (struct frame *f, GC gc, int x, int y, int width, int height)
cairo_fill (cr);
x_end_cr_clip (f);
#else
- XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
gc, x, y, width, height);
#endif
}
@@ -743,7 +744,7 @@ x_draw_rectangle (struct frame *f, GC gc, int x, int y, int width, int height)
cairo_stroke (cr);
x_end_cr_clip (f);
#else
- XDrawRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ XDrawRectangle (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
gc, x, y, width, height);
#endif
}
@@ -759,7 +760,10 @@ x_clear_window (struct frame *f)
cairo_paint (cr);
x_end_cr_clip (f);
#else
- XClearWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
+ if (FRAME_X_DOUBLE_BUFFERED_P (f))
+ x_clear_area (f, 0, 0, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f));
+ else
+ XClearWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
#endif
}
@@ -1062,7 +1066,7 @@ x_draw_vertical_window_border (struct window *w, int x, int y0, int y1)
struct frame *f = XFRAME (WINDOW_FRAME (w));
struct face *face;
- face = FACE_FROM_ID (f, VERTICAL_BORDER_FACE_ID);
+ face = FACE_FROM_ID_OR_NULL (f, VERTICAL_BORDER_FACE_ID);
if (face)
XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->normal_gc,
face->foreground);
@@ -1070,7 +1074,7 @@ x_draw_vertical_window_border (struct window *w, int x, int y0, int y1)
#ifdef USE_CAIRO
x_fill_rectangle (f, f->output_data.x->normal_gc, x, y0, 1, y1 - y0);
#else
- XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
f->output_data.x->normal_gc, x, y0, x, y1);
#endif
}
@@ -1081,9 +1085,11 @@ static void
x_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1)
{
struct frame *f = XFRAME (WINDOW_FRAME (w));
- struct face *face = FACE_FROM_ID (f, WINDOW_DIVIDER_FACE_ID);
- struct face *face_first = FACE_FROM_ID (f, WINDOW_DIVIDER_FIRST_PIXEL_FACE_ID);
- struct face *face_last = FACE_FROM_ID (f, WINDOW_DIVIDER_LAST_PIXEL_FACE_ID);
+ struct face *face = FACE_FROM_ID_OR_NULL (f, WINDOW_DIVIDER_FACE_ID);
+ struct face *face_first
+ = FACE_FROM_ID_OR_NULL (f, WINDOW_DIVIDER_FIRST_PIXEL_FACE_ID);
+ struct face *face_last
+ = FACE_FROM_ID_OR_NULL (f, WINDOW_DIVIDER_LAST_PIXEL_FACE_ID);
unsigned long color = face ? face->foreground : FRAME_FOREGROUND_PIXEL (f);
unsigned long color_first = (face_first
? face_first->foreground
@@ -1176,6 +1182,41 @@ x_update_window_end (struct window *w, bool cursor_on_p,
}
}
+/* 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. */
+static void
+show_back_buffer (struct frame *f)
+{
+ block_input ();
+ if (FRAME_X_DOUBLE_BUFFERED_P (f))
+ {
+#ifdef HAVE_XDBE
+ XdbeSwapInfo swap_info;
+ memset (&swap_info, 0, sizeof (swap_info));
+ 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 ();
+}
+
+/* Updates back buffer and flushes changes to display. Called from
+ minibuf read code. Note that we display the back buffer even if
+ buffer flipping is blocked. */
+static void
+x_flip_and_flush (struct frame *f)
+{
+ block_input ();
+ if (FRAME_X_NEED_BUFFER_FLIP (f))
+ show_back_buffer (f);
+ x_flush (f);
+ unblock_input ();
+}
/* End update of frame F. This function is installed as a hook in
update_end. */
@@ -1208,7 +1249,7 @@ x_update_end (struct frame *f)
if (! FRAME_EXTERNAL_MENU_BAR (f))
height += FRAME_MENU_BAR_HEIGHT (f);
surface = cairo_xlib_surface_create (FRAME_X_DISPLAY (f),
- FRAME_X_WINDOW (f),
+ FRAME_X_DRAWABLE (f),
FRAME_DISPLAY_INFO (f)->visual,
width,
height);
@@ -1221,7 +1262,7 @@ x_update_end (struct frame *f)
cairo_destroy (cr);
unblock_input ();
}
-#endif /* USE_CAIRO */
+#endif
#ifndef XFlush
block_input ();
@@ -1230,17 +1271,26 @@ x_update_end (struct frame *f)
#endif
}
-
/* This function is called from various places in xdisp.c
whenever a complete update has been performed. */
static void
XTframe_up_to_date (struct frame *f)
{
- if (FRAME_X_P (f))
- FRAME_MOUSE_UPDATE (f);
+ eassert (FRAME_X_P (f));
+ block_input ();
+ FRAME_MOUSE_UPDATE (f);
+ if (!buffer_flipping_blocked_p () && FRAME_X_NEED_BUFFER_FLIP (f))
+ show_back_buffer (f);
+ unblock_input ();
}
+static void
+XTbuffer_flipping_unblocked_hook (struct frame *f)
+{
+ if (FRAME_X_NEED_BUFFER_FLIP (f))
+ show_back_buffer (f);
+}
/* Clear under internal border if any (GTK has its own version). */
#ifndef USE_GTK
@@ -1355,7 +1405,7 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring
#else /* not USE_CAIRO */
if (p->which)
{
- Window window = FRAME_X_WINDOW (f);
+ Drawable drawable = FRAME_X_DRAWABLE (f);
char *bits;
Pixmap pixmap, clipmask = (Pixmap) 0;
int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
@@ -1368,7 +1418,7 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring
/* Draw the bitmap. I believe these small pixmaps can be cached
by the server. */
- pixmap = XCreatePixmapFromBitmapData (display, window, bits, p->wd, p->h,
+ pixmap = XCreatePixmapFromBitmapData (display, drawable, bits, p->wd, p->h,
(p->cursor_p
? (p->overlay_p ? face->background
: f->output_data.x->cursor_pixel)
@@ -1387,7 +1437,7 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring
XChangeGC (display, gc, GCClipMask | GCClipXOrigin | GCClipYOrigin, &gcv);
}
- XCopyArea (display, pixmap, window, gc, 0, 0,
+ XCopyArea (display, pixmap, drawable, gc, 0, 0,
p->wd, p->h, p->x, p->y);
XFreePixmap (display, pixmap);
@@ -1488,7 +1538,7 @@ x_set_cursor_gc (struct glyph_string *s)
mask, &xgcv);
else
FRAME_DISPLAY_INFO (s->f)->scratch_cursor_gc
- = XCreateGC (s->display, s->window, mask, &xgcv);
+ = XCreateGC (s->display, FRAME_X_DRAWABLE (s->f), mask, &xgcv);
s->gc = FRAME_DISPLAY_INFO (s->f)->scratch_cursor_gc;
}
@@ -1505,7 +1555,7 @@ x_set_mouse_face_gc (struct glyph_string *s)
/* What face has to be used last for the mouse face? */
face_id = MOUSE_HL_INFO (s->f)->mouse_face_face_id;
- face = FACE_FROM_ID (s->f, face_id);
+ face = FACE_FROM_ID_OR_NULL (s->f, face_id);
if (face == NULL)
face = FACE_FROM_ID (s->f, MOUSE_FACE_ID);
@@ -1535,7 +1585,7 @@ x_set_mouse_face_gc (struct glyph_string *s)
mask, &xgcv);
else
FRAME_DISPLAY_INFO (s->f)->scratch_cursor_gc
- = XCreateGC (s->display, s->window, mask, &xgcv);
+ = XCreateGC (s->display, FRAME_X_DRAWABLE (s->f), mask, &xgcv);
s->gc = FRAME_DISPLAY_INFO (s->f)->scratch_cursor_gc;
@@ -2156,6 +2206,7 @@ static const XColor *
x_color_cells (Display *dpy, int *ncells)
{
struct x_display_info *dpyinfo = x_display_info_for_display (dpy);
+ eassume (dpyinfo);
if (dpyinfo->color_cells == NULL)
{
@@ -2352,17 +2403,19 @@ x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color)
equal to a cached pixel color recorded earlier, there was a
change in the colormap, so clear the color cache. */
struct x_display_info *dpyinfo = x_display_info_for_display (dpy);
- XColor *cached_color;
+ eassume (dpyinfo);
- if (dpyinfo->color_cells
- && (cached_color = &dpyinfo->color_cells[color->pixel],
- (cached_color->red != color->red
- || cached_color->blue != color->blue
- || cached_color->green != color->green)))
+ if (dpyinfo->color_cells)
{
- xfree (dpyinfo->color_cells);
- dpyinfo->color_cells = NULL;
- dpyinfo->ncolor_cells = 0;
+ XColor *cached_color = &dpyinfo->color_cells[color->pixel];
+ if (cached_color->red != color->red
+ || cached_color->blue != color->blue
+ || cached_color->green != color->green)
+ {
+ xfree (dpyinfo->color_cells);
+ dpyinfo->color_cells = NULL;
+ dpyinfo->ncolor_cells = 0;
+ }
}
}
@@ -2563,7 +2616,7 @@ x_setup_relief_color (struct frame *f, struct relief *relief, double factor,
{
xgcv.stipple = dpyinfo->gray;
mask |= GCStipple;
- relief->gc = XCreateGC (dpy, FRAME_X_WINDOW (f), mask, &xgcv);
+ relief->gc = XCreateGC (dpy, FRAME_X_DRAWABLE (f), mask, &xgcv);
}
else
XChangeGC (dpy, relief->gc, mask, &xgcv);
@@ -2694,7 +2747,7 @@ x_draw_relief_rect (struct frame *f,
x_reset_clip_rectangles (f, bottom_right_gc);
#else
Display *dpy = FRAME_X_DISPLAY (f);
- Window window = FRAME_X_WINDOW (f);
+ Drawable drawable = FRAME_X_DRAWABLE (f);
int i;
GC gc;
@@ -2713,12 +2766,12 @@ x_draw_relief_rect (struct frame *f,
if (top_p)
{
if (width == 1)
- XDrawLine (dpy, window, gc,
+ XDrawLine (dpy, drawable, gc,
left_x + left_p, top_y,
right_x + !right_p, top_y);
for (i = 1; i < width; ++i)
- XDrawLine (dpy, window, gc,
+ XDrawLine (dpy, drawable, gc,
left_x + i * left_p, top_y + i,
right_x + 1 - i * right_p, top_y + i);
}
@@ -2727,13 +2780,13 @@ x_draw_relief_rect (struct frame *f,
if (left_p)
{
if (width == 1)
- XDrawLine (dpy, window, gc, left_x, top_y + 1, left_x, bottom_y);
+ XDrawLine (dpy, drawable, gc, left_x, top_y + 1, left_x, bottom_y);
- XClearArea (dpy, window, left_x, top_y, 1, 1, False);
- XClearArea (dpy, window, left_x, bottom_y, 1, 1, False);
+ x_clear_area(f, left_x, top_y, 1, 1);
+ x_clear_area(f, left_x, bottom_y, 1, 1);
for (i = (width > 1 ? 1 : 0); i < width; ++i)
- XDrawLine (dpy, window, gc,
+ XDrawLine (dpy, drawable, gc,
left_x + i, top_y + (i + 1) * top_p,
left_x + i, bottom_y + 1 - (i + 1) * bot_p);
}
@@ -2749,23 +2802,23 @@ x_draw_relief_rect (struct frame *f,
{
/* Outermost top line. */
if (top_p)
- XDrawLine (dpy, window, gc,
+ XDrawLine (dpy, drawable, gc,
left_x + left_p, top_y,
right_x + !right_p, top_y);
/* Outermost left line. */
if (left_p)
- XDrawLine (dpy, window, gc, left_x, top_y + 1, left_x, bottom_y);
+ XDrawLine (dpy, drawable, gc, left_x, top_y + 1, left_x, bottom_y);
}
/* Bottom. */
if (bot_p)
{
- XDrawLine (dpy, window, gc,
+ XDrawLine (dpy, drawable, gc,
left_x + left_p, bottom_y,
right_x + !right_p, bottom_y);
for (i = 1; i < width; ++i)
- XDrawLine (dpy, window, gc,
+ XDrawLine (dpy, drawable, gc,
left_x + i * left_p, bottom_y - i,
right_x + 1 - i * right_p, bottom_y - i);
}
@@ -2773,10 +2826,10 @@ x_draw_relief_rect (struct frame *f,
/* Right. */
if (right_p)
{
- XClearArea (dpy, window, right_x, top_y, 1, 1, False);
- XClearArea (dpy, window, right_x, bottom_y, 1, 1, False);
+ x_clear_area(f, right_x, top_y, 1, 1);
+ x_clear_area(f, right_x, bottom_y, 1, 1);
for (i = 0; i < width; ++i)
- XDrawLine (dpy, window, gc,
+ XDrawLine (dpy, drawable, gc,
right_x - i, top_y + (i + 1) * top_p,
right_x - i, bottom_y + 1 - (i + 1) * bot_p);
}
@@ -2928,7 +2981,8 @@ x_draw_image_foreground (struct glyph_string *s)
image_rect.width = s->slice.width;
image_rect.height = s->slice.height;
if (x_intersect_rectangles (&clip_rect, &image_rect, &r))
- XCopyArea (s->display, s->img->pixmap, s->window, s->gc,
+ XCopyArea (s->display, s->img->pixmap,
+ FRAME_X_DRAWABLE (s->f), s->gc,
s->slice.x + r.x - x, s->slice.y + r.y - y,
r.width, r.height, r.x, r.y);
}
@@ -2942,7 +2996,8 @@ x_draw_image_foreground (struct glyph_string *s)
image_rect.width = s->slice.width;
image_rect.height = s->slice.height;
if (x_intersect_rectangles (&clip_rect, &image_rect, &r))
- XCopyArea (s->display, s->img->pixmap, s->window, s->gc,
+ XCopyArea (s->display, s->img->pixmap,
+ FRAME_X_DRAWABLE (s->f), s->gc,
s->slice.x + r.x - x, s->slice.y + r.y - y,
r.width, r.height, r.x, r.y);
@@ -3182,7 +3237,7 @@ x_draw_image_glyph_string (struct glyph_string *s)
int depth = DefaultDepthOfScreen (screen);
/* Create a pixmap as large as the glyph string. */
- pixmap = XCreatePixmap (s->display, s->window,
+ pixmap = XCreatePixmap (s->display, FRAME_X_DRAWABLE (s->f),
s->background_width,
s->height, depth);
@@ -3257,7 +3312,7 @@ x_draw_image_glyph_string (struct glyph_string *s)
{
x_draw_image_foreground_1 (s, pixmap);
x_set_glyph_string_clipping (s);
- XCopyArea (s->display, pixmap, s->window, s->gc,
+ XCopyArea (s->display, pixmap, FRAME_X_DRAWABLE (s->f), s->gc,
0, 0, s->background_width, s->height, s->x, s->y);
XFreePixmap (s->display, pixmap);
}
@@ -3436,7 +3491,7 @@ x_draw_underwave (struct glyph_string *s)
while (x1 <= xmax)
{
- XDrawLine (s->display, s->window, s->gc, x1, y1, x2, y2);
+ XDrawLine (s->display, FRAME_X_DRAWABLE (s->f), s->gc, x1, y1, x2, y2);
x1 = x2, y1 = y2;
x2 += dx, y2 = y0 + odd*dy;
odd = !odd;
@@ -3739,7 +3794,7 @@ x_shift_glyphs_for_insert (struct frame *f, int x, int y, int width, int height,
/* Never called on a GUI frame, see
http://lists.gnu.org/archive/html/emacs-devel/2015-05/msg00456.html
*/
- XCopyArea (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), FRAME_X_WINDOW (f),
+ XCopyArea (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), FRAME_X_DRAWABLE (f),
f->output_data.x->normal_gc,
x, y, width, height,
x + shift_by, y);
@@ -3780,8 +3835,14 @@ x_clear_area (struct frame *f, int x, int y, int width, int height)
cairo_fill (cr);
x_end_cr_clip (f);
#else
- x_clear_area1 (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- x, y, width, height, False);
+ 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);
+ else
+ x_clear_area1 (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ x, y, width, height, False);
#endif
}
@@ -3797,19 +3858,13 @@ x_clear_frame (struct frame *f)
block_input ();
+ font_drop_xrender_surfaces (f);
x_clear_window (f);
/* We have to clear the scroll bars. If we have changed colors or
something like that, then they should be notified. */
x_scroll_bar_clear (f);
-#if defined (USE_GTK) && defined (USE_TOOLKIT_SCROLL_BARS)
- /* Make sure scroll bars are redrawn. As they aren't redrawn by
- redisplay, do it here. */
- if (FRAME_GTK_WIDGET (f))
- gtk_widget_queue_draw (FRAME_GTK_WIDGET (f));
-#endif
-
XFlush (FRAME_X_DISPLAY (f));
unblock_input ();
@@ -4107,7 +4162,7 @@ x_scroll_run (struct window *w, struct run *run)
SET_FRAME_GARBAGED (f);
#else
XCopyArea (FRAME_X_DISPLAY (f),
- FRAME_X_WINDOW (f), FRAME_X_WINDOW (f),
+ FRAME_X_DRAWABLE (f), FRAME_X_DRAWABLE (f),
f->output_data.x->normal_gc,
x, from_y,
width, height,
@@ -4646,12 +4701,15 @@ x_find_modifier_meanings (struct x_display_info *dpyinfo)
int
x_x_to_emacs_modifiers (struct x_display_info *dpyinfo, int state)
{
+ int mod_ctrl = ctrl_modifier;
int mod_meta = meta_modifier;
int mod_alt = alt_modifier;
int mod_hyper = hyper_modifier;
int mod_super = super_modifier;
Lisp_Object tem;
+ tem = Fget (Vx_ctrl_keysym, Qmodifier_value);
+ if (INTEGERP (tem)) mod_ctrl = XINT (tem) & INT_MAX;
tem = Fget (Vx_alt_keysym, Qmodifier_value);
if (INTEGERP (tem)) mod_alt = XINT (tem) & INT_MAX;
tem = Fget (Vx_meta_keysym, Qmodifier_value);
@@ -4662,7 +4720,7 @@ x_x_to_emacs_modifiers (struct x_display_info *dpyinfo, int state)
if (INTEGERP (tem)) mod_super = XINT (tem) & INT_MAX;
return ( ((state & (ShiftMask | dpyinfo->shift_lock_mask)) ? shift_modifier : 0)
- | ((state & ControlMask) ? ctrl_modifier : 0)
+ | ((state & ControlMask) ? mod_ctrl : 0)
| ((state & dpyinfo->meta_mod_mask) ? mod_meta : 0)
| ((state & dpyinfo->alt_mod_mask) ? mod_alt : 0)
| ((state & dpyinfo->super_mod_mask) ? mod_super : 0)
@@ -4672,6 +4730,7 @@ x_x_to_emacs_modifiers (struct x_display_info *dpyinfo, int state)
static int
x_emacs_to_x_modifiers (struct x_display_info *dpyinfo, EMACS_INT state)
{
+ EMACS_INT mod_ctrl = ctrl_modifier;
EMACS_INT mod_meta = meta_modifier;
EMACS_INT mod_alt = alt_modifier;
EMACS_INT mod_hyper = hyper_modifier;
@@ -4679,6 +4738,8 @@ x_emacs_to_x_modifiers (struct x_display_info *dpyinfo, EMACS_INT state)
Lisp_Object tem;
+ tem = Fget (Vx_ctrl_keysym, Qmodifier_value);
+ if (INTEGERP (tem)) mod_ctrl = XINT (tem);
tem = Fget (Vx_alt_keysym, Qmodifier_value);
if (INTEGERP (tem)) mod_alt = XINT (tem);
tem = Fget (Vx_meta_keysym, Qmodifier_value);
@@ -4693,7 +4754,7 @@ x_emacs_to_x_modifiers (struct x_display_info *dpyinfo, EMACS_INT state)
| ((state & mod_super) ? dpyinfo->super_mod_mask : 0)
| ((state & mod_hyper) ? dpyinfo->hyper_mod_mask : 0)
| ((state & shift_modifier) ? ShiftMask : 0)
- | ((state & ctrl_modifier) ? ControlMask : 0)
+ | ((state & mod_ctrl) ? ControlMask : 0)
| ((state & mod_meta) ? dpyinfo->meta_mod_mask : 0));
}
@@ -5244,9 +5305,8 @@ x_send_scroll_bar_event (Lisp_Object window, enum scroll_bar_part part,
struct window *w = XWINDOW (window);
struct frame *f = XFRAME (w->frame);
intptr_t iw = (intptr_t) w;
- enum { BITS_PER_INTPTR = CHAR_BIT * sizeof iw };
- verify (BITS_PER_INTPTR <= 64);
- int sign_shift = BITS_PER_INTPTR - 32;
+ verify (INTPTR_WIDTH <= 64);
+ int sign_shift = INTPTR_WIDTH - 32;
block_input ();
@@ -7447,6 +7507,26 @@ x_net_wm_state (struct frame *f, Window window)
/** store_frame_param (f, Qsticky, sticky ? Qt : Qnil); **/
}
+/* Flip back buffers on any frames with undrawn content. */
+static void
+flush_dirty_back_buffers (void)
+{
+ block_input ();
+ Lisp_Object tail, frame;
+ FOR_EACH_FRAME (tail, frame)
+ {
+ struct frame *f = XFRAME (frame);
+ if (FRAME_LIVE_P (f) &&
+ FRAME_X_P (f) &&
+ FRAME_X_WINDOW (f) &&
+ !FRAME_GARBAGED_P (f) &&
+ !buffer_flipping_blocked_p () &&
+ FRAME_X_NEED_BUFFER_FLIP (f))
+ show_back_buffer (f);
+ }
+ unblock_input ();
+}
+
/* Handles the XEvent EVENT on display DPYINFO.
*FINISH is X_EVENT_GOTO_OUT if caller should stop reading events.
@@ -7605,7 +7685,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
goto done;
}
-#ifdef HACK_EDITRES
+#ifdef X_TOOLKIT_EDITRES
if (event->xclient.message_type == dpyinfo->Xatom_editres)
{
f = any;
@@ -7614,7 +7694,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
NULL, (XEvent *) event, NULL);
goto done;
}
-#endif /* HACK_EDITRES */
+#endif /* X_TOOLKIT_EDITRES */
if (event->xclient.message_type == dpyinfo->Xatom_DONE
|| event->xclient.message_type == dpyinfo->Xatom_PAGE)
@@ -7765,23 +7845,49 @@ handle_one_xevent (struct x_display_info *dpyinfo,
{
if (!FRAME_VISIBLE_P (f))
{
+ block_input ();
SET_FRAME_VISIBLE (f, 1);
SET_FRAME_ICONIFIED (f, false);
+ if (FRAME_X_DOUBLE_BUFFERED_P (f))
+ font_drop_xrender_surfaces (f);
f->output_data.x->has_been_visible = true;
SET_FRAME_GARBAGED (f);
+ unblock_input ();
}
- else
- {
+ else if (FRAME_GARBAGED_P (f))
+ {
#ifdef USE_GTK
- /* This seems to be needed for GTK 2.6 and later, see
- http://debbugs.gnu.org/cgi/bugreport.cgi?bug=15398. */
- x_clear_area (f,
- event->xexpose.x, event->xexpose.y,
- event->xexpose.width, event->xexpose.height);
+ /* Go around the back buffer and manually clear the
+ window the first time we show it. This way, we avoid
+ showing users the sanity-defying horror of whatever
+ GtkWindow is rendering beneath us. We've garbaged
+ the frame, so we'll redraw the whole thing on next
+ redisplay anyway. Yuck. */
+ x_clear_area1 (
+ FRAME_X_DISPLAY (f),
+ FRAME_X_WINDOW (f),
+ event->xexpose.x, event->xexpose.y,
+ event->xexpose.width, event->xexpose.height,
+ 0);
#endif
- expose_frame (f, event->xexpose.x, event->xexpose.y,
+ }
+
+
+ if (!FRAME_GARBAGED_P (f))
+ {
+#ifdef USE_GTK
+ /* This seems to be needed for GTK 2.6 and later, see
+ http://debbugs.gnu.org/cgi/bugreport.cgi?bug=15398. */
+ x_clear_area (f,
+ event->xexpose.x, event->xexpose.y,
+ event->xexpose.width, event->xexpose.height);
+#endif
+ expose_frame (f, event->xexpose.x, event->xexpose.y,
event->xexpose.width, event->xexpose.height);
- }
+ }
+
+ if (!FRAME_GARBAGED_P (f))
+ show_back_buffer (f);
}
else
{
@@ -7821,10 +7927,13 @@ handle_one_xevent (struct x_display_info *dpyinfo,
available. */
f = x_window_to_frame (dpyinfo, event->xgraphicsexpose.drawable);
if (f)
- expose_frame (f, event->xgraphicsexpose.x,
- event->xgraphicsexpose.y,
- event->xgraphicsexpose.width,
- event->xgraphicsexpose.height);
+ {
+ expose_frame (f, event->xgraphicsexpose.x,
+ event->xgraphicsexpose.y,
+ event->xgraphicsexpose.width,
+ event->xgraphicsexpose.height);
+ show_back_buffer (f);
+ }
#ifdef USE_X_TOOLKIT
else
goto OTHER;
@@ -7895,16 +8004,6 @@ handle_one_xevent (struct x_display_info *dpyinfo,
/* Force a redisplay sooner or later to update the
frame titles in case this is the second frame. */
record_asynch_buffer_change ();
-
-#ifdef USE_GTK
- /* xg_frame_resized does the wrong thing with Gtk+ 3.20.3 or later.
- For earlier Gtk+ versions it is unclear whether
- xg_frame_resized is useful, so leave it in for now.
- See Bug#23144. */
-# if ! GTK_CHECK_VERSION (3, 20, 3)
- xg_frame_resized (f, -1, -1);
-# endif
-#endif
}
goto OTHER;
@@ -8419,7 +8518,17 @@ handle_one_xevent (struct x_display_info *dpyinfo,
else
configureEvent = next_event;
}
+
f = x_top_window_to_frame (dpyinfo, configureEvent.xconfigure.window);
+ /* Unfortunately, we need to call font_drop_xrender_surfaces for
+ _all_ ConfigureNotify events, otherwise we miss some and
+ flicker. Don't try to optimize these calls by looking only
+ for size changes: that's not sufficient. We miss some
+ surface invalidations and flicker. */
+ block_input ();
+ if (f && FRAME_X_DOUBLE_BUFFERED_P (f))
+ font_drop_xrender_surfaces (f);
+ unblock_input ();
#ifdef USE_CAIRO
if (f) x_cr_destroy_surface (f);
#endif
@@ -8428,6 +8537,10 @@ handle_one_xevent (struct x_display_info *dpyinfo,
&& (f = any)
&& configureEvent.xconfigure.window == FRAME_X_WINDOW (f))
{
+ block_input ();
+ if (FRAME_X_DOUBLE_BUFFERED_P (f))
+ font_drop_xrender_surfaces (f);
+ unblock_input ();
xg_frame_resized (f, configureEvent.xconfigure.width,
configureEvent.xconfigure.height);
#ifdef USE_CAIRO
@@ -8438,7 +8551,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
#endif
if (f)
{
- x_net_wm_state (f, configureEvent.xconfigure.window);
+
+ x_net_wm_state (f, configureEvent.xconfigure.window);
#ifdef USE_X_TOOLKIT
/* Tip frames are pure X window, set size for them. */
@@ -8446,7 +8560,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
{
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;
}
@@ -8472,8 +8588,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
|| configureEvent.xconfigure.height != FRAME_PIXEL_HEIGHT (f))
{
change_frame_size (f, width, height, false, true, false, true);
- x_clear_under_internal_border (f);
- SET_FRAME_GARBAGED (f);
+ x_clear_under_internal_border (f);
+ SET_FRAME_GARBAGED (f);
cancel_mouse_face (f);
}
#endif /* not USE_GTK */
@@ -8697,6 +8813,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
count++;
}
+ /* Sometimes event processing draws to the frame outside redisplay.
+ To ensure that these changes become visible, draw them here. */
+ flush_dirty_back_buffers ();
SAFE_FREE ();
return count;
}
@@ -8889,7 +9008,7 @@ x_draw_hollow_cursor (struct window *w, struct glyph_row *row)
if (dpyinfo->scratch_cursor_gc)
XChangeGC (dpy, dpyinfo->scratch_cursor_gc, GCForeground, &xgcv);
else
- dpyinfo->scratch_cursor_gc = XCreateGC (dpy, FRAME_X_WINDOW (f),
+ dpyinfo->scratch_cursor_gc = XCreateGC (dpy, FRAME_X_DRAWABLE (f),
GCForeground, &xgcv);
gc = dpyinfo->scratch_cursor_gc;
@@ -8946,7 +9065,7 @@ x_draw_bar_cursor (struct window *w, struct glyph_row *row, int width, enum text
else
{
Display *dpy = FRAME_X_DISPLAY (f);
- Window window = FRAME_X_WINDOW (f);
+ Drawable drawable = FRAME_X_DRAWABLE (f);
GC gc = FRAME_DISPLAY_INFO (f)->scratch_cursor_gc;
unsigned long mask = GCForeground | GCBackground | GCGraphicsExposures;
struct face *face = FACE_FROM_ID (f, cursor_glyph->face_id);
@@ -8967,7 +9086,7 @@ x_draw_bar_cursor (struct window *w, struct glyph_row *row, int width, enum text
XChangeGC (dpy, gc, mask, &xgcv);
else
{
- gc = XCreateGC (dpy, window, mask, &xgcv);
+ gc = XCreateGC (dpy, drawable, mask, &xgcv);
FRAME_DISPLAY_INFO (f)->scratch_cursor_gc = gc;
}
@@ -9037,11 +9156,6 @@ static void
x_clear_frame_area (struct frame *f, int x, int y, int width, int height)
{
x_clear_area (f, x, y, width, height);
-#ifdef USE_GTK
- /* Must queue a redraw, because scroll bars might have been cleared. */
- if (FRAME_GTK_WIDGET (f))
- gtk_widget_queue_draw (FRAME_GTK_WIDGET (f));
-#endif
}
@@ -9398,7 +9512,7 @@ static char *error_msg;
/* Handle the loss of connection to display DPY. ERROR_MESSAGE is
the text of an error message that lead to the connection loss. */
-static void
+static _Noreturn void
x_connection_closed (Display *dpy, const char *error_message, bool ioerror)
{
struct x_display_info *dpyinfo = x_display_info_for_display (dpy);
@@ -9496,9 +9610,6 @@ For details, see etc/PROBLEMS.\n",
unbind_to (idx, Qnil);
clear_waiting_for_input ();
- /* Tell GCC not to suggest attribute 'noreturn' for this function. */
- IF_LINT (if (! terminal_list) return; )
-
/* Here, we absolutely have to use a non-local exit (e.g. signal, throw,
longjmp), because returning from this function would get us back into
Xlib's code which will directly call `exit'. */
@@ -9564,7 +9675,7 @@ x_error_quitter (Display *display, XErrorEvent *event)
It kills all frames on the display that we lost touch with.
If that was the only one, it prints an error message and kills Emacs. */
-static int
+static _Noreturn int
x_io_error_quitter (Display *display)
{
char buf[256];
@@ -9572,7 +9683,7 @@ x_io_error_quitter (Display *display)
snprintf (buf, sizeof buf, "Connection lost to X server '%s'",
DisplayString (display));
x_connection_closed (display, buf, true);
- return 0;
+ assume (false);
}
/* Changing the font of the frame. */
@@ -10901,9 +11012,9 @@ x_make_frame_visible (struct frame *f)
if (! FRAME_VISIBLE_P (f))
{
- /* We test FRAME_GARBAGED_P here to make sure we don't
- call x_set_offset a second time
- if we get to x_make_frame_visible a second time
+ /* We test asked_for_visible here to make sure we don't
+ call x_set_offset a second time
+ if we get to x_make_frame_visible a second time
before the window gets really visible. */
if (! FRAME_ICONIFIED_P (f)
&& ! FRAME_X_EMBEDDED_P (f)
@@ -10947,6 +11058,8 @@ x_make_frame_visible (struct frame *f)
will set it when they are handled. */
bool previously_visible = f->output_data.x->has_been_visible;
+ XSETFRAME (frame, f);
+
original_left = f->left_pos;
original_top = f->top_pos;
@@ -10993,8 +11106,6 @@ x_make_frame_visible (struct frame *f)
unblock_input ();
}
- XSETFRAME (frame, f);
-
/* Process X events until a MapNotify event has been seen. */
while (!FRAME_VISIBLE_P (f))
{
@@ -11239,6 +11350,7 @@ x_free_frame_resources (struct frame *f)
font-driver (e.g. xft) access a window while finishing a
face. */
free_frame_faces (f);
+ tear_down_x_back_buffer (f);
if (f->output_data.x->icon_desc)
XDestroyWindow (FRAME_X_DISPLAY (f), f->output_data.x->icon_desc);
@@ -11270,7 +11382,7 @@ x_free_frame_resources (struct frame *f)
/* Tooltips don't have widgets, only a simple X window, even if
we are using a toolkit. */
else if (FRAME_X_WINDOW (f))
- XDestroyWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
+ XDestroyWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
free_frame_menubar (f);
@@ -11282,8 +11394,9 @@ x_free_frame_resources (struct frame *f)
xg_free_frame_widgets (f);
#endif /* USE_GTK */
+ tear_down_x_back_buffer (f);
if (FRAME_X_WINDOW (f))
- XDestroyWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
+ XDestroyWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
#endif /* !USE_X_TOOLKIT */
unload_color (f, FRAME_FOREGROUND_PIXEL (f));
@@ -12123,7 +12236,15 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
}
else
dpyinfo->cmap = XCreateColormap (dpyinfo->display, dpyinfo->root_window,
- dpyinfo->visual, AllocNone);
+ dpyinfo->visual, AllocNone);
+
+#ifdef HAVE_XDBE
+ dpyinfo->supports_xdbe = false;
+ int xdbe_major;
+ int xdbe_minor;
+ if (XdbeQueryExtension (dpyinfo->display, &xdbe_major, &xdbe_minor))
+ dpyinfo->supports_xdbe = true;
+#endif
#ifdef HAVE_XFT
{
@@ -12474,7 +12595,7 @@ static struct redisplay_interface x_redisplay_interface =
x_after_update_window_line,
x_update_window_begin,
x_update_window_end,
- x_flush,
+ x_flip_and_flush,
x_clear_window_mouse_face,
x_get_glyph_overhangs,
x_fix_overlapping_area,
@@ -12604,6 +12725,7 @@ 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;
+ terminal->buffer_flipping_unblocked_hook = XTbuffer_flipping_unblocked_hook;
terminal->mouse_position_hook = XTmouse_position;
terminal->frame_rehighlight_hook = XTframe_rehighlight;
terminal->frame_raise_lower_hook = XTframe_raise_lower;
@@ -12747,6 +12869,8 @@ With MS Windows or Nextstep, the value is t. */);
#endif
DEFSYM (Qmodifier_value, "modifier-value");
+ DEFSYM (Qctrl, "ctrl");
+ Fput (Qctrl, Qmodifier_value, make_number (ctrl_modifier));
DEFSYM (Qalt, "alt");
Fput (Qalt, Qmodifier_value, make_number (alt_modifier));
DEFSYM (Qhyper, "hyper");
@@ -12756,32 +12880,39 @@ With MS Windows or Nextstep, the value is t. */);
DEFSYM (Qsuper, "super");
Fput (Qsuper, Qmodifier_value, make_number (super_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'. */);
+ 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 `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'. */);
+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'. */);
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 `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'. */);
+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'. */);
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 `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'. */);
+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'. */);
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 `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'. */);
+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'. */);
Vx_super_keysym = Qnil;
DEFVAR_LISP ("x-keysym-table", Vx_keysym_table,
diff --git a/src/xterm.h b/src/xterm.h
index 8e1fc788bc1..01d7efc6dc8 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -38,6 +38,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <X11/CoreP.h> /* foul, but we need this to use our own
window inside a widget instead of one
that Xt creates... */
+#ifdef X_TOOLKIT_EDITRES
+#include <X11/Xmu/Editres.h>
+#endif
+
typedef Widget xt_or_gtk_widget;
#endif
@@ -471,6 +475,10 @@ struct x_display_info
#ifdef USE_XCB
xcb_connection_t *xcb_connection;
#endif
+
+#ifdef HAVE_XDBE
+ bool supports_xdbe;
+#endif
};
#ifdef HAVE_X_I18N
@@ -523,6 +531,16 @@ struct x_output
and the X window has not yet been created. */
Window window_desc;
+ /* The drawable to which we're rendering. In the single-buffered
+ base, the window itself. In the double-buffered case, the
+ window's back buffer. */
+ Drawable draw_desc;
+
+ /* Flag that indicates whether we've modified the back buffer and
+ need to publish our modifications to the front buffer at a
+ convenient time. */
+ bool need_buffer_flip;
+
/* The X window used for the bitmap icon;
or 0 if we don't have a bitmap icon. */
Window icon_desc;
@@ -733,6 +751,24 @@ enum
/* Return the X window used for displaying data in frame F. */
#define FRAME_X_WINDOW(f) ((f)->output_data.x->window_desc)
+/* Return the drawable used for rendering to frame F. */
+#define FRAME_X_RAW_DRAWABLE(f) ((f)->output_data.x->draw_desc)
+
+extern void x_mark_frame_dirty (struct frame *f);
+
+/* Return the drawable used for rendering to frame F and mark the
+ frame as needing a buffer flip later. There's no easy way to run
+ 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)))
+
+#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)
+
/* Return the outermost X window associated with the frame F. */
#ifdef USE_X_TOOLKIT
#define FRAME_OUTER_WINDOW(f) ((f)->output_data.x->widget ? \
@@ -1136,6 +1172,9 @@ extern bool x_wm_supports (struct frame *, Atom);
extern void x_wait_for_event (struct frame *, int);
extern void x_clear_under_internal_border (struct frame *f);
+extern void tear_down_x_back_buffer (struct frame *f);
+extern void initial_set_up_x_back_buffer (struct frame *f);
+
/* Defined in xselect.c. */
extern void x_handle_property_notify (const XPropertyEvent *);
diff --git a/src/xwidget.c b/src/xwidget.c
index 82449f7a215..d1f9540e11f 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -21,90 +21,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "xwidget.h"
-#include <signal.h>
-
-#include <stdio.h>
-#include <setjmp.h>
-#ifdef HAVE_X_WINDOWS
-
#include "lisp.h"
#include "blockinput.h"
-#include "syssignal.h"
-
-#include "xterm.h"
-#include <X11/cursorfont.h>
-
-#ifndef makedev
-# include <sys/types.h>
-#endif
-
-#ifdef BSD_SYSTEM
-# include <sys/ioctl.h>
-#endif
-
-#include "systime.h"
-
-#ifndef INCLUDED_FCNTL
-# include <fcntl.h>
-#endif
-#include <ctype.h>
-#include <errno.h>
-#include <setjmp.h>
-#include <sys/stat.h>
-
-#include "charset.h"
-#include "character.h"
-#include "coding.h"
-#include "ccl.h"
#include "frame.h"
-#include "dispextern.h"
-#include "fontset.h"
-#include "termhooks.h"
-#include "termopts.h"
-#include "termchar.h"
-#include "disptab.h"
-#include "buffer.h"
-#include "window.h"
#include "keyboard.h"
-#include "intervals.h"
-#include "process.h"
-#include "atimer.h"
-#include "keymap.h"
-
-
-#ifdef USE_X_TOOLKIT
-#include <X11/Shell.h>
-#endif
-#include <X11/extensions/Xcomposite.h>
-#include <X11/extensions/Xrender.h>
-#include <cairo.h>
-#ifdef HAVE_SYS_TIME_H
-#include <sys/time.h>
-#endif
-#ifdef HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-
#include "gtkutil.h"
-#include "font.h"
-#endif /* HAVE_X_WINDOWS */
-
-#include <gtk/gtk.h>
-#include <gdk/gdk.h>
-
-#include <gtk/gtkx.h>
-
-#include "emacsgtkfixed.h"
-#include <wchar.h>
-
-#include <webkit/webkitwebview.h>
-#include <webkit/webkitwebplugindatabase.h>
-#include <webkit/webkitwebplugin.h>
-#include <webkit/webkitglobals.h>
-#include <webkit/webkitwebnavigationaction.h>
-#include <webkit/webkitdownload.h>
-#include <webkit/webkitwebpolicydecision.h>
+#include <webkit2/webkit2.h>
+#include <JavaScriptCore/JavaScript.h>
static struct xwidget *
allocate_xwidget (void)
@@ -124,34 +48,19 @@ allocate_xwidget_view (void)
static struct xwidget_view *xwidget_view_lookup (struct xwidget *,
struct window *);
-static void webkit_document_load_finished_cb (WebKitWebView *, WebKitWebFrame *,
- gpointer);
-static gboolean webkit_download_cb (WebKitWebView *, WebKitDownload *, gpointer);
+static void webkit_view_load_changed_cb (WebKitWebView *,
+ WebKitLoadEvent,
+ gpointer);
+static void webkit_javascript_finished_cb (GObject *,
+ GAsyncResult *,
+ gpointer);
+static gboolean webkit_download_cb (WebKitWebContext *, WebKitDownload *, gpointer);
static gboolean
-webkit_mime_type_policy_typedecision_requested_cb (WebKitWebView *,
- WebKitWebFrame *,
- WebKitNetworkRequest *,
- gchar *,
- WebKitWebPolicyDecision *,
- gpointer);
-
-static gboolean
-webkit_new_window_policy_decision_requested_cb (WebKitWebView *,
- WebKitWebFrame *,
- WebKitNetworkRequest *,
- WebKitWebNavigationAction *,
- WebKitWebPolicyDecision *,
- gpointer);
-
-static gboolean
-webkit_navigation_policy_decision_requested_cb (WebKitWebView *,
- WebKitWebFrame *,
- WebKitNetworkRequest *,
- WebKitWebNavigationAction *,
- WebKitWebPolicyDecision *,
- gpointer);
-
+webkit_decide_policy_cb (WebKitWebView *,
+ WebKitPolicyDecision *,
+ WebKitPolicyDecisionType,
+ gpointer);
DEFUN ("make-xwidget",
@@ -194,25 +103,9 @@ Returns the newly constructed xwidget, or nil if construction fails. */)
gtk_window_resize (GTK_WINDOW (xw->widgetwindow_osr), xw->width,
xw->height);
- /* WebKit OSR is the only scrolled component at the moment. */
- xw->widgetscrolledwindow_osr = NULL;
-
if (EQ (xw->type, Qwebkit))
{
- xw->widgetscrolledwindow_osr = gtk_scrolled_window_new (NULL, NULL);
- gtk_scrolled_window_set_min_content_height
- (GTK_SCROLLED_WINDOW (xw->widgetscrolledwindow_osr),
- xw->height);
- gtk_scrolled_window_set_min_content_width
- (GTK_SCROLLED_WINDOW (xw->widgetscrolledwindow_osr),
- xw->width);
- gtk_scrolled_window_set_policy
- (GTK_SCROLLED_WINDOW (xw->widgetscrolledwindow_osr),
- GTK_POLICY_ALWAYS, GTK_POLICY_ALWAYS);
-
xw->widget_osr = webkit_web_view_new ();
- gtk_container_add (GTK_CONTAINER (xw->widgetscrolledwindow_osr),
- GTK_WIDGET (WEBKIT_WEB_VIEW (xw->widget_osr)));
}
gtk_widget_set_size_request (GTK_WIDGET (xw->widget_osr), xw->width,
@@ -221,7 +114,7 @@ Returns the newly constructed xwidget, or nil if construction fails. */)
if (EQ (xw->type, Qwebkit))
{
gtk_container_add (GTK_CONTAINER (xw->widgetwindow_osr),
- xw->widgetscrolledwindow_osr);
+ GTK_WIDGET (WEBKIT_WEB_VIEW (xw->widget_osr)));
}
else
{
@@ -231,7 +124,6 @@ Returns the newly constructed xwidget, or nil if construction fails. */)
gtk_widget_show (xw->widget_osr);
gtk_widget_show (xw->widgetwindow_osr);
- gtk_widget_show (xw->widgetscrolledwindow_osr);
/* Store some xwidget data in the gtk widgets for convenient
retrieval in the event handlers. */
@@ -242,29 +134,17 @@ Returns the newly constructed xwidget, or nil if construction fails. */)
if (EQ (xw->type, Qwebkit))
{
g_signal_connect (G_OBJECT (xw->widget_osr),
- "document-load-finished",
- G_CALLBACK (webkit_document_load_finished_cb), xw);
+ "load-changed",
+ G_CALLBACK (webkit_view_load_changed_cb), xw);
- g_signal_connect (G_OBJECT (xw->widget_osr),
- "download-requested",
+ g_signal_connect (G_OBJECT (webkit_web_context_get_default ()),
+ "download-started",
G_CALLBACK (webkit_download_cb), xw);
g_signal_connect (G_OBJECT (xw->widget_osr),
- "mime-type-policy-decision-requested",
- G_CALLBACK
- (webkit_mime_type_policy_typedecision_requested_cb),
- xw);
-
- g_signal_connect (G_OBJECT (xw->widget_osr),
- "new-window-policy-decision-requested",
- G_CALLBACK
- (webkit_new_window_policy_decision_requested_cb),
- xw);
-
- g_signal_connect (G_OBJECT (xw->widget_osr),
- "navigation-policy-decision-requested",
+ "decide-policy",
G_CALLBACK
- (webkit_navigation_policy_decision_requested_cb),
+ (webkit_decide_policy_cb),
xw);
}
@@ -358,81 +238,221 @@ store_xwidget_event_string (struct xwidget *xw, const char *eventname,
kbd_buffer_store_event (&event);
}
-/* TODO deprecated, use load-status. */
+static void
+store_xwidget_js_callback_event (struct xwidget *xw,
+ Lisp_Object proc,
+ Lisp_Object argument)
+{
+ struct input_event event;
+ Lisp_Object xwl;
+ XSETXWIDGET (xwl, xw);
+ EVENT_INIT (event);
+ event.kind = XWIDGET_EVENT;
+ event.frame_or_window = Qnil;
+ event.arg = list4 (intern ("javascript-callback"), xwl, proc, argument);
+ kbd_buffer_store_event (&event);
+}
+
+
void
-webkit_document_load_finished_cb (WebKitWebView *webkitwebview,
- WebKitWebFrame *arg1,
- gpointer data)
+webkit_view_load_changed_cb (WebKitWebView *webkitwebview,
+ WebKitLoadEvent load_event,
+ gpointer data)
{
- struct xwidget *xw = g_object_get_data (G_OBJECT (webkitwebview),
- XG_XWIDGET);
+ switch (load_event) {
+ case WEBKIT_LOAD_FINISHED:
+ {
+ struct xwidget *xw = g_object_get_data (G_OBJECT (webkitwebview),
+ XG_XWIDGET);
+ store_xwidget_event_string (xw, "load-changed", "");
+ break;
+ }
+ default:
+ break;
+ }
+}
+
+/* Recursively convert a JavaScript value to a Lisp value. */
+static Lisp_Object
+webkit_js_to_lisp (JSContextRef context, JSValueRef value)
+{
+ switch (JSValueGetType (context, value))
+ {
+ case kJSTypeString:
+ {
+ JSStringRef js_str_value;
+ gchar *str_value;
+ gsize str_length;
+
+ js_str_value = JSValueToStringCopy (context, value, NULL);
+ str_length = JSStringGetMaximumUTF8CStringSize (js_str_value);
+ str_value = (gchar *)g_malloc (str_length);
+ JSStringGetUTF8CString (js_str_value, str_value, str_length);
+ JSStringRelease (js_str_value);
+ return build_string (str_value);
+ }
+ case kJSTypeBoolean:
+ return (JSValueToBoolean (context, value)) ? Qt : Qnil;
+ case kJSTypeNumber:
+ return make_number (JSValueToNumber (context, value, NULL));
+ case kJSTypeObject:
+ {
+ if (JSValueIsArray (context, value))
+ {
+ JSStringRef pname = JSStringCreateWithUTF8CString("length");
+ JSValueRef len = JSObjectGetProperty (context, (JSObjectRef) value, pname, NULL);
+ int n = JSValueToNumber (context, len, NULL);
+ JSStringRelease(pname);
+
+ Lisp_Object obj;
+ struct Lisp_Vector *p = allocate_vector (n);
+
+ for (int i = 0; i < n; ++i)
+ {
+ p->contents[i] =
+ webkit_js_to_lisp (context,
+ JSObjectGetPropertyAtIndex (context,
+ (JSObjectRef) value,
+ i, NULL));
+ }
+ XSETVECTOR (obj, p);
+ return obj;
+ }
+ else
+ {
+ JSPropertyNameArrayRef properties =
+ JSObjectCopyPropertyNames (context, (JSObjectRef) value);
+
+ int n = JSPropertyNameArrayGetCount (properties);
+ Lisp_Object obj;
+
+ /* TODO: can we use a regular list here? */
+ struct Lisp_Vector *p = allocate_vector (n);
+
+ for (int i = 0; i < n; ++i)
+ {
+ JSStringRef name = JSPropertyNameArrayGetNameAtIndex (properties, i);
+ JSValueRef property = JSObjectGetProperty (context,
+ (JSObjectRef) value,
+ name, NULL);
+ gchar *str_name;
+ gsize str_length;
+ str_length = JSStringGetMaximumUTF8CStringSize (name);
+ str_name = (gchar *)g_malloc (str_length);
+ JSStringGetUTF8CString (name, str_name, str_length);
+ JSStringRelease (name);
+
+ p->contents[i] =
+ Fcons (build_string (str_name),
+ webkit_js_to_lisp (context, property));
+ }
+
+ JSPropertyNameArrayRelease (properties);
+ XSETVECTOR (obj, p);
+ return obj;
+ }
+ }
+ case kJSTypeUndefined:
+ case kJSTypeNull:
+ default:
+ return Qnil;
+ }
+}
+
+static void
+webkit_javascript_finished_cb (GObject *webview,
+ GAsyncResult *result,
+ gpointer lisp_callback)
+{
+ WebKitJavascriptResult *js_result;
+ JSValueRef value;
+ JSGlobalContextRef context;
+ GError *error = NULL;
+ struct xwidget *xw = g_object_get_data (G_OBJECT (webview),
+ XG_XWIDGET);
- store_xwidget_event_string (xw, "document-load-finished", "");
+ js_result = webkit_web_view_run_javascript_finish
+ (WEBKIT_WEB_VIEW (webview), result, &error);
+
+ if (!js_result)
+ {
+ g_warning ("Error running javascript: %s", error->message);
+ g_error_free (error);
+ return;
+ }
+
+ context = webkit_javascript_result_get_global_context (js_result);
+ value = webkit_javascript_result_get_value (js_result);
+ Lisp_Object lisp_value = webkit_js_to_lisp (context, value);
+ webkit_javascript_result_unref (js_result);
+
+ /* Register an xwidget event here, which then runs the callback.
+ This ensures that the callback runs in sync with the Emacs
+ event loop. */
+ store_xwidget_js_callback_event (xw, (Lisp_Object)lisp_callback,
+ lisp_value);
}
+
gboolean
-webkit_download_cb (WebKitWebView *webkitwebview,
+webkit_download_cb (WebKitWebContext *webkitwebcontext,
WebKitDownload *arg1,
gpointer data)
{
- struct xwidget *xw = g_object_get_data (G_OBJECT (webkitwebview),
+ WebKitWebView *view = webkit_download_get_web_view(arg1);
+ WebKitURIRequest *request = webkit_download_get_request(arg1);
+ struct xwidget *xw = g_object_get_data (G_OBJECT (view),
XG_XWIDGET);
- store_xwidget_event_string (xw, "download-requested",
- webkit_download_get_uri (arg1));
+
+ store_xwidget_event_string (xw, "download-started",
+ webkit_uri_request_get_uri(request));
return FALSE;
}
static gboolean
-webkit_mime_type_policy_typedecision_requested_cb (WebKitWebView *webView,
- WebKitWebFrame *frame,
- WebKitNetworkRequest *request,
- gchar *mimetype,
- WebKitWebPolicyDecision *policy_decision,
- gpointer user_data)
+webkit_decide_policy_cb (WebKitWebView *webView,
+ WebKitPolicyDecision *decision,
+ WebKitPolicyDecisionType type,
+ gpointer user_data)
{
- /* This function makes webkit send a download signal for all unknown
- mime types. TODO: Defer the decision to Lisp, so that it's
- possible to make Emacs handle mime text for instance. */
- if (!webkit_web_view_can_show_mime_type (webView, mimetype))
+ switch (type) {
+ case WEBKIT_POLICY_DECISION_TYPE_RESPONSE:
+ /* This function makes webkit send a download signal for all unknown
+ mime types. TODO: Defer the decision to Lisp, so that it's
+ possible to make Emacs handle mime text for instance. */
{
- webkit_web_policy_decision_download (policy_decision);
- return TRUE;
+ WebKitResponsePolicyDecision *response =
+ WEBKIT_RESPONSE_POLICY_DECISION (decision);
+ if (!webkit_response_policy_decision_is_mime_type_supported (response))
+ {
+ webkit_policy_decision_download (decision);
+ return TRUE;
+ }
+ else
+ return FALSE;
+ break;
}
- else
+ case WEBKIT_POLICY_DECISION_TYPE_NEW_WINDOW_ACTION:
+ case WEBKIT_POLICY_DECISION_TYPE_NAVIGATION_ACTION:
+ {
+ WebKitNavigationPolicyDecision *navigation_decision =
+ WEBKIT_NAVIGATION_POLICY_DECISION (decision);
+ WebKitNavigationAction *navigation_action =
+ webkit_navigation_policy_decision_get_navigation_action (navigation_decision);
+ WebKitURIRequest *request =
+ webkit_navigation_action_get_request (navigation_action);
+
+ struct xwidget *xw = g_object_get_data (G_OBJECT (webView), XG_XWIDGET);
+ store_xwidget_event_string (xw, "decide-policy",
+ webkit_uri_request_get_uri (request));
+ return FALSE;
+ break;
+ }
+ default:
return FALSE;
+ }
}
-static gboolean
-webkit_new_window_policy_decision_requested_cb (WebKitWebView *webView,
- WebKitWebFrame *frame,
- WebKitNetworkRequest *request,
- WebKitWebNavigationAction *navigation_action,
- WebKitWebPolicyDecision *policy_decision,
- gpointer user_data)
-{
- struct xwidget *xw = g_object_get_data (G_OBJECT (webView), XG_XWIDGET);
- webkit_web_navigation_action_get_original_uri (navigation_action);
-
- store_xwidget_event_string (xw, "new-window-policy-decision-requested",
- webkit_web_navigation_action_get_original_uri
- (navigation_action));
- return FALSE;
-}
-
-static gboolean
-webkit_navigation_policy_decision_requested_cb (WebKitWebView *webView,
- WebKitWebFrame *frame,
- WebKitNetworkRequest *request,
- WebKitWebNavigationAction *navigation_action,
- WebKitWebPolicyDecision *policy_decision,
- gpointer user_data)
-{
- struct xwidget *xw = g_object_get_data (G_OBJECT (webView), XG_XWIDGET);
- store_xwidget_event_string (xw, "navigation-policy-decision-requested",
- webkit_web_navigation_action_get_original_uri
- (navigation_action));
- return FALSE;
-}
/* For gtk3 offscreen rendered widgets. */
static gboolean
@@ -445,10 +465,7 @@ xwidget_osr_draw_cb (GtkWidget *widget, cairo_t *cr, gpointer data)
cairo_rectangle (cr, 0, 0, xv->clip_right, xv->clip_bottom);
cairo_clip (cr);
- if (xw->widgetscrolledwindow_osr != NULL)
- gtk_widget_draw (xw->widgetscrolledwindow_osr, cr);
- else
- gtk_widget_draw (xw->widget_osr, cr);
+ gtk_widget_draw (xw->widget_osr, cr);
return FALSE;
}
@@ -565,12 +582,16 @@ x_draw_xwidget_glyph_string (struct glyph_string *s)
xwidget on screen. Moving and clipping is done here. Also view
initialization. */
struct xwidget *xww = s->xwidget;
- struct xwidget_view *xv = xwidget_view_lookup (xww, s->w);
+ struct xwidget_view *xv;
int clip_right;
int clip_bottom;
int clip_top;
int clip_left;
+ /* FIXME: The result of this call is discarded.
+ What if the lookup fails? */
+ xwidget_view_lookup (xww, s->w);
+
int x = s->x;
int y = s->y + (s->height / 2) - (xww->height / 2);
@@ -660,39 +681,51 @@ DEFUN ("xwidget-webkit-goto-uri",
return Qnil;
}
-
-DEFUN ("xwidget-webkit-execute-script",
- Fxwidget_webkit_execute_script, Sxwidget_webkit_execute_script,
+DEFUN ("xwidget-webkit-zoom",
+ Fxwidget_webkit_zoom, Sxwidget_webkit_zoom,
2, 2, 0,
- doc: /* Make the Webkit XWIDGET execute JavaScript SCRIPT. */)
- (Lisp_Object xwidget, Lisp_Object script)
+ doc: /* Change the zoom factor of the xwidget webkit instance
+referenced by XWIDGET. */)
+ (Lisp_Object xwidget, Lisp_Object factor)
{
WEBKIT_FN_INIT ();
- CHECK_STRING (script);
- webkit_web_view_execute_script (WEBKIT_WEB_VIEW (xw->widget_osr),
- SSDATA (script));
+ if (FLOATP (factor))
+ {
+ double zoom_change = XFLOAT_DATA (factor);
+ webkit_web_view_set_zoom_level
+ (WEBKIT_WEB_VIEW (xw->widget_osr),
+ webkit_web_view_get_zoom_level
+ (WEBKIT_WEB_VIEW (xw->widget_osr)) + zoom_change);
+ }
return Qnil;
}
-DEFUN ("xwidget-webkit-get-title",
- Fxwidget_webkit_get_title, Sxwidget_webkit_get_title,
- 1, 1, 0,
- doc: /* Return the title from the Webkit instance in XWIDGET.
-This can be used to work around the lack of a return value from the
-exec method. */ )
- (Lisp_Object xwidget)
+
+DEFUN ("xwidget-webkit-execute-script",
+ Fxwidget_webkit_execute_script, Sxwidget_webkit_execute_script,
+ 2, 3, 0,
+ doc: /* Make the Webkit XWIDGET execute JavaScript SCRIPT. If
+FUN is provided, feed the JavaScript return value to the single
+argument procedure FUN.*/)
+ (Lisp_Object xwidget, Lisp_Object script, Lisp_Object fun)
{
- /* TODO support multibyte strings. */
WEBKIT_FN_INIT ();
- const gchar *str =
- webkit_web_view_get_title (WEBKIT_WEB_VIEW (xw->widget_osr));
- if (str == 0)
- {
- /* TODO maybe return Qnil instead. I suppose webkit returns
- null pointer when doc is not properly loaded or something. */
- return build_string ("");
- }
- return build_string (str);
+ CHECK_STRING (script);
+ if (!NILP (fun) && (!FUNCTIONP (fun)))
+ wrong_type_argument (Qinvalid_function, fun);
+
+ void *callback = (FUNCTIONP (fun)) ?
+ &webkit_javascript_finished_cb : NULL;
+
+ /* JavaScript execution happens asynchronously. If an elisp
+ callback function is provided we pass it to the C callback
+ procedure that retrieves the return value. */
+ webkit_web_view_run_javascript (WEBKIT_WEB_VIEW (xw->widget_osr),
+ SSDATA (script),
+ NULL, /* cancelable */
+ callback,
+ (gpointer) fun);
+ return Qnil;
}
DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0,
@@ -712,21 +745,11 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0,
/* If there is an offscreen widget resize it first. */
if (xw->widget_osr)
{
- /* Use minimum size. */
- gtk_widget_set_size_request (GTK_WIDGET (xw->widget_osr),
- xw->width, xw->height);
-
gtk_window_resize (GTK_WINDOW (xw->widgetwindow_osr), xw->width,
xw->height);
- gtk_scrolled_window_set_min_content_height
- (GTK_SCROLLED_WINDOW (xw->widgetscrolledwindow_osr),
- xw->height);
- gtk_scrolled_window_set_min_content_width
- (GTK_SCROLLED_WINDOW (xw->widgetscrolledwindow_osr),
- xw->width);
-
gtk_container_resize_children (GTK_CONTAINER (xw->widgetwindow_osr));
-
+ gtk_widget_set_size_request (GTK_WIDGET (xw->widget_osr), xw->width,
+ xw->height);
}
for (Lisp_Object tail = Vxwidget_view_list; CONSP (tail); tail = XCDR (tail))
@@ -745,30 +768,6 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0,
-DEFUN ("xwidget-set-adjustment",
- Fxwidget_set_adjustment, Sxwidget_set_adjustment, 4, 4, 0,
- doc: /* Set native scrolling for XWIDGET.
-AXIS can be `vertical' or `horizontal'.
-If RELATIVE is t, scroll relative, otherwise absolutely.
-VALUE is the amount to scroll, either relatively or absolutely. */)
- (Lisp_Object xwidget, Lisp_Object axis, Lisp_Object relative,
- Lisp_Object value)
-{
- CHECK_XWIDGET (xwidget);
- CHECK_NUMBER (value);
- struct xwidget *xw = XXWIDGET (xwidget);
- GtkAdjustment *adjustment
- = ((EQ (Qhorizontal, axis)
- ? gtk_scrolled_window_get_hadjustment
- : gtk_scrolled_window_get_vadjustment)
- (GTK_SCROLLED_WINDOW (xw->widgetscrolledwindow_osr)));
- double final_value = XINT (value);
- if (EQ (Qt, relative))
- final_value += gtk_adjustment_get_value (adjustment);
- gtk_adjustment_set_value (adjustment, final_value);
- return Qnil;
-}
-
DEFUN ("xwidget-size-request",
Fxwidget_size_request, Sxwidget_size_request,
@@ -973,8 +972,8 @@ syms_of_xwidget (void)
defsubr (&Sset_xwidget_query_on_exit_flag);
defsubr (&Sxwidget_webkit_goto_uri);
+ defsubr (&Sxwidget_webkit_zoom);
defsubr (&Sxwidget_webkit_execute_script);
- defsubr (&Sxwidget_webkit_get_title);
DEFSYM (Qwebkit, "webkit");
defsubr (&Sxwidget_size_request);
@@ -984,8 +983,6 @@ syms_of_xwidget (void)
defsubr (&Sxwidget_buffer);
defsubr (&Sset_xwidget_plist);
- defsubr (&Sxwidget_set_adjustment);
-
DEFSYM (Qxwidget, "xwidget");
DEFSYM (QCxwidget, ":xwidget");
@@ -1145,7 +1142,13 @@ xwidget_end_redisplay (struct window *w, struct glyph_matrix *matrix)
{
/* The only call to xwidget_end_redisplay is in dispnew.
xwidget_end_redisplay (w->current_matrix); */
- xwidget_touch (xwidget_view_lookup (glyph->u.xwidget, w));
+ struct xwidget_view *xv
+ = xwidget_view_lookup (glyph->u.xwidget, w);
+ /* FIXME: Is it safe to assume xwidget_view_lookup
+ always succeeds here? If so, this comment can be removed.
+ If not, the code probably needs fixing. */
+ eassume (xv);
+ xwidget_touch (xv);
}
}
}
diff --git a/src/xwidget.h b/src/xwidget.h
index 8fc382188f4..4447abbe38b 100644
--- a/src/xwidget.h
+++ b/src/xwidget.h
@@ -56,9 +56,6 @@ struct xwidget
GtkWidget *widget_osr;
GtkWidget *widgetwindow_osr;
- /* Used if the widget (webkit) is to be wrapped in a scrolled window. */
- GtkWidget *widgetscrolledwindow_osr;
-
/* Kill silently if Emacs is exited. */
bool_bf kill_without_query : 1;
};