(Freplace_buffer_contents): Preserve markers more carefully

Use `replace_range` rather than `delete+insert`.

* src/insdel.c (replace_range): Allow NEW to specify a chunk
of buffer text.
* src/editfns.c (Freplace_buffer_contents): Use it.
* test/src/editfns-tests.el (replace-buffer-contents-1): Remove
incorrect check which happened to succeed because point was not
preserved carefully enough.  Make the replacement text share a bit
more content to make the test a bit more strict.
(editfns-tests--replace-region): Doesn't fail any more.
This commit is contained in:
Stefan Monnier 2025-03-11 17:10:30 -04:00
parent e1ceee716d
commit 40d8650d51
3 changed files with 82 additions and 29 deletions

View file

@ -2050,9 +2050,10 @@ nil. */)
if (early_abort) if (early_abort)
{ {
/* FIXME: Use 'replace_range'! */ Lisp_Object src = CALLN (Fvector, source_buffer,
del_range (min_a, ZV); make_fixnum (BUF_BEGV (b)),
Finsert_buffer_substring (source, Qnil,Qnil); make_fixnum (BUF_ZV (b)));
replace_range (BEGV, ZV, src, true, false, false);
SAFE_FREE_UNBIND_TO (count, Qnil); SAFE_FREE_UNBIND_TO (count, Qnil);
return Qnil; return Qnil;
} }
@ -2075,6 +2076,7 @@ nil. */)
ptrdiff_t i = size_a; ptrdiff_t i = size_a;
ptrdiff_t j = size_b; ptrdiff_t j = size_b;
Lisp_Object src = CALLN (Fvector, source_buffer, Qnil, Qnil);
/* Walk backwards through the lists of changes. This was also /* Walk backwards through the lists of changes. This was also
cargo-culted from src/analyze.c in GNU Diffutils. Because we cargo-culted from src/analyze.c in GNU Diffutils. Because we
walk backwards, we dont have to keep the positions in sync. */ walk backwards, we dont have to keep the positions in sync. */
@ -2101,14 +2103,9 @@ nil. */)
eassert (beg_b <= end_b); eassert (beg_b <= end_b);
eassert (beg_a < end_a || beg_b < end_b); eassert (beg_a < end_a || beg_b < end_b);
/* FIXME: Use 'replace_range'! */ /* FIXME: Use 'replace_range'! */
if (beg_a < end_a) ASET (src, 1, make_fixed_natnum (beg_b));
del_range (beg_a, end_a); ASET (src, 2, make_fixed_natnum (end_b));
if (beg_b < end_b) replace_range (beg_a, end_a, src, true, false, false);
{
SET_PT (beg_a);
Finsert_buffer_substring (source, make_fixed_natnum (beg_b),
make_fixed_natnum (end_b));
}
} }
--i; --i;
--j; --j;

View file

