aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2025-03-28 00:46:53 -0400
committerStefan Monnier2025-03-29 17:49:05 -0400
commit7c82cc8b975175aebbad1c43ec1cd98b3232f482 (patch)
tree2f2f5ac19ec7055442da0bd58507314d213b9bdd
parentf60fc1287d499e8c93857b1b96e8bd2467b22c8d (diff)
downloademacs-7c82cc8b975175aebbad1c43ec1cd98b3232f482.tar.gz
emacs-7c82cc8b975175aebbad1c43ec1cd98b3232f482.zip
(replace-region-contents): Improve and promote (bug#76313)
Swap the role of `replace-region-contents` and `replace-buffer-contents`, so `replace-region-contents` is the main function, implemented in C, and `replace-buffer-contents` is a mere wrapper (marked as obsolete). Also remove the need to rely on narrowing and on describing the new text as a function. Finally, allow MAX-SECS==0 to require a cheap replacement, and add an INHERIT argument. * src/editfns.c: Include `coding.h`. (Freplace_region_contents): Rename from `Freplace_buffer_contents`. Change calling convention to that of `replace-region-contents`. Add more options for the SOURCE argument. Add INHERIT argument. Skip the costly algorithm if MAX-SECS is 0. * src/insdel.c (replace_range): Allow NEW to be a buffer. * lisp/subr.el (replace-buffer-contents): New implementation. * lisp/emacs-lisp/subr-x.el (replace-region-contents): Delete. * doc/lispref/text.texi (Replacing): Document new API for `replace-region-contents`. Remove documentation of `replace-buffer-contents`. * test/src/editfns-tests.el (replace-buffer-contents-1) (replace-buffer-contents-2, replace-buffer-contents-bug31837): Use `replace-region-contents`. (editfns--replace-region): Delete. (editfns-tests--replace-region): Use `replace-region-contents`. Adds tests for new types of SOURCE args.
-rw-r--r--doc/lispref/text.texi74
-rw-r--r--etc/NEWS7
-rw-r--r--lisp/emacs-lisp/subr-x.el29
-rw-r--r--lisp/subr.el13
-rw-r--r--src/coding.c2
-rw-r--r--src/editfns.c150
-rw-r--r--src/insdel.c12
-rw-r--r--test/src/editfns-tests.el68
8 files changed, 204 insertions, 151 deletions
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 18ed71fd1f5..954979a00e6 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -4776,30 +4776,42 @@ all markers unrelocated.
4776@node Replacing 4776@node Replacing
4777@section Replacing Buffer Text 4777@section Replacing Buffer Text
4778 4778
4779 You can use the following function to replace the text of one buffer 4779 You can use the following function to replace some the text of the
4780with the text of another buffer: 4780current buffer:
4781 4781
4782@deffn Command replace-buffer-contents source &optional max-secs max-costs 4782@defun replace-region-contents beg end source &optional max-secs max-costs inherit
4783This function replaces the accessible portion of the current buffer 4783This function replaces the region between @var{beg} and @var{end}
4784with the accessible portion of the buffer @var{source}. @var{source} 4784of the current buffer with the text found in @var{source} which
4785may either be a buffer object or the name of a buffer. When 4785is usually a string or a buffer, in which case it will use the
4786@code{replace-buffer-contents} succeeds, the text of the accessible 4786accessible portion of that buffer.
4787portion of the current buffer will be equal to the text of the
4788accessible portion of the @var{source} buffer.
4789 4787
4790This function attempts to keep point, markers, text properties, and 4788This function attempts to keep point, markers, text properties, and
4791overlays in the current buffer intact. One potential case where this 4789overlays in the current buffer intact. One potential case where this
4792behavior is useful is external code formatting programs: they 4790behavior is useful is external code formatting programs: they typically
4793typically write the reformatted text into a temporary buffer or file, 4791write the reformatted text into a temporary buffer or file, and using
4794and using @code{delete-region} and @code{insert-buffer-substring} 4792@code{insert} and @code{delete-region} would destroy these properties.
4795would destroy these properties. However, the latter combination is 4793
4796typically faster (@xref{Deletion}, and @ref{Insertion}). 4794However, in order to do that, @code{replace-region-contents} needs to
4797 4795compare the contents of the original buffer with that of @var{source},
4798For its working, @code{replace-buffer-contents} needs to compare the 4796using a costly algorithm which makes the operation much slower than
4799contents of the original buffer with that of @var{source} which is a 4797a simple @code{insert} and @code{delete-region}. In many cases, you may
4800costly operation if the buffers are huge and there is a high number of 4798not need that refinement, and you will then want to pass 0 as
4801differences between them. In order to keep 4799@var{max-secs} argument, so as to short-circuit that costly algorithm:
4802@code{replace-buffer-contents}'s runtime in bounds, it has two 4800It will then be just as fast as @code{insert} and @code{delete-region}
4801while still preserving point and markers marginally better.
4802
4803Beyond that basic usage, if you need to use as source a subset of the
4804accessible portion of a buffer, @var{source} can also be a vector
4805@code{[@var{sbuf} @var{sbeg} @var{send}]} where the region between
4806@var{sbeg} and @var{send} in buffer @var{sbuf} is the text
4807you want to use as source.
4808
4809If you need the inserted text to inherit text-properties
4810from the adjoining text, you can pass a non-@code{nil} value as
4811@var{inherit} argument.
4812
4813When you do want the costly refined replacement, in order to keep
4814@code{replace-region-contents}'s runtime in bounds, it has two
4803optional arguments. 4815optional arguments.
4804 4816
4805@var{max-secs} defines a hard boundary in terms of seconds. If given 4817@var{max-secs} defines a hard boundary in terms of seconds. If given
@@ -4810,26 +4822,14 @@ and exceeded, it will fall back to @code{delete-region} and
4810the actual costs exceed this limit, heuristics are used to provide a 4822the actual costs exceed this limit, heuristics are used to provide a
4811faster but suboptimal solution. The default value is 1000000. 4823faster but suboptimal solution. The default value is 1000000.
4812 4824
4813@code{replace-buffer-contents} returns @code{t} if a non-destructive 4825@code{replace-region-contents} returns @code{t} if a non-destructive
4814replacement could be performed. Otherwise, i.e., if @var{max-secs} 4826replacement could be performed. Otherwise, i.e., if @var{max-secs}
4815was exceeded, it returns @code{nil}. 4827was exceeded, it returns @code{nil}.
4816@end deffn
4817 4828
4818@defun replace-region-contents beg end replace-fn &optional max-secs max-costs 4829Note: When using the refined replacement algorithm, if the replacement
4819This function replaces the region between @var{beg} and @var{end} 4830is a string, it will be internally copied to a temporary buffer.
4820using the given @var{replace-fn}. The function @var{replace-fn} is 4831Therefore, all else being equal, it is preferable to pass a buffer than
4821run in the current buffer narrowed to the specified region and it 4832a string as @var{source} argument.
4822should return either a string or a buffer replacing the region.
4823
4824The replacement is performed using @code{replace-buffer-contents} (see
4825above) which also describes the @var{max-secs} and @var{max-costs}
4826arguments and the return value.
4827
4828Note: If the replacement is a string, it will be placed in a temporary
4829buffer so that @code{replace-buffer-contents} can operate on it.
4830Therefore, if you already have the replacement in a buffer, it makes
4831no sense to convert it to a string using @code{buffer-substring} or
4832similar.
4833@end defun 4833@end defun
4834 4834
4835@node Decompression 4835@node Decompression
diff --git a/etc/NEWS b/etc/NEWS
index 33a2b3fd07a..f0b84385510 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1733,6 +1733,13 @@ Previously, its argument was always evaluated using dynamic binding.
1733* Lisp Changes in Emacs 31.1 1733* Lisp Changes in Emacs 31.1
1734 1734
1735+++ 1735+++
1736** Improve 'replace-region-contents' to accept more forms of sources.
1737It has been promoted from 'subr-x' to the C code.
1738You can now directly pass it a string or a buffer rather than a function.
1739Actually passing it a function is now deprecated.
1740'replace-buffer-contents' is also marked as obsolete.
1741
1742+++
1736** New macros 'static-when' and 'static-unless'. 1743** New macros 'static-when' and 'static-unless'.
1737Like 'static-if', these macros evaluate their condition at 1744Like 'static-if', these macros evaluate their condition at
1738macro-expansion time and are useful for writing code that can work 1745macro-expansion time and are useful for writing code that can work
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 6414ecab394..eaa8119ead7 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -281,35 +281,6 @@ the string."
281 (declare (pure t) (side-effect-free t)) 281 (declare (pure t) (side-effect-free t))
282 (string-remove-suffix "\n" string)) 282 (string-remove-suffix "\n" string))
283 283
284(defun replace-region-contents (beg end replace-fn
285 &optional max-secs max-costs)
286 "Replace the region between BEG and END using REPLACE-FN.
287REPLACE-FN runs on the current buffer narrowed to the region. It
288should return either a string or a buffer replacing the region.
289
290The replacement is performed using `replace-buffer-contents'
291which also describes the MAX-SECS and MAX-COSTS arguments and the
292return value.
293
294Note: If the replacement is a string, it'll be placed in a
295temporary buffer so that `replace-buffer-contents' can operate on
296it. Therefore, if you already have the replacement in a buffer,
297it makes no sense to convert it to a string using
298`buffer-substring' or similar."
299 (save-excursion
300 (save-restriction
301 (narrow-to-region beg end)
302 (goto-char (point-min))
303 (let ((repl (funcall replace-fn)))
304 (if (bufferp repl)
305 (replace-buffer-contents repl max-secs max-costs)
306 (let ((source-buffer (current-buffer)))
307 (with-temp-buffer
308 (insert repl)
309 (let ((tmp-buffer (current-buffer)))
310 (set-buffer source-buffer)
311 (replace-buffer-contents tmp-buffer max-secs max-costs)))))))))
312
313;;;###autoload 284;;;###autoload
314(defmacro named-let (name bindings &rest body) 285(defmacro named-let (name bindings &rest body)
315 "Looping construct taken from Scheme. 286 "Looping construct taken from Scheme.
diff --git a/lisp/subr.el b/lisp/subr.el
index 8c1e6f657a6..66b73cbf6cc 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4762,6 +4762,19 @@ Point in BUFFER will be placed after the inserted text."
4762 (with-current-buffer buffer 4762 (with-current-buffer buffer
4763 (insert-buffer-substring current start end)))) 4763 (insert-buffer-substring current start end))))
4764 4764
4765(defun replace-buffer-contents (source &optional max-secs max-costs)
4766 "Replace accessible portion of current buffer with that of SOURCE.
4767SOURCE can be a buffer or a string that names a buffer.
4768Interactively, prompt for SOURCE.
4769
4770The replacement is performed using `replace-region-contents'
4771which also describes the MAX-SECS and MAX-COSTS arguments and the
4772return value."
4773 (declare (obsolete replace-region-contents "31.1"))
4774 (interactive "bSource buffer: ")
4775 (replace-region-contents (point-min) (point-max) (get-buffer source)
4776 max-secs max-costs))
4777
4765(defun replace-string-in-region (string replacement &optional start end) 4778(defun replace-string-in-region (string replacement &optional start end)
4766 "Replace STRING with REPLACEMENT in the region from START to END. 4779 "Replace STRING with REPLACEMENT in the region from START to END.
4767The number of replaced occurrences are returned, or nil if STRING 4780The number of replaced occurrences are returned, or nil if STRING
diff --git a/src/coding.c b/src/coding.c
index b0bd5d3a9ab..63b0dbeb18b 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -7898,6 +7898,8 @@ code_conversion_save (bool with_work_buf, bool multibyte)
7898 bset_enable_multibyte_characters (current_buffer, multibyte ? Qt : Qnil); 7898 bset_enable_multibyte_characters (current_buffer, multibyte ? Qt : Qnil);
7899 if (EQ (workbuf, Vcode_conversion_reused_workbuf)) 7899 if (EQ (workbuf, Vcode_conversion_reused_workbuf))
7900 reused_workbuf_in_use = true; 7900 reused_workbuf_in_use = true;
7901 /* FIXME: Maybe we should stay in the new workbuf, because we often
7902 switch right back to it anyway in order to initialize it further. */
7901 set_buffer_internal (current); 7903 set_buffer_internal (current);
7902 } 7904 }
7903 7905
diff --git a/src/editfns.c b/src/editfns.c
index 53d6cce7c82..25625793c42 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -54,6 +54,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
54#include "buffer.h" 54#include "buffer.h"
55#include "window.h" 55#include "window.h"
56#include "blockinput.h" 56#include "blockinput.h"
57#include "coding.h"
57 58
58#ifdef WINDOWSNT 59#ifdef WINDOWSNT
59# include "w32common.h" 60# include "w32common.h"
@@ -1914,11 +1915,14 @@ static bool compareseq_early_abort (struct context *);
1914#include "minmax.h" 1915#include "minmax.h"
1915#include "diffseq.h" 1916#include "diffseq.h"
1916 1917
1917DEFUN ("replace-buffer-contents", Freplace_buffer_contents, 1918DEFUN ("replace-region-contents", Freplace_region_contents,
1918 Sreplace_buffer_contents, 1, 3, "bSource buffer: ", 1919 Sreplace_region_contents, 3, 6, 0,
1919 doc: /* Replace accessible portion of current buffer with that of SOURCE. 1920 doc: /* Replace the region between BEG and END with that of SOURCE.
1920SOURCE can be a buffer or a string that names a buffer. 1921SOURCE can be a buffer, a string, or a vector [SBUF SBEG SEND]
1921Interactively, prompt for SOURCE. 1922denoting the subtring SBEG..SEND of buffer SBUF.
1923
1924If optional argument INHERIT is non-nil, the inserted text will inherit
1925properties from adjoining text.
1922 1926
1923As far as possible the replacement is non-destructive, i.e. existing 1927As far as possible the replacement is non-destructive, i.e. existing
1924buffer contents, markers, properties, and overlays in the current 1928buffer contents, markers, properties, and overlays in the current
@@ -1940,18 +1944,85 @@ computation. If the actual costs exceed this limit, heuristics are
1940used to provide a faster but suboptimal solution. The default value 1944used to provide a faster but suboptimal solution. The default value
1941is 1000000. 1945is 1000000.
1942 1946
1947Note: If the replacement is a string, it’ll usually be placed internally
1948in a temporary buffer. Therefore, all else being equal, it is preferable
1949to pass a buffer rather than a string as SOURCE argument.
1950
1943This function returns t if a non-destructive replacement could be 1951This function returns t if a non-destructive replacement could be
1944performed. Otherwise, i.e., if MAX-SECS was exceeded, it returns 1952performed. Otherwise, i.e., if MAX-SECS was exceeded, it returns
1945nil. */) 1953nil.
1946 (Lisp_Object source, Lisp_Object max_secs, Lisp_Object max_costs) 1954
1955SOURCE can also be a function that will be called with no arguments
1956and with current buffer narrowed to BEG..END, and should return
1957a buffer or a string. But this is deprecated. */)
1958 (Lisp_Object beg, Lisp_Object end, Lisp_Object source,
1959 Lisp_Object max_secs, Lisp_Object max_costs, Lisp_Object inherit)
1947{ 1960{
1948 struct buffer *a = current_buffer; 1961 validate_region (&beg, &end);
1949 Lisp_Object source_buffer = Fget_buffer (source); 1962 ptrdiff_t min_a = XFIXNUM (beg);
1950 if (NILP (source_buffer)) 1963 ptrdiff_t size_a = XFIXNUM (end) - min_a;
1951 nsberror (source); 1964 eassume (size_a >= 0);
1952 struct buffer *b = XBUFFER (source_buffer); 1965 bool a_empty = size_a == 0;
1953 if (! BUFFER_LIVE_P (b)) 1966 bool inh = !NILP (inherit);
1967
1968 if (FUNCTIONP (source))
1969 {
1970 specpdl_ref count = SPECPDL_INDEX ();
1971 record_unwind_protect (save_restriction_restore,
1972 save_restriction_save ());
1973 Fnarrow_to_region (beg, end);
1974 source = calln (source);
1975 unbind_to (count, Qnil);
1976 }
1977 ptrdiff_t min_b, size_b;
1978 struct buffer *b;
1979 if (STRINGP (source))
1980 {
1981 min_b = BEG; /* Assuming we'll copy it into a buffer. */
1982 size_b = SCHARS (source);
1983 b = NULL;
1984 }
1985 else if (BUFFERP (source))
1986 {
1987 b = XBUFFER (source);
1988 min_b = BUF_BEGV (b);
1989 size_b = BUF_ZV (b) - min_b;
1990 }
1991 else
1992 {
1993 CHECK_TYPE (VECTORP (source),
1994 list (Qor, Qstring, Qbuffer, Qvector), source);
1995 /* Let `Faref' signal an error if it's too small. */
1996 Lisp_Object send = Faref (source, make_fixnum (2));
1997 Lisp_Object sbeg = AREF (source, 1);
1998 CHECK_BUFFER (AREF (source, 0));
1999 b = XBUFFER (AREF (source, 0));
2000 specpdl_ref count = SPECPDL_INDEX ();
2001 record_unwind_current_buffer ();
2002 set_buffer_internal (b);
2003 validate_region (&sbeg, &send);
2004 unbind_to (count, Qnil);
2005 min_b = XFIXNUM (sbeg);
2006 size_b = XFIXNUM (send) - min_b;
2007 }
2008 bool b_empty = size_b == 0;
2009 if (b && !BUFFER_LIVE_P (b))
1954 error ("Selecting deleted buffer"); 2010 error ("Selecting deleted buffer");
2011
2012 /* Handle trivial cases where at least one accessible portion is
2013 empty. */
2014
2015 if (a_empty && b_empty)
2016 return Qt;
2017 else if (a_empty || b_empty
2018 || EQ (max_secs, make_fixnum (0))
2019 || EQ (max_costs, make_fixnum (0)))
2020 {
2021 replace_range (min_a, min_a + size_a, source, true, false, inh);
2022 return Qt;
2023 }
2024
2025 struct buffer *a = current_buffer;
1955 if (a == b) 2026 if (a == b)
1956 error ("Cannot replace a buffer with itself"); 2027 error ("Cannot replace a buffer with itself");
1957 2028
@@ -1977,36 +2048,8 @@ nil. */)
1977 time_limit = tlim; 2048 time_limit = tlim;
1978 } 2049 }
1979 2050
1980 ptrdiff_t min_a = BEGV;
1981 ptrdiff_t min_b = BUF_BEGV (b);
1982 ptrdiff_t size_a = ZV - min_a;
1983 ptrdiff_t size_b = BUF_ZV (b) - min_b;
1984 eassume (size_a >= 0);
1985 eassume (size_b >= 0);
1986 bool a_empty = size_a == 0;
1987 bool b_empty = size_b == 0;
1988
1989 /* Handle trivial cases where at least one accessible portion is
1990 empty. */
1991
1992 if (a_empty && b_empty)
1993 return Qt;
1994
1995 if (a_empty)
1996 {
1997 Finsert_buffer_substring (source, Qnil, Qnil);
1998 return Qt;
1999 }
2000
2001 if (b_empty)
2002 {
2003 del_range_both (BEGV, BEGV_BYTE, ZV, ZV_BYTE, true);
2004 return Qt;
2005 }
2006
2007 specpdl_ref count = SPECPDL_INDEX (); 2051 specpdl_ref count = SPECPDL_INDEX ();
2008 2052
2009
2010 ptrdiff_t diags = size_a + size_b + 3; 2053 ptrdiff_t diags = size_a + size_b + 3;
2011 ptrdiff_t del_bytes = size_a / CHAR_BIT + 1; 2054 ptrdiff_t del_bytes = size_a / CHAR_BIT + 1;
2012 ptrdiff_t ins_bytes = size_b / CHAR_BIT + 1; 2055 ptrdiff_t ins_bytes = size_b / CHAR_BIT + 1;
@@ -2020,6 +2063,18 @@ nil. */)
2020 unsigned char *deletions_insertions = memset (buffer + 2 * diags, 0, 2063 unsigned char *deletions_insertions = memset (buffer + 2 * diags, 0,
2021 del_bytes + ins_bytes); 2064 del_bytes + ins_bytes);
2022 2065
2066 /* The rest of the code is not prepared to handle a string SOURCE. */
2067 if (!b)
2068 {
2069 Lisp_Object workbuf
2070 = code_conversion_save (true, STRING_MULTIBYTE (source));
2071 b = XBUFFER (workbuf);
2072 set_buffer_internal (b);
2073 CALLN (Finsert, source);
2074 set_buffer_internal (a);
2075 }
2076 Lisp_Object source_buffer = make_lisp_ptr (b, Lisp_Vectorlike);
2077
2023 /* FIXME: It is not documented how to initialize the contents of the 2078 /* FIXME: It is not documented how to initialize the contents of the
2024 context structure. This code cargo-cults from the existing 2079 context structure. This code cargo-cults from the existing
2025 caller in src/analyze.c of GNU Diffutils, which appears to 2080 caller in src/analyze.c of GNU Diffutils, which appears to
@@ -2053,7 +2108,7 @@ nil. */)
2053 Lisp_Object src = CALLN (Fvector, source_buffer, 2108 Lisp_Object src = CALLN (Fvector, source_buffer,
2054 make_fixnum (BUF_BEGV (b)), 2109 make_fixnum (BUF_BEGV (b)),
2055 make_fixnum (BUF_ZV (b))); 2110 make_fixnum (BUF_ZV (b)));
2056 replace_range (BEGV, ZV, src, true, false, false); 2111 replace_range (min_a, min_a + size_a, src, true, false, inh);
2057 SAFE_FREE_UNBIND_TO (count, Qnil); 2112 SAFE_FREE_UNBIND_TO (count, Qnil);
2058 return Qnil; 2113 return Qnil;
2059 } 2114 }
@@ -2069,7 +2124,7 @@ nil. */)
2069 modification hooks, because then they don't want that. */ 2124 modification hooks, because then they don't want that. */
2070 if (!inhibit_modification_hooks) 2125 if (!inhibit_modification_hooks)
2071 { 2126 {
2072 prepare_to_modify_buffer (BEGV, ZV, NULL); 2127 prepare_to_modify_buffer (min_a, min_a + size_a, NULL);
2073 specbind (Qinhibit_modification_hooks, Qt); 2128 specbind (Qinhibit_modification_hooks, Qt);
2074 modification_hooks_inhibited = true; 2129 modification_hooks_inhibited = true;
2075 } 2130 }
@@ -2102,10 +2157,9 @@ nil. */)
2102 eassert (beg_a <= end_a); 2157 eassert (beg_a <= end_a);
2103 eassert (beg_b <= end_b); 2158 eassert (beg_b <= end_b);
2104 eassert (beg_a < end_a || beg_b < end_b); 2159 eassert (beg_a < end_a || beg_b < end_b);
2105 /* FIXME: Use 'replace_range'! */
2106 ASET (src, 1, make_fixed_natnum (beg_b)); 2160 ASET (src, 1, make_fixed_natnum (beg_b));
2107 ASET (src, 2, make_fixed_natnum (end_b)); 2161 ASET (src, 2, make_fixed_natnum (end_b));
2108 replace_range (beg_a, end_a, src, true, false, false); 2162 replace_range (beg_a, end_a, src, true, false, inh);
2109 } 2163 }
2110 --i; 2164 --i;
2111 --j; 2165 --j;
@@ -2115,8 +2169,8 @@ nil. */)
2115 2169
2116 if (modification_hooks_inhibited) 2170 if (modification_hooks_inhibited)
2117 { 2171 {
2118 signal_after_change (BEGV, size_a, ZV - BEGV); 2172 signal_after_change (min_a, size_a, size_b);
2119 update_compositions (BEGV, ZV, CHECK_INSIDE); 2173 update_compositions (min_a, min_a + size_b, CHECK_INSIDE);
2120 /* We've locked the buffer's file above in 2174 /* We've locked the buffer's file above in
2121 prepare_to_modify_buffer; if the buffer is unchanged at this 2175 prepare_to_modify_buffer; if the buffer is unchanged at this
2122 point, i.e. no insertions or deletions have been made, unlock 2176 point, i.e. no insertions or deletions have been made, unlock
@@ -4787,7 +4841,7 @@ it to be non-nil. */);
4787 4841
4788 defsubr (&Sinsert_buffer_substring); 4842 defsubr (&Sinsert_buffer_substring);
4789 defsubr (&Scompare_buffer_substrings); 4843 defsubr (&Scompare_buffer_substrings);
4790 defsubr (&Sreplace_buffer_contents); 4844 defsubr (&Sreplace_region_contents);
4791 defsubr (&Ssubst_char_in_region); 4845 defsubr (&Ssubst_char_in_region);
4792 defsubr (&Stranslate_region_internal); 4846 defsubr (&Stranslate_region_internal);
4793 defsubr (&Sdelete_region); 4847 defsubr (&Sdelete_region);
diff --git a/src/insdel.c b/src/insdel.c
index 9b770725971..20267265ab8 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -1409,9 +1409,9 @@ adjust_after_insert (ptrdiff_t from, ptrdiff_t from_byte,
1409 adjust_after_replace (from, from_byte, Qnil, newlen, len_byte); 1409 adjust_after_replace (from, from_byte, Qnil, newlen, len_byte);
1410} 1410}
1411 1411
1412/* Replace the text from character positions FROM to TO with NEW. 1412/* Replace the text from character positions FROM to TO with the
1413 NEW could either be a string, the replacement text, or a vector 1413 replacement text NEW. NEW could either be a string, a buffer, or
1414 [BUFFER BEG END], where BUFFER is the buffer with the replacement 1414 a vector [BUFFER BEG END], where BUFFER is the buffer with the replacement
1415 text and BEG and END are buffer positions in BUFFER that give the 1415 text and BEG and END are buffer positions in BUFFER that give the
1416 replacement text beginning and end. 1416 replacement text beginning and end.
1417 If PREPARE, call prepare_to_modify_buffer. 1417 If PREPARE, call prepare_to_modify_buffer.
@@ -1439,6 +1439,12 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new,
1439 insbeg = 0; 1439 insbeg = 0;
1440 inschars = SCHARS (new); 1440 inschars = SCHARS (new);
1441 } 1441 }
1442 else if (BUFFERP (new))
1443 {
1444 insbuf = XBUFFER (new);
1445 insbeg = BUF_BEGV (insbuf);
1446 inschars = BUF_ZV (insbuf) - insbeg;
1447 }
1442 else 1448 else
1443 { 1449 {
1444 CHECK_VECTOR (new); 1450 CHECK_VECTOR (new);
diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el
index c3f825c6149..3da9d4e8acd 100644
--- a/test/src/editfns-tests.el
+++ b/test/src/editfns-tests.el
@@ -289,7 +289,7 @@
289 (narrow-to-region 8 13) 289 (narrow-to-region 8 13)
290 (goto-char 12) 290 (goto-char 12)
291 (should (looking-at " \\'")) 291 (should (looking-at " \\'"))
292 (replace-buffer-contents source) 292 (replace-region-contents (point-min) (point-max) source)
293 (should (looking-at " \\'"))) 293 (should (looking-at " \\'")))
294 (should (equal (marker-buffer marker) (current-buffer))) 294 (should (equal (marker-buffer marker) (current-buffer)))
295 (should (equal (marker-position marker) 16))) 295 (should (equal (marker-position marker) 16)))
@@ -306,7 +306,7 @@
306 (let ((source (current-buffer))) 306 (let ((source (current-buffer)))
307 (with-temp-buffer 307 (with-temp-buffer
308 (insert "foo BAR baz qux") 308 (insert "foo BAR baz qux")
309 (replace-buffer-contents source) 309 (replace-region-contents (point-min) (point-max) source)
310 (should (equal-including-properties 310 (should (equal-including-properties
311 (buffer-string) 311 (buffer-string)
312 "foo bar baz qux")))))) 312 "foo bar baz qux"))))))
@@ -318,44 +318,44 @@
318 (switch-to-buffer "b") 318 (switch-to-buffer "b")
319 (insert-char (char-from-name "SMILE")) 319 (insert-char (char-from-name "SMILE"))
320 (insert "5678") 320 (insert "5678")
321 (replace-buffer-contents "a") 321 (replace-region-contents (point-min) (point-max) (get-buffer "a"))
322 (should (equal (buffer-substring-no-properties (point-min) (point-max)) 322 (should (equal (buffer-substring-no-properties (point-min) (point-max))
323 (concat (string (char-from-name "SMILE")) "1234")))) 323 (concat (string (char-from-name "SMILE")) "1234"))))
324 324
325(defun editfns--replace-region (from to string)
326 (save-excursion
327 (save-restriction
328 (narrow-to-region from to)
329 (let ((buf (current-buffer)))
330 (with-temp-buffer
331 (let ((str-buf (current-buffer)))
332 (insert string)
333 (with-current-buffer buf
334 (replace-buffer-contents str-buf))))))))
335
336(ert-deftest editfns-tests--replace-region () 325(ert-deftest editfns-tests--replace-region ()
337 ;; :expected-result :failed 326 ;; :expected-result :failed
338 (with-temp-buffer 327 (with-temp-buffer
339 (insert "here is some text") 328 (let ((tmpbuf (current-buffer)))
340 (let ((m5n (copy-marker (+ (point-min) 5))) 329 (insert " be ")
341 (m5a (copy-marker (+ (point-min) 5) t)) 330 (narrow-to-region (+ (point-min) 2) (- (point-max) 2))
342 (m6n (copy-marker (+ (point-min) 6))) 331 (dolist (args `((,tmpbuf)
343 (m6a (copy-marker (+ (point-min) 6) t)) 332 (,(vector tmpbuf (point-min) (point-max)))
344 (m7n (copy-marker (+ (point-min) 7))) 333 (,"be")
345 (m7a (copy-marker (+ (point-min) 7) t))) 334 (,(vector tmpbuf (point-min) (point-max)) 0)
346 (editfns--replace-region (+ (point-min) 5) (+ (point-min) 7) "be") 335 (,"be" 0)))
347 (should (equal (buffer-string) "here be some text")) 336 (with-temp-buffer
348 (should (equal (point) (point-max))) 337 (insert "here is some text")
349 ;; Markers before the replaced text stay before. 338 (let ((m5n (copy-marker (+ (point-min) 5)))
350 (should (= m5n (+ (point-min) 5))) 339 (m5a (copy-marker (+ (point-min) 5) t))
351 (should (= m5a (+ (point-min) 5))) 340 (m6n (copy-marker (+ (point-min) 6)))
352 ;; Markers in the replaced text can end up at either end, depending 341 (m6a (copy-marker (+ (point-min) 6) t))
353 ;; on whether they're advance-after-insert or not. 342 (m7n (copy-marker (+ (point-min) 7)))
354 (should (= m6n (+ (point-min) 5))) 343 (m7a (copy-marker (+ (point-min) 7) t)))
355 (should (<= (+ (point-min) 5) m6a (+ (point-min) 7))) 344 (apply #'replace-region-contents
356 ;; Markers after the replaced text stay after. 345 (+ (point-min) 5) (+ (point-min) 7) args)
357 (should (= m7n (+ (point-min) 7))) 346 (should (equal (buffer-string) "here be some text"))
358 (should (= m7a (+ (point-min) 7)))))) 347 (should (equal (point) (point-max)))
348 ;; Markers before the replaced text stay before.
349 (should (= m5n (+ (point-min) 5)))
350 (should (= m5a (+ (point-min) 5)))
351 ;; Markers in the replaced text can end up at either end, depending
352 ;; on whether they're advance-after-insert or not.
353 (should (= m6n (+ (point-min) 5)))
354 (should (<= (+ (point-min) 5) m6a (+ (point-min) 7)))
355 ;; Markers after the replaced text stay after.
356 (should (= m7n (+ (point-min) 7)))
357 (should (= m7a (+ (point-min) 7)))))
358 (widen)))))
359 359
360(ert-deftest delete-region-undo-markers-1 () 360(ert-deftest delete-region-undo-markers-1 ()
361 "Make sure we don't end up with freed markers reachable from Lisp." 361 "Make sure we don't end up with freed markers reachable from Lisp."