diff options
| author | Stefan Monnier | 2025-03-28 00:46:53 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2025-03-29 17:49:05 -0400 |
| commit | 7c82cc8b975175aebbad1c43ec1cd98b3232f482 (patch) | |
| tree | 2f2f5ac19ec7055442da0bd58507314d213b9bdd | |
| parent | f60fc1287d499e8c93857b1b96e8bd2467b22c8d (diff) | |
| download | emacs-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.texi | 74 | ||||
| -rw-r--r-- | etc/NEWS | 7 | ||||
| -rw-r--r-- | lisp/emacs-lisp/subr-x.el | 29 | ||||
| -rw-r--r-- | lisp/subr.el | 13 | ||||
| -rw-r--r-- | src/coding.c | 2 | ||||
| -rw-r--r-- | src/editfns.c | 150 | ||||
| -rw-r--r-- | src/insdel.c | 12 | ||||
| -rw-r--r-- | test/src/editfns-tests.el | 68 |
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 |
| 4780 | with the text of another buffer: | 4780 | current 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 |
| 4783 | This function replaces the accessible portion of the current buffer | 4783 | This function replaces the region between @var{beg} and @var{end} |
| 4784 | with the accessible portion of the buffer @var{source}. @var{source} | 4784 | of the current buffer with the text found in @var{source} which |
| 4785 | may either be a buffer object or the name of a buffer. When | 4785 | is usually a string or a buffer, in which case it will use the |
| 4786 | @code{replace-buffer-contents} succeeds, the text of the accessible | 4786 | accessible portion of that buffer. |
| 4787 | portion of the current buffer will be equal to the text of the | ||
| 4788 | accessible portion of the @var{source} buffer. | ||
| 4789 | 4787 | ||
| 4790 | This function attempts to keep point, markers, text properties, and | 4788 | This function attempts to keep point, markers, text properties, and |
| 4791 | overlays in the current buffer intact. One potential case where this | 4789 | overlays in the current buffer intact. One potential case where this |
| 4792 | behavior is useful is external code formatting programs: they | 4790 | behavior is useful is external code formatting programs: they typically |
| 4793 | typically write the reformatted text into a temporary buffer or file, | 4791 | write the reformatted text into a temporary buffer or file, and using |
| 4794 | and using @code{delete-region} and @code{insert-buffer-substring} | 4792 | @code{insert} and @code{delete-region} would destroy these properties. |
| 4795 | would destroy these properties. However, the latter combination is | 4793 | |
| 4796 | typically faster (@xref{Deletion}, and @ref{Insertion}). | 4794 | However, in order to do that, @code{replace-region-contents} needs to |
| 4797 | 4795 | compare the contents of the original buffer with that of @var{source}, | |
| 4798 | For its working, @code{replace-buffer-contents} needs to compare the | 4796 | using a costly algorithm which makes the operation much slower than |
| 4799 | contents of the original buffer with that of @var{source} which is a | 4797 | a simple @code{insert} and @code{delete-region}. In many cases, you may |
| 4800 | costly operation if the buffers are huge and there is a high number of | 4798 | not need that refinement, and you will then want to pass 0 as |
| 4801 | differences 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 | 4800 | It will then be just as fast as @code{insert} and @code{delete-region} |
| 4801 | while still preserving point and markers marginally better. | ||
| 4802 | |||
| 4803 | Beyond that basic usage, if you need to use as source a subset of the | ||
| 4804 | accessible 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 | ||
| 4807 | you want to use as source. | ||
| 4808 | |||
| 4809 | If you need the inserted text to inherit text-properties | ||
| 4810 | from the adjoining text, you can pass a non-@code{nil} value as | ||
| 4811 | @var{inherit} argument. | ||
| 4812 | |||
| 4813 | When you do want the costly refined replacement, in order to keep | ||
| 4814 | @code{replace-region-contents}'s runtime in bounds, it has two | ||
| 4803 | optional arguments. | 4815 | optional 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 | |||
| 4810 | the actual costs exceed this limit, heuristics are used to provide a | 4822 | the actual costs exceed this limit, heuristics are used to provide a |
| 4811 | faster but suboptimal solution. The default value is 1000000. | 4823 | faster 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 |
| 4814 | replacement could be performed. Otherwise, i.e., if @var{max-secs} | 4826 | replacement could be performed. Otherwise, i.e., if @var{max-secs} |
| 4815 | was exceeded, it returns @code{nil}. | 4827 | was exceeded, it returns @code{nil}. |
| 4816 | @end deffn | ||
| 4817 | 4828 | ||
| 4818 | @defun replace-region-contents beg end replace-fn &optional max-secs max-costs | 4829 | Note: When using the refined replacement algorithm, if the replacement |
| 4819 | This function replaces the region between @var{beg} and @var{end} | 4830 | is a string, it will be internally copied to a temporary buffer. |
| 4820 | using the given @var{replace-fn}. The function @var{replace-fn} is | 4831 | Therefore, all else being equal, it is preferable to pass a buffer than |
| 4821 | run in the current buffer narrowed to the specified region and it | 4832 | a string as @var{source} argument. |
| 4822 | should return either a string or a buffer replacing the region. | ||
| 4823 | |||
| 4824 | The replacement is performed using @code{replace-buffer-contents} (see | ||
| 4825 | above) which also describes the @var{max-secs} and @var{max-costs} | ||
| 4826 | arguments and the return value. | ||
| 4827 | |||
| 4828 | Note: If the replacement is a string, it will be placed in a temporary | ||
| 4829 | buffer so that @code{replace-buffer-contents} can operate on it. | ||
| 4830 | Therefore, if you already have the replacement in a buffer, it makes | ||
| 4831 | no sense to convert it to a string using @code{buffer-substring} or | ||
| 4832 | similar. | ||
| 4833 | @end defun | 4833 | @end defun |
| 4834 | 4834 | ||
| 4835 | @node Decompression | 4835 | @node Decompression |
| @@ -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. | ||
| 1737 | It has been promoted from 'subr-x' to the C code. | ||
| 1738 | You can now directly pass it a string or a buffer rather than a function. | ||
| 1739 | Actually 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'. |
| 1737 | Like 'static-if', these macros evaluate their condition at | 1744 | Like 'static-if', these macros evaluate their condition at |
| 1738 | macro-expansion time and are useful for writing code that can work | 1745 | macro-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. | ||
| 287 | REPLACE-FN runs on the current buffer narrowed to the region. It | ||
| 288 | should return either a string or a buffer replacing the region. | ||
| 289 | |||
| 290 | The replacement is performed using `replace-buffer-contents' | ||
| 291 | which also describes the MAX-SECS and MAX-COSTS arguments and the | ||
| 292 | return value. | ||
| 293 | |||
| 294 | Note: If the replacement is a string, it'll be placed in a | ||
| 295 | temporary buffer so that `replace-buffer-contents' can operate on | ||
| 296 | it. Therefore, if you already have the replacement in a buffer, | ||
| 297 | it 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. | ||
| 4767 | SOURCE can be a buffer or a string that names a buffer. | ||
| 4768 | Interactively, prompt for SOURCE. | ||
| 4769 | |||
| 4770 | The replacement is performed using `replace-region-contents' | ||
| 4771 | which also describes the MAX-SECS and MAX-COSTS arguments and the | ||
| 4772 | return 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. |
| 4767 | The number of replaced occurrences are returned, or nil if STRING | 4780 | The 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 | ||
| 1917 | DEFUN ("replace-buffer-contents", Freplace_buffer_contents, | 1918 | DEFUN ("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. |
| 1920 | SOURCE can be a buffer or a string that names a buffer. | 1921 | SOURCE can be a buffer, a string, or a vector [SBUF SBEG SEND] |
| 1921 | Interactively, prompt for SOURCE. | 1922 | denoting the subtring SBEG..SEND of buffer SBUF. |
| 1923 | |||
| 1924 | If optional argument INHERIT is non-nil, the inserted text will inherit | ||
| 1925 | properties from adjoining text. | ||
| 1922 | 1926 | ||
| 1923 | As far as possible the replacement is non-destructive, i.e. existing | 1927 | As far as possible the replacement is non-destructive, i.e. existing |
| 1924 | buffer contents, markers, properties, and overlays in the current | 1928 | buffer contents, markers, properties, and overlays in the current |
| @@ -1940,18 +1944,85 @@ computation. If the actual costs exceed this limit, heuristics are | |||
| 1940 | used to provide a faster but suboptimal solution. The default value | 1944 | used to provide a faster but suboptimal solution. The default value |
| 1941 | is 1000000. | 1945 | is 1000000. |
| 1942 | 1946 | ||
| 1947 | Note: If the replacement is a string, it’ll usually be placed internally | ||
| 1948 | in a temporary buffer. Therefore, all else being equal, it is preferable | ||
| 1949 | to pass a buffer rather than a string as SOURCE argument. | ||
| 1950 | |||
| 1943 | This function returns t if a non-destructive replacement could be | 1951 | This function returns t if a non-destructive replacement could be |
| 1944 | performed. Otherwise, i.e., if MAX-SECS was exceeded, it returns | 1952 | performed. Otherwise, i.e., if MAX-SECS was exceeded, it returns |
| 1945 | nil. */) | 1953 | nil. |
| 1946 | (Lisp_Object source, Lisp_Object max_secs, Lisp_Object max_costs) | 1954 | |
| 1955 | SOURCE can also be a function that will be called with no arguments | ||
| 1956 | and with current buffer narrowed to BEG..END, and should return | ||
| 1957 | a 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." |