summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGlenn Morris <rgm@gnu.org>2018-07-02 19:19:26 -0700
committerGlenn Morris <rgm@gnu.org>2018-07-02 19:19:26 -0700
commit02f2f336af7c4129ec79ab00881bba3e14ff9820 (patch)
tree3f279977bb231ea6ddab8680999bc1bffcb31071 /src
parentbc0e36df8d33595d6411ec4c18e3f4b643c01306 (diff)
parentfc5cae731cede7e00f3f2d40d6577537f872d439 (diff)
downloademacs-02f2f336af7c4129ec79ab00881bba3e14ff9820.tar.gz
Merge from origin/emacs-26
fc5cae7 ; Fix ChangeLog typo. e17a5e5 ; make change-history-commit f205928 * etc/HISTORY: Cite Brinkoff on early history. 4e58ca8 Document internal use of 'above-suspended' z-group frame para... 4bd43b0 Increase max-lisp-eval-depth adjustment while in debugger (bu... ab98352 Improve on last change in replace-buffer-contents 2f149c0 Fix a factual error in Introduction to Emacs Lisp 8ad50a3 ; * lisp/files.el (buffer-offer-save): Doc fix. (Bug#32000) c80f31f Minor improvements in documentation of imenu.el 8ebb683 Avoid errors with recentering in 'skeleton-insert' e980a3c * src/lisp.h: Omit obsolete comment re bytecode stack. eec71eb Speed up replace-buffer-contents 93c41ce Remove extra process call from vc-git-find-file-hook 7ea0873 ; Update some commentary 4a7f423 Speed up vc-git-dir-status-files 9134c84 Avoid compiler warning using coding.h Conflicts: src/editfns.c
Diffstat (limited to 'src')
-rw-r--r--src/coding.h4
-rw-r--r--src/editfns.c99
-rw-r--r--src/eval.c8
-rw-r--r--src/lisp.h18
-rw-r--r--src/w32fns.c22
-rw-r--r--src/xterm.c4
6 files changed, 116 insertions, 39 deletions
diff --git a/src/coding.h b/src/coding.h
index 165c1b29b71..d2cf4d8a7ba 100644
--- a/src/coding.h
+++ b/src/coding.h
@@ -28,6 +28,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "lisp.h"
+INLINE_HEADER_BEGIN
+
/* Index to arguments of Fdefine_coding_system_internal. */
enum define_coding_system_arg_index
@@ -771,4 +773,6 @@ extern struct coding_system safe_terminal_coding;
extern char emacs_mule_bytes[256];
+INLINE_HEADER_END
+
#endif /* EMACS_CODING_H */
diff --git a/src/editfns.c b/src/editfns.c
index efe83e811ba..e16a554de20 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -3127,6 +3127,9 @@ determines whether case is significant or ignored. */)
#undef ELEMENT
#undef EQUAL
+/* Counter used to rarely_quit in replace-buffer-contents. */
+static unsigned short rbc_quitcounter;
+
#define XVECREF_YVECREF_EQUAL(ctx, xoff, yoff) \
buffer_chars_equal ((ctx), (xoff), (yoff))
@@ -3136,6 +3139,9 @@ determines whether case is significant or ignored. */)
/* Buffers to compare. */ \
struct buffer *buffer_a; \
struct buffer *buffer_b; \
+ /* Whether each buffer is unibyte/plain-ASCII or not. */ \
+ bool a_unibyte; \
+ bool b_unibyte; \
/* Bit vectors recording for each character whether it was deleted
or inserted. */ \
unsigned char *deletions; \
@@ -3216,6 +3222,8 @@ differences between the two buffers. */)
struct context ctx = {
.buffer_a = a,
.buffer_b = b,
+ .a_unibyte = BUF_ZV (a) == BUF_ZV_BYTE (a),
+ .b_unibyte = BUF_ZV (b) == BUF_ZV_BYTE (b),
.deletions = SAFE_ALLOCA (del_bytes),
.insertions = SAFE_ALLOCA (ins_bytes),
.fdiag = buffer + size_b + 1,
@@ -3232,9 +3240,36 @@ differences between the two buffers. */)
early. */
eassert (! early_abort);
+ rbc_quitcounter = 0;
+
Fundo_boundary ();
+ bool modification_hooks_inhibited = false;
record_unwind_protect_excursion ();
+ /* We are going to make a lot of small modifications, and having the
+ modification hooks called for each of them will slow us down.
+ Instead, we announce a single modification for the entire
+ modified region. But don't do that if the caller inhibited
+ modification hooks, because then they don't want that. */
+ ptrdiff_t from, to;
+ if (!inhibit_modification_hooks)
+ {
+ ptrdiff_t k, l;
+
+ /* Find the first character position to be changed. */
+ for (k = 0; k < size_a && !bit_is_set (ctx.deletions, k); k++)
+ ;
+ from = BEGV + k;
+
+ /* Find the last character position to be changed. */
+ for (l = size_a; l > 0 && !bit_is_set (ctx.deletions, l - 1); l--)
+ ;
+ to = BEGV + l;
+ prepare_to_modify_buffer (from, to, NULL);
+ specbind (Qinhibit_modification_hooks, Qt);
+ modification_hooks_inhibited = true;
+ }
+
ptrdiff_t i = size_a;
ptrdiff_t j = size_b;
/* Walk backwards through the lists of changes. This was also
@@ -3243,15 +3278,13 @@ differences between the two buffers. */)
while (i >= 0 || j >= 0)
{
/* Allow the user to quit if this gets too slow. */
- maybe_quit ();
+ rarely_quit (++rbc_quitcounter);
/* Check whether there is a change (insertion or deletion)
before the current position. */
if ((i > 0 && bit_is_set (ctx.deletions, i - 1)) ||
(j > 0 && bit_is_set (ctx.insertions, j - 1)))
{
- maybe_quit ();
-
ptrdiff_t end_a = min_a + i;
ptrdiff_t end_b = min_b + j;
/* Find the beginning of the current change run. */
@@ -3259,14 +3292,13 @@ differences between the two buffers. */)
--i;
while (j > 0 && bit_is_set (ctx.insertions, j - 1))
--j;
+
+ rarely_quit (rbc_quitcounter++);
+
ptrdiff_t beg_a = min_a + i;
ptrdiff_t beg_b = min_b + j;
- eassert (beg_a >= BEGV);
- eassert (beg_b >= BUF_BEGV (b));
eassert (beg_a <= end_a);
eassert (beg_b <= end_b);
- eassert (end_a <= ZV);
- eassert (end_b <= BUF_ZV (b));
eassert (beg_a < end_a || beg_b < end_b);
if (beg_a < end_a)
del_range (beg_a, end_a);
@@ -3280,8 +3312,17 @@ differences between the two buffers. */)
--i;
--j;
}
+ SAFE_FREE_UNBIND_TO (count, Qnil);
+ rbc_quitcounter = 0;
- return SAFE_FREE_UNBIND_TO (count, Qnil);
+ if (modification_hooks_inhibited)
+ {
+ ptrdiff_t updated_to = to + ZV - BEGV - size_a;
+ signal_after_change (from, to - from, updated_to - from);
+ update_compositions (from, updated_to, CHECK_INSIDE);
+ }
+
+ return Qnil;
}
static void
@@ -3307,39 +3348,45 @@ bit_is_set (const unsigned char *a, ptrdiff_t i)
/* Return true if the characters at position POS_A of buffer
CTX->buffer_a and at position POS_B of buffer CTX->buffer_b are
equal. POS_A and POS_B are zero-based. Text properties are
- ignored. */
+ ignored.
+
+ Implementation note: this function is called inside the inner-most
+ loops of compareseq, so it absolutely must be optimized for speed,
+ every last bit of it. E.g., each additional use of BEGV or such
+ likes will slow down replace-buffer-contents by dozens of percents,
+ because builtin_lisp_symbol will be called one more time in the
+ innermost loop. */
static bool
buffer_chars_equal (struct context *ctx,
ptrdiff_t pos_a, ptrdiff_t pos_b)
{
- eassert (pos_a >= 0);
pos_a += BUF_BEGV (ctx->buffer_a);
- eassert (pos_a >= BUF_BEGV (ctx->buffer_a));
- eassert (pos_a < BUF_ZV (ctx->buffer_a));
-
- eassert (pos_b >= 0);
pos_b += BUF_BEGV (ctx->buffer_b);
- eassert (pos_b >= BUF_BEGV (ctx->buffer_b));
- eassert (pos_b < BUF_ZV (ctx->buffer_b));
-
- bool a_unibyte = BUF_ZV (ctx->buffer_a) == BUF_ZV_BYTE (ctx->buffer_a);
- bool b_unibyte = BUF_ZV (ctx->buffer_b) == BUF_ZV_BYTE (ctx->buffer_b);
/* Allow the user to escape out of a slow compareseq call. */
- maybe_quit ();
+ rarely_quit (++rbc_quitcounter);
ptrdiff_t bpos_a =
- a_unibyte ? pos_a : buf_charpos_to_bytepos (ctx->buffer_a, pos_a);
+ ctx->a_unibyte ? pos_a : buf_charpos_to_bytepos (ctx->buffer_a, pos_a);
ptrdiff_t bpos_b =
- b_unibyte ? pos_b : buf_charpos_to_bytepos (ctx->buffer_b, pos_b);
+ ctx->b_unibyte ? pos_b : buf_charpos_to_bytepos (ctx->buffer_b, pos_b);
- if (a_unibyte && b_unibyte)
+ /* We make the below a series of specific test to avoid using
+ BUF_FETCH_CHAR_AS_MULTIBYTE, which references Lisp symbols, and
+ is therefore significantly slower (see the note in the commentary
+ to this function). */
+ if (ctx->a_unibyte && ctx->b_unibyte)
return BUF_FETCH_BYTE (ctx->buffer_a, bpos_a)
== BUF_FETCH_BYTE (ctx->buffer_b, bpos_b);
-
- return BUF_FETCH_CHAR_AS_MULTIBYTE (ctx->buffer_a, bpos_a)
- == BUF_FETCH_CHAR_AS_MULTIBYTE (ctx->buffer_b, bpos_b);
+ if (ctx->a_unibyte && !ctx->b_unibyte)
+ return UNIBYTE_TO_CHAR (BUF_FETCH_BYTE (ctx->buffer_a, bpos_a))
+ == BUF_FETCH_MULTIBYTE_CHAR (ctx->buffer_b, bpos_b);
+ if (!ctx->a_unibyte && ctx->b_unibyte)
+ return BUF_FETCH_MULTIBYTE_CHAR (ctx->buffer_a, bpos_a)
+ == UNIBYTE_TO_CHAR (BUF_FETCH_BYTE (ctx->buffer_b, bpos_b));
+ return BUF_FETCH_MULTIBYTE_CHAR (ctx->buffer_a, bpos_a)
+ == BUF_FETCH_MULTIBYTE_CHAR (ctx->buffer_b, bpos_b);
}
diff --git a/src/eval.c b/src/eval.c
index c16a267bc5e..256ca8ffdc8 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -282,8 +282,12 @@ call_debugger (Lisp_Object arg)
/* Do not allow max_specpdl_size less than actual depth (Bug#16603). */
EMACS_INT old_max = max (max_specpdl_size, count);
- if (lisp_eval_depth + 40 > max_lisp_eval_depth)
- max_lisp_eval_depth = lisp_eval_depth + 40;
+ /* The previous value of 40 is too small now that the debugger
+ prints using cl-prin1 instead of prin1. Printing lists nested 8
+ deep (which is the value of print-level used in the debugger)
+ currently requires 77 additional frames. See bug#31919. */
+ if (lisp_eval_depth + 100 > max_lisp_eval_depth)
+ max_lisp_eval_depth = lisp_eval_depth + 100;
/* While debugging Bug#16603, previous value of 100 was found
too small to avoid specpdl overflow in the debugger itself. */
diff --git a/src/lisp.h b/src/lisp.h
index 6203a746a30..731a45da11a 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3012,15 +3012,13 @@ extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int);
} while (false)
-/* Elisp uses several stacks:
- - the C stack.
- - the bytecode stack: used internally by the bytecode interpreter.
- Allocated from the C stack.
- - The specpdl stack: keeps track of active unwind-protect and
- dynamic-let-bindings. Allocated from the `specpdl' array, a manually
- managed stack.
- - The handler stack: keeps track of active catch tags and condition-case
- handlers. Allocated in a manually managed stack implemented by a
+/* Elisp uses multiple stacks:
+ - The C stack.
+ - The specpdl stack keeps track of backtraces, unwind-protects and
+ dynamic let-bindings. It is allocated from the 'specpdl' array,
+ a manually managed stack.
+ - The handler stack keeps track of active catch tags and condition-case
+ handlers. It is allocated in a manually managed stack implemented by a
doubly-linked list allocated via xmalloc and never freed. */
/* Structure for recording Lisp call stack for backtrace purposes. */
@@ -3113,7 +3111,7 @@ SPECPDL_INDEX (void)
control structures. A struct handler contains all the information needed to
restore the state of the interpreter after a non-local jump.
- handler structures are chained together in a doubly linked list; the `next'
+ Handler structures are chained together in a doubly linked list; the `next'
member points to the next outer catchtag and the `nextfree' member points in
the other direction to the next inner element (which is typically the next
free element since we mostly use it on the deepest handler).
diff --git a/src/w32fns.c b/src/w32fns.c
index 3bd320928dd..7f7e1a404ce 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -2192,6 +2192,11 @@ x_set_no_accept_focus (struct frame *f, Lisp_Object new_value, Lisp_Object old_v
*
* Some window managers may not honor this parameter. The value `below'
* is not supported on Windows.
+ *
+ * Internally, this function also handles a value 'above-suspended'.
+ * That value is used to temporarily remove F from the 'above' group
+ * to make sure that it does not obscure the window of a dialog in
+ * progress.
*/
static void
x_set_z_group (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
@@ -7583,12 +7588,27 @@ file_dialog_callback (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
return 0;
}
+/**
+ * w32_dialog_in_progress:
+ *
+ * This function is called by Fx_file_dialog and Fx_select_font and
+ * serves to temporarily remove any Emacs frame currently in the
+ * 'above' z-group from that group to assure that such a frame does
+ * not hide the dialog window. Frames that are temporarily removed
+ * from the 'above' group have their z_group bit-field set to
+ * z_group_above_suspended. Any such frame is moved back to the
+ * 'above' group as soon as the dialog finishes and has its z_group
+ * bit-field reset to z_group_above.
+ *
+ * This function does not affect the z-order or the z-group state of
+ * the dialog window itself.
+ */
void
w32_dialog_in_progress (Lisp_Object in_progress)
{
Lisp_Object frames, frame;
- /* Don't let frames in `above' z-group obscure popups. */
+ /* Don't let frames in `above' z-group obscure dialog windows. */
FOR_EACH_FRAME (frames, frame)
{
struct frame *f = XFRAME (frame);
diff --git a/src/xterm.c b/src/xterm.c
index 9504bfb1834..af28dab860a 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -10566,6 +10566,10 @@ x_set_skip_taskbar (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu
* windows that do not have the `below' property set.
*
* Some window managers may not honor this parameter.
+ *
+ * Internally, this function also handles a value 'above-suspended'.
+ * That value is used to temporarily remove F from the 'above' group
+ * to make sure that it does not obscure a menu currently popped up.
*/
void
x_set_z_group (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)