@ -1428,12 +1428,29 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new,
bool run_mod_hooks, bool inherit, bool run_mod_hooks, bool inherit,
bool adjust_match_data) bool adjust_match_data)
{ {
ptrdiff_t inschars = SCHARS (new); ptrdiff_t inschars;
ptrdiff_t insbytes = SBYTES (new); ptrdiff_t insbeg;
struct buffer *insbuf;
if (STRINGP (new))
{
insbuf = NULL;
insbeg = 0;
inschars = SCHARS (new);
}
else
{
CHECK_VECTOR (new);
/* Let `Faref' signal an error if it's too small. */
Lisp_Object insend = Faref (new, make_fixnum (2));
CHECK_BUFFER (AREF (new, 0));
CHECK_FIXNUM (AREF (new, 1));
CHECK_FIXNUM (insend);
insbuf = XBUFFER (AREF (new, 0));
insbeg = XFIXNUM (AREF (new, 1));
inschars = XFIXNUM (insend) - insbeg;
}
ptrdiff_t from_byte, to_byte; ptrdiff_t from_byte, to_byte;
ptrdiff_t nbytes_del, nchars_del; ptrdiff_t nbytes_del, nchars_del;
INTERVAL intervals;
ptrdiff_t outgoing_insbytes = insbytes;
Lisp_Object deletion; Lisp_Object deletion;
check_markers (); check_markers ();
@ -1459,17 +1476,51 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new,
nchars_del = to - from; nchars_del = to - from;
nbytes_del = to_byte - from_byte; nbytes_del = to_byte - from_byte;
if (nbytes_del <= 0 && insbytes == 0) if (nbytes_del <= 0 && inschars == 0)
return; return;
ptrdiff_t insbeg_bytes, insend_bytes;
ptrdiff_t insbytes;
unsigned char *insbeg_ptr;
bool new_is_multibyte;
if (!insbuf)
{
new_is_multibyte = STRING_MULTIBYTE (new);
insbytes = SBYTES (new);
insbeg_ptr = SDATA (new);
}
else
{
new_is_multibyte = !NILP (BVAR (insbuf, enable_multibyte_characters));
ptrdiff_t insend = insbeg + inschars;
if (new_is_multibyte)
{
insbeg_bytes = buf_charpos_to_bytepos (insbuf, insbeg);
insend_bytes = buf_charpos_to_bytepos (insbuf, insend);
}
else
{
insbeg_bytes = insbeg;
insend_bytes = insend;
}
insbytes = insend_bytes - insbeg_bytes;
if (insbuf->text->gpt_byte > insbeg_bytes
&& insbuf->text->gpt_byte < insend_bytes)
move_gap_both (insbeg, insbeg_bytes);
insbeg_ptr = BUF_BYTE_ADDRESS (insbuf, insbeg_bytes);
eassert (insbuf->text->gpt_byte <= insbeg_bytes
|| insbuf->text->gpt_byte >= insend_bytes);
}
ptrdiff_t outgoing_insbytes = insbytes;
/* Make OUTGOING_INSBYTES describe the text /* Make OUTGOING_INSBYTES describe the text
as it will be inserted in this buffer. */ as it will be inserted in this buffer. */
if (NILP (BVAR (current_buffer, enable_multibyte_characters))) if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
outgoing_insbytes = inschars; outgoing_insbytes = inschars;
else if (! STRING_MULTIBYTE (new)) else if (! new_is_multibyte)
outgoing_insbytes outgoing_insbytes
= count_size_as_multibyte (SDATA (new), insbytes); = count_size_as_multibyte (insbeg_ptr, insbytes);
/* Make sure the gap is somewhere in or next to what we are deleting. */ /* Make sure the gap is somewhere in or next to what we are deleting. */
if (from > GPT) if (from > GPT)
@ -1504,8 +1555,8 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new,
/* Copy the string text into the buffer, perhaps converting /* Copy the string text into the buffer, perhaps converting
between single-byte and multibyte. */ between single-byte and multibyte. */
copy_text (SDATA (new), GPT_ADDR, insbytes, copy_text (insbeg_ptr, GPT_ADDR, insbytes,
STRING_MULTIBYTE (new), new_is_multibyte,
! NILP (BVAR (current_buffer, enable_multibyte_characters))); ! NILP (BVAR (current_buffer, enable_multibyte_characters)));
#ifdef BYTE_COMBINING_DEBUG #ifdef BYTE_COMBINING_DEBUG
@ -1548,7 +1599,10 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new,
/* Get the intervals for the part of the string we are inserting-- /* Get the intervals for the part of the string we are inserting--
not including the combined-before bytes. */ not including the combined-before bytes. */
intervals = string_intervals (new); INTERVAL intervals
= (!insbuf ? string_intervals (new)
: copy_intervals (buffer_intervals (insbuf), insbeg, inschars));
/* Insert those intervals. */ /* Insert those intervals. */
graft_intervals_into_buffer (intervals, from, inschars, graft_intervals_into_buffer (intervals, from, inschars,
current_buffer, inherit); current_buffer, inherit);
@ -1571,7 +1625,7 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new,
CHARS_MODIFF = MODIFF; CHARS_MODIFF = MODIFF;
if (adjust_match_data) if (adjust_match_data)
update_search_regs (from, to, from + SCHARS (new)); update_search_regs (from, to, from + inschars);
if (run_mod_hooks) if (run_mod_hooks)
{ {

View file

@ -280,23 +280,25 @@
(ert-deftest replace-buffer-contents-1 () (ert-deftest replace-buffer-contents-1 ()
(with-temp-buffer (with-temp-buffer
(insert #("source" 2 4 (prop 7))) (insert #("source " 2 4 (prop 7)))
(let ((source (current-buffer))) (let ((source (current-buffer)))
(with-temp-buffer (with-temp-buffer
(insert "before dest after") (insert "before dest after")
(let ((marker (set-marker (make-marker) 14))) (let ((marker (set-marker (make-marker) 14)))
(save-restriction (save-restriction
(narrow-to-region 8 12) (narrow-to-region 8 13)
(replace-buffer-contents source)) (goto-char 12)
(should (looking-at " \\'"))
(replace-buffer-contents source)
(should (looking-at " \\'")))
(should (equal (marker-buffer marker) (current-buffer))) (should (equal (marker-buffer marker) (current-buffer)))
(should (equal (marker-position marker) 16))) (should (equal (marker-position marker) 16)))
(should (equal-including-properties (should (equal-including-properties
(buffer-string) (buffer-string)
#("before source after" 9 11 (prop 7)))) #("before source after" 9 11 (prop 7))))))
(should (equal (point) 9))))
(should (equal-including-properties (should (equal-including-properties
(buffer-string) (buffer-string)
#("source" 2 4 (prop 7)))))) #("source " 2 4 (prop 7))))))
(ert-deftest replace-buffer-contents-2 () (ert-deftest replace-buffer-contents-2 ()
(with-temp-buffer (with-temp-buffer
@ -332,7 +334,7 @@
(replace-buffer-contents str-buf)))))))) (replace-buffer-contents str-buf))))))))
(ert-deftest editfns-tests--replace-region () (ert-deftest editfns-tests--replace-region ()
:expected-result :failed ;; :expected-result :failed
(with-temp-buffer (with-temp-buffer
(insert "here is some text") (insert "here is some text")
(let ((m5n (copy-marker (+ (point-min) 5))) (let ((m5n (copy-marker (+ (point-min) 5)))