procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge remote-tracking branch 'origin/scratch/replace-region-contents'

Browse source
This commit is contained in:
Stefan Monnier 2025-03-29 17:53:55 -04:00
commit a5126f79a1
21 changed files with 323 additions and 268 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

72
doc/lispref/text.texi
View file

@ -4776,30 +4776,42 @@ all markers unrelocated.
@node Replacing
@section Replacing Buffer Text
You can use the following function to replace the text of one buffer
with the text of another buffer:
You can use the following function to replace some the text of the
current buffer:
@deffn Command replace-buffer-contents source &optional max-secs max-costs
This function replaces the accessible portion of the current buffer
with the accessible portion of the buffer @var{source}. @var{source}
may either be a buffer object or the name of a buffer. When
@code{replace-buffer-contents} succeeds, the text of the accessible
portion of the current buffer will be equal to the text of the
accessible portion of the @var{source} buffer.
@defun replace-region-contents beg end source &optional max-secs max-costs inherit
This function replaces the region between @var{beg} and @var{end}
of the current buffer with the text found in @var{source} which
is usually a string or a buffer, in which case it will use the
accessible portion of that buffer.
This function attempts to keep point, markers, text properties, and
overlays in the current buffer intact. One potential case where this
behavior is useful is external code formatting programs: they
typically write the reformatted text into a temporary buffer or file,
and using @code{delete-region} and @code{insert-buffer-substring}
would destroy these properties. However, the latter combination is
typically faster (@xref{Deletion}, and @ref{Insertion}).
behavior is useful is external code formatting programs: they typically
write the reformatted text into a temporary buffer or file, and using
@code{insert} and @code{delete-region} would destroy these properties.
For its working, @code{replace-buffer-contents} needs to compare the
contents of the original buffer with that of @var{source} which is a
costly operation if the buffers are huge and there is a high number of
differences between them. In order to keep
@code{replace-buffer-contents}'s runtime in bounds, it has two
However, in order to do that, @code{replace-region-contents} needs to
compare the contents of the original buffer with that of @var{source},
using a costly algorithm which makes the operation much slower than
a simple @code{insert} and @code{delete-region}. In many cases, you may
not need that refinement, and you will then want to pass 0 as
@var{max-secs} argument, so as to short-circuit that costly algorithm:
It will then be just as fast as @code{insert} and @code{delete-region}
while still preserving point and markers marginally better.
Beyond that basic usage, if you need to use as source a subset of the
accessible portion of a buffer, @var{source} can also be a vector
@code{[@var{sbuf} @var{sbeg} @var{send}]} where the region between
@var{sbeg} and @var{send} in buffer @var{sbuf} is the text
you want to use as source.
If you need the inserted text to inherit text-properties
from the adjoining text, you can pass a non-@code{nil} value as
@var{inherit} argument.
When you do want the costly refined replacement, in order to keep
@code{replace-region-contents}'s runtime in bounds, it has two
optional arguments.
@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
the actual costs exceed this limit, heuristics are used to provide a
faster but suboptimal solution. The default value is 1000000.
@code{replace-buffer-contents} returns @code{t} if a non-destructive
@code{replace-region-contents} returns @code{t} if a non-destructive
replacement could be performed. Otherwise, i.e., if @var{max-secs}
was exceeded, it returns @code{nil}.
@end deffn
@defun replace-region-contents beg end replace-fn &optional max-secs max-costs
This function replaces the region between @var{beg} and @var{end}
using the given @var{replace-fn}. The function @var{replace-fn} is
run in the current buffer narrowed to the specified region and it
should return either a string or a buffer replacing the region.
The replacement is performed using @code{replace-buffer-contents} (see
above) which also describes the @var{max-secs} and @var{max-costs}
arguments and the return value.
Note: If the replacement is a string, it will be placed in a temporary
buffer so that @code{replace-buffer-contents} can operate on it.
Therefore, if you already have the replacement in a buffer, it makes
no sense to convert it to a string using @code{buffer-substring} or
similar.
Note: When using the refined replacement algorithm, if the replacement
is a string, it will be internally copied to a temporary buffer.
Therefore, all else being equal, it is preferable to pass a buffer than
a string as @var{source} argument.
@end defun
@node Decompression

7
etc/NEWS
View file

@ -1752,6 +1752,13 @@ Previously, its argument was always evaluated using dynamic binding.
* Lisp Changes in Emacs 31.1
+++
** Improve 'replace-region-contents' to accept more forms of sources.
It has been promoted from 'subr-x' to the C code.
You can now directly pass it a string or a buffer rather than a function.
Actually passing it a function is now deprecated.
'replace-buffer-contents' is also marked as obsolete.
+++
** New macros 'static-when' and 'static-unless'.
Like 'static-if', these macros evaluate their condition at

8
lisp/emacs-lisp/cl-lib.el
View file

@ -154,12 +154,10 @@ to an element already in the list stored in PLACE.
`(setq ,place (cl-adjoin ,x ,place ,@keys)))
`(cl-callf2 cl-adjoin ,x ,place ,@keys)))
(defun cl--set-buffer-substring (start end val)
(defun cl--set-buffer-substring (start end val &optional inherit)
"Delete region from START to END and insert VAL."
(save-excursion (delete-region start end)
(goto-char start)
(insert val)
val))
(replace-region-contents start end val 0 nil inherit)
val)
(defun cl--set-substring (str start end val)
(if end (if (< end 0) (incf end (length str)))

2
lisp/emacs-lisp/gv.el
View file

@ -684,6 +684,8 @@ REF must have been previously obtained with `gv-ref'."
`(insert (prog1 ,store (erase-buffer))))
(make-obsolete-generalized-variable 'buffer-string nil "29.1")
;; FIXME: Can't use `replace-region-contents' because it's not
;; expected to be costly, so we need to pass MAX-SECS==0.
(gv-define-simple-setter buffer-substring cl--set-buffer-substring)
(make-obsolete-generalized-variable 'buffer-substring nil "29.1")

29
lisp/emacs-lisp/subr-x.el
View file

@ -281,35 +281,6 @@ the string."
(declare (pure t) (side-effect-free t))
(string-remove-suffix "\n" string))
(defun replace-region-contents (beg end replace-fn
&optional max-secs max-costs)
"Replace the region between BEG and END using REPLACE-FN.
REPLACE-FN runs on the current buffer narrowed to the region. It
should return either a string or a buffer replacing the region.
The replacement is performed using `replace-buffer-contents'
which also describes the MAX-SECS and MAX-COSTS arguments and the
return value.
Note: If the replacement is a string, it'll be placed in a
temporary buffer so that `replace-buffer-contents' can operate on
it. Therefore, if you already have the replacement in a buffer,
it makes no sense to convert it to a string using
`buffer-substring' or similar."
(save-excursion
(save-restriction
(narrow-to-region beg end)
(goto-char (point-min))
(let ((repl (funcall replace-fn)))
(if (bufferp repl)
(replace-buffer-contents repl max-secs max-costs)
(let ((source-buffer (current-buffer)))
(with-temp-buffer
(insert repl)
(let ((tmp-buffer (current-buffer)))
(set-buffer source-buffer)
(replace-buffer-contents tmp-buffer max-secs max-costs)))))))))
;;;###autoload
(defmacro named-let (name bindings &rest body)
"Looping construct taken from Scheme.

11
lisp/files.el
View file

@ -7264,9 +7264,9 @@ an auto-save file."
The command tries to preserve markers, properties and overlays.
If the operation takes more than this time, a single
delete+insert is performed. Actually, this value is passed as
the MAX-SECS argument to the function `replace-buffer-contents',
the MAX-SECS argument to the function `replace-region-contents',
so it is not ensured that the whole execution won't take longer.
See `replace-buffer-contents' for more details.")
See `replace-region-contents' for more details.")
(defun revert-buffer-insert-file-contents-delicately (file-name _auto-save-p)
"Optional function for `revert-buffer-insert-file-contents-function'.
@ -7275,11 +7275,11 @@ The function `revert-buffer-with-fine-grain' uses this function by binding
As with `revert-buffer-insert-file-contents--default-function', FILE-NAME is
the name of the file and AUTO-SAVE-P is non-nil if this is an auto-save file.
Since calling `replace-buffer-contents' can take a long time, depending of
Since calling `replace-region-contents' can take a long time, depending of
the number of changes made to the buffer, it uses the value of the variable
`revert-buffer-with-fine-grain-max-seconds' as a maximum time to try delicately
reverting the buffer. If it fails, it does a delete+insert. For more details,
see `replace-buffer-contents'."
see `replace-region-contents'."
(cond
((not (file-exists-p file-name))
(error (if buffer-file-number
@ -7302,7 +7302,8 @@ see `replace-buffer-contents'."
(let ((temp-buf (current-buffer)))
(set-buffer buf)
(let ((buffer-file-name nil))
(replace-buffer-contents
(replace-region-contents
(point-min) (point-max)
temp-buf
revert-buffer-with-fine-grain-max-seconds))))))))
;; See comments in revert-buffer-with-fine-grain for an explanation.

2
lisp/help-fns.el
View file

@ -777,7 +777,7 @@ the C sources, too."
(save-excursion
(forward-char -1)
(<= (current-column) (- fill-column 12)))
(cl--set-buffer-substring (- beg 3) beg " ")))))
(replace-region-contents (- beg 3) beg " " 0)))))
high-doc)))))
(defun help-fns--parent-mode (function)

20
lisp/json.el
View file

@ -803,7 +803,7 @@ With prefix argument MINIMIZE, minimize it instead."
(orig-buf (current-buffer)))
;; Strategy: Repeatedly `json-read' from the original buffer and
;; write the pretty-printed snippet to a temporary buffer.
;; Use `replace-buffer-contents' to swap the original
;; Use `replace-region-contents' to swap the original
;; region with the contents of the temporary buffer so that point,
;; marks, etc. are kept.
;; Stop as soon as we get an error from `json-read'.
@ -825,16 +825,14 @@ With prefix argument MINIMIZE, minimize it instead."
(standard-output tmp-buf))
(with-current-buffer tmp-buf
(erase-buffer) (json--print json))
(save-restriction
(narrow-to-region beg (point))
(replace-buffer-contents
tmp-buf
json-pretty-print-max-secs
;; FIXME: What's a good value here? Can we use
;; something better, e.g., by deriving a value
;; from the size of the region?
64)
'keep-going))
(replace-region-contents
beg (point) tmp-buf
json-pretty-print-max-secs
;; FIXME: What's a good value here? Can we use
;; something better, e.g., by deriving a value
;; from the size of the region?
64)
'keep-going)
;; EOF is expected because we json-read until we hit
;; the end of the narrow region.
(json-end-of-file nil))))))))))

43
lisp/language/japan-util.el
View file

@ -217,9 +217,9 @@ The argument object is not altered--the value is a copy."
(defun japanese-replace-region (from to string)
"Replace the region specified by FROM and TO to STRING."
(goto-char from)
(insert string)
(delete-char (- to from)))
(declare (obsolete replace-region-contents "31.1"))
(goto-char to)
(replace-region-contents from to string 0))
;;;###autoload
(defun japanese-katakana-region (from to &optional hankaku)
@ -238,13 +238,15 @@ of which charset is `japanese-jisx0201-kana'."
(get-char-code-property kana 'kana-composition)))
slot) ;; next
(if (and composition (setq slot (assq (following-char) composition)))
(japanese-replace-region (match-beginning 0) (1+ (point))
(cdr slot))
(progn
(goto-char (1+ (point)))
(replace-region-contents (match-beginning 0) (point)
(cdr slot) 0))
(let ((kata (get-char-code-property
kana (if hankaku 'jisx0201 'katakana))))
(if kata
(japanese-replace-region (match-beginning 0) (point)
kata)))))))))
(replace-region-contents (match-beginning 0) (point)
kata 0)))))))))
;;;###autoload
@ -260,13 +262,16 @@ of which charset is `japanese-jisx0201-kana'."
(composition (get-char-code-property kata 'kana-composition))
slot) ;; next
(if (and composition (setq slot (assq (following-char) composition)))
(japanese-replace-region (match-beginning 0) (1+ (point))
(get-char-code-property
(cdr slot) 'hiragana))
(progn
(goto-char (1+ (point)))
(replace-region-contents (match-beginning 0) (point)
(get-char-code-property
(cdr slot) 'hiragana)
0))
(let ((hira (get-char-code-property kata 'hiragana)))
(if hira
(japanese-replace-region (match-beginning 0) (point)
hira)))))))))
(replace-region-contents (match-beginning 0) (point)
hira 0)))))))))
;;;###autoload
(defun japanese-hankaku-region (from to &optional ascii-only)
@ -285,8 +290,8 @@ Optional argument ASCII-ONLY non-nil means to convert only to ASCII char."
(get-char-code-property zenkaku 'jisx0201))
(get-char-code-property zenkaku 'ascii))))
(if hankaku
(japanese-replace-region (match-beginning 0) (match-end 0)
hankaku)))))))
(replace-region-contents (match-beginning 0) (match-end 0)
hankaku 0)))))))
;;;###autoload
(defun japanese-zenkaku-region (from to &optional katakana-only)
@ -307,12 +312,14 @@ Optional argument KATAKANA-ONLY non-nil means to convert only KATAKANA char."
(composition (get-char-code-property hankaku 'kana-composition))
slot) ;; next
(if (and composition (setq slot (assq (following-char) composition)))
(japanese-replace-region (match-beginning 0) (1+ (point))
(cdr slot))
(progn
(goto-char (1+ (point)))
(replace-region-contents (match-beginning 0) (point)
(cdr slot) 0))
(let ((zenkaku (japanese-zenkaku hankaku)))
(if zenkaku
(japanese-replace-region (match-beginning 0) (match-end 0)
zenkaku)))))))))
(replace-region-contents (match-beginning 0) (match-end 0)
zenkaku 0)))))))))
;;;###autoload
(defun read-hiragana-string (prompt &optional initial-input)

33
lisp/minibuffer.el
View file

@ -1398,35 +1398,8 @@ Moves point to the end of the new text."
newtext)
;; Remove all text properties.
(set-text-properties 0 (length newtext) nil newtext))
;; Maybe this should be in subr.el.
;; You'd think this is trivial to do, but details matter if you want
;; to keep markers "at the right place" and be robust in the face of
;; after-change-functions that may themselves modify the buffer.
(let ((prefix-len 0))
;; Don't touch markers in the shared prefix (if any).
(while (and (< prefix-len (length newtext))
(< (+ beg prefix-len) end)
(eq (char-after (+ beg prefix-len))
(aref newtext prefix-len)))
(setq prefix-len (1+ prefix-len)))
(unless (zerop prefix-len)
(setq beg (+ beg prefix-len))
(setq newtext (substring newtext prefix-len))))
(let ((suffix-len 0))
;; Don't touch markers in the shared suffix (if any).
(while (and (< suffix-len (length newtext))
(< beg (- end suffix-len))
(eq (char-before (- end suffix-len))
(aref newtext (- (length newtext) suffix-len 1))))
(setq suffix-len (1+ suffix-len)))
(unless (zerop suffix-len)
(setq end (- end suffix-len))
(setq newtext (substring newtext 0 (- suffix-len))))
(goto-char beg)
(let ((length (- end beg))) ;Read `end' before we insert the text.
(insert-and-inherit newtext)
(delete-region (point) (+ (point) length)))
(forward-char suffix-len)))
(replace-region-contents beg end newtext 0.1 nil 'inherit)
(goto-char (+ beg (length newtext))))
(defcustom completion-cycle-threshold nil
"Number of completion candidates below which cycling is used.
@ -2951,7 +2924,7 @@ This calls the function that `completion-in-region-function' specifies
\(passing the same four arguments that it received) to do the work,
and returns whatever it does. The return value should be nil
if there was no valid completion, else t."
(cl-assert (<= start (point)) (<= (point) end))
(cl-assert (<= start (point) end) t)
(funcall completion-in-region-function start end collection predicate))
(defcustom read-file-name-completion-ignore-case

18
lisp/org/org-compat.el
View file

@ -292,10 +292,20 @@ older than 27.1"
(if tree (push tree elems))
(nreverse elems))))
(if (version< emacs-version "27.1")
(defsubst org-replace-buffer-contents (source &optional _max-secs _max-costs)
(replace-buffer-contents source))
(defalias 'org-replace-buffer-contents #'replace-buffer-contents))
(defalias 'org-replace-region-contents
(if (> emacs-major-version 30)
#'replace-region-contents
;; The `replace-region-contents' in Emacs<31 does not accept a buffer
;; as SOURCE argument and does not preserve the position well enough.
(lambda (beg end source &optional max-secs max-costs)
(save-restriction
(narrow-to-region beg end)
(let ((eobp (eobp)))
(with-no-warnings
(if (< emacs-major-version 27)
(replace-buffer-contents source)
(replace-buffer-contents source max-secs max-costs)))
(if eobp (goto-char (point-max))))))))
(unless (fboundp 'proper-list-p)
;; `proper-list-p' was added in Emacs 27.1. The function below is

21
lisp/org/org-src.el
View file

@ -1414,13 +1414,9 @@ EVENT is passed to `mouse-set-point'."
;; insert new contents.
(delete-overlay overlay)
(let ((expecting-bol (bolp)))
(if (version< emacs-version "27.1")
(progn (delete-region beg end)
(insert (with-current-buffer write-back-buf (buffer-string))))
(save-restriction
(narrow-to-region beg end)
(org-replace-buffer-contents write-back-buf 0.1 nil)
(goto-char (point-max))))
(goto-char end)
(org-replace-region-contents beg end write-back-buf 0.1 nil)
(cl-assert (= (point) (+ beg (buffer-size write-back-buf))))
(when (and expecting-bol (not (bolp))) (insert "\n")))
(kill-buffer write-back-buf)
(save-buffer)
@ -1461,14 +1457,9 @@ EVENT is passed to `mouse-set-point'."
(undo-boundary)
(goto-char beg)
(let ((expecting-bol (bolp)))
(if (version< emacs-version "27.1")
(progn (delete-region beg end)
(insert (with-current-buffer write-back-buf
(buffer-string))))
(save-restriction
(narrow-to-region beg end)
(org-replace-buffer-contents write-back-buf 0.1 nil)
(goto-char (point-max))))
(goto-char end)
(org-replace-region-contents beg end write-back-buf 0.1 nil)
(cl-assert (= (point) (+ beg (buffer-size write-back-buf))))
(when (and expecting-bol (not (bolp))) (insert "\n")))))
(when write-back-buf (kill-buffer write-back-buf))
;; If we are to return to source buffer, put point at an

25
lisp/progmodes/eglot.el
View file

@ -3839,17 +3839,20 @@ If SILENT, don't echo progress in mode-line."
0 howmany)))
(done 0))
(mapc (pcase-lambda (`(,newText ,beg . ,end))
(let ((source (current-buffer)))
(with-temp-buffer
(insert newText)
(let ((temp (current-buffer)))
(with-current-buffer source
(save-excursion
(save-restriction
(narrow-to-region beg end)
(replace-buffer-contents temp)))
(when reporter
(eglot--reporter-update reporter (cl-incf done))))))))
(if (> emacs-major-version 30)
(replace-region-contents beg end newText)
(let ((source (current-buffer)))
(with-temp-buffer
(insert newText)
(let ((temp (current-buffer)))
(with-current-buffer source
(save-excursion
(save-restriction
(narrow-to-region beg end)
(with-no-warnings
(replace-buffer-contents temp)))))))))
(when reporter
(eglot--reporter-update reporter (cl-incf done))))
(mapcar (lambda (edit)
(eglot--dcase edit
(((TextEdit) range newText)

14
lisp/progmodes/flymake-proc.el
View file

@ -331,7 +331,7 @@ max-level parent dirs. File contents are not checked."
(setq dirs (cdr dirs)))
(when files
(let ((flymake-proc--included-file-name (file-name-nondirectory file-name)))
(setq files (sort files 'flymake-proc--master-file-compare))))
(setq files (sort files #'flymake-proc--master-file-compare))))
(flymake-log 3 "found %d possible master file(s)" (length files))
files))
@ -407,9 +407,10 @@ instead of reading master file from disk."
;; replace-match is not used here as it fails in
;; XEmacs with 'last match not a buffer' error as
;; check-includes calls replace-in-string
(flymake-proc--replace-region
(replace-region-contents
match-beg match-end
(file-name-nondirectory patched-source-file-name))))
(file-name-nondirectory patched-source-file-name)
0)))
(forward-line 1)))
(when found
(flymake-proc--save-buffer-in-file patched-master-file-name)))
@ -424,11 +425,8 @@ instead of reading master file from disk."
;;; XXX: remove
(defun flymake-proc--replace-region (beg end rep)
"Replace text in BUFFER in region (BEG END) with REP."
(save-excursion
(goto-char end)
;; Insert before deleting, so as to better preserve markers's positions.
(insert rep)
(delete-region beg end)))
(declare (obsolete replace-region-contents "31"))
(replace-region-contents beg end rep 0))
(defun flymake-proc--read-file-to-temp-buffer (file-name)
"Insert contents of FILE-NAME into newly created temp buffer."

2
lisp/progmodes/python.el
View file

@ -6931,7 +6931,7 @@ Return non-nil if the buffer was actually modified."
(unless (eq 0 status)
(error "%s exited with status %s (maybe isort is missing?)"
python-interpreter status))
(replace-buffer-contents temp)
(replace-region-contents (point-min) (point-max) temp)
(not (eq tick (buffer-chars-modified-tick)))))))))
;;;###autoload

17
lisp/subr.el
View file

@ -4762,6 +4762,19 @@ Point in BUFFER will be placed after the inserted text."
(with-current-buffer buffer
(insert-buffer-substring current start end))))
(defun replace-buffer-contents (source &optional max-secs max-costs)
"Replace accessible portion of current buffer with that of SOURCE.
SOURCE can be a buffer or a string that names a buffer.
Interactively, prompt for SOURCE.
The replacement is performed using `replace-region-contents'
which also describes the MAX-SECS and MAX-COSTS arguments and the
return value."
(declare (obsolete replace-region-contents "31.1"))
(interactive "bSource buffer: ")
(replace-region-contents (point-min) (point-max) (get-buffer source)
max-secs max-costs))
(defun replace-string-in-region (string replacement &optional start end)
"Replace STRING with REPLACEMENT in the region from START to END.
The number of replaced occurrences are returned, or nil if STRING
@ -4785,8 +4798,8 @@ Comparisons and replacements are done with fixed case."
(let ((matches 0)
(case-fold-search nil))
(while (search-forward string nil t)
(delete-region (match-beginning 0) (match-end 0))
(insert replacement)
(replace-region-contents (match-beginning 0) (match-end 0)
replacement 0)
(setq matches (1+ matches)))
(and (not (zerop matches))
matches)))))

2
lisp/vc/vc.el
View file

@ -1970,7 +1970,7 @@ of NEW (without destroying existing markers), swapping their text
objects, and finally killing buffer ORIGINAL."
(with-current-buffer original
(let ((inhibit-read-only t))
(replace-buffer-contents new)))
(replace-region-contents (point-min) (point-max) new)))
(with-current-buffer new
(buffer-swap-text original))
(kill-buffer original))

2
src/coding.c
View file

@ -7898,6 +7898,8 @@ code_conversion_save (bool with_work_buf, bool multibyte)
bset_enable_multibyte_characters (current_buffer, multibyte ? Qt : Qnil);
if (EQ (workbuf, Vcode_conversion_reused_workbuf))
reused_workbuf_in_use = true;
/* FIXME: Maybe we should stay in the new workbuf, because we often
switch right back to it anyway in order to initialize it further. */
set_buffer_internal (current);
}

150
src/editfns.c
View file

@ -54,6 +54,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "buffer.h"
#include "window.h"
#include "blockinput.h"
#include "coding.h"
#ifdef WINDOWSNT
# include "w32common.h"
@ -1914,11 +1915,14 @@ static bool compareseq_early_abort (struct context *);
#include "minmax.h"
#include "diffseq.h"
DEFUN ("replace-buffer-contents", Freplace_buffer_contents,
Sreplace_buffer_contents, 1, 3, "bSource buffer: ",
doc: /* Replace accessible portion of current buffer with that of SOURCE.
SOURCE can be a buffer or a string that names a buffer.
Interactively, prompt for SOURCE.
DEFUN ("replace-region-contents", Freplace_region_contents,
Sreplace_region_contents, 3, 6, 0,
doc: /* Replace the region between BEG and END with that of SOURCE.
SOURCE can be a buffer, a string, or a vector [SBUF SBEG SEND]
denoting the subtring SBEG..SEND of buffer SBUF.
If optional argument INHERIT is non-nil, the inserted text will inherit
properties from adjoining text.
As far as possible the replacement is non-destructive, i.e. existing
buffer contents, markers, properties, and overlays in the current
@ -1940,18 +1944,85 @@ computation. If the actual costs exceed this limit, heuristics are
used to provide a faster but suboptimal solution. The default value
is 1000000.
Note: If the replacement is a string, it’ll usually be placed internally
in a temporary buffer. Therefore, all else being equal, it is preferable
to pass a buffer rather than a string as SOURCE argument.
This function returns t if a non-destructive replacement could be
performed. Otherwise, i.e., if MAX-SECS was exceeded, it returns
nil. */)
(Lisp_Object source, Lisp_Object max_secs, Lisp_Object max_costs)
nil.
SOURCE can also be a function that will be called with no arguments
and with current buffer narrowed to BEG..END, and should return
a buffer or a string. But this is deprecated. */)
(Lisp_Object beg, Lisp_Object end, Lisp_Object source,
Lisp_Object max_secs, Lisp_Object max_costs, Lisp_Object inherit)
{
struct buffer *a = current_buffer;
Lisp_Object source_buffer = Fget_buffer (source);
if (NILP (source_buffer))
nsberror (source);
struct buffer *b = XBUFFER (source_buffer);
if (! BUFFER_LIVE_P (b))
validate_region (&beg, &end);
ptrdiff_t min_a = XFIXNUM (beg);
ptrdiff_t size_a = XFIXNUM (end) - min_a;
eassume (size_a >= 0);
bool a_empty = size_a == 0;
bool inh = !NILP (inherit);
if (FUNCTIONP (source))
{
specpdl_ref count = SPECPDL_INDEX ();
record_unwind_protect (save_restriction_restore,
save_restriction_save ());
Fnarrow_to_region (beg, end);
source = calln (source);
unbind_to (count, Qnil);
}
ptrdiff_t min_b, size_b;
struct buffer *b;
if (STRINGP (source))
{
min_b = BEG; /* Assuming we'll copy it into a buffer. */
size_b = SCHARS (source);
b = NULL;
}
else if (BUFFERP (source))
{
b = XBUFFER (source);
min_b = BUF_BEGV (b);
size_b = BUF_ZV (b) - min_b;
}
else
{
CHECK_TYPE (VECTORP (source),
list (Qor, Qstring, Qbuffer, Qvector), source);
/* Let `Faref' signal an error if it's too small. */
Lisp_Object send = Faref (source, make_fixnum (2));
Lisp_Object sbeg = AREF (source, 1);
CHECK_BUFFER (AREF (source, 0));
b = XBUFFER (AREF (source, 0));
specpdl_ref count = SPECPDL_INDEX ();
record_unwind_current_buffer ();
set_buffer_internal (b);
validate_region (&sbeg, &send);
unbind_to (count, Qnil);
min_b = XFIXNUM (sbeg);
size_b = XFIXNUM (send) - min_b;
}
bool b_empty = size_b == 0;
if (b && !BUFFER_LIVE_P (b))
error ("Selecting deleted buffer");
/* Handle trivial cases where at least one accessible portion is
empty. */
if (a_empty && b_empty)
return Qt;
else if (a_empty || b_empty
|| EQ (max_secs, make_fixnum (0))
|| EQ (max_costs, make_fixnum (0)))
{
replace_range (min_a, min_a + size_a, source, true, false, inh);
return Qt;
}
struct buffer *a = current_buffer;
if (a == b)
error ("Cannot replace a buffer with itself");
@ -1977,36 +2048,8 @@ nil. */)
time_limit = tlim;
}
ptrdiff_t min_a = BEGV;
ptrdiff_t min_b = BUF_BEGV (b);
ptrdiff_t size_a = ZV - min_a;
ptrdiff_t size_b = BUF_ZV (b) - min_b;
eassume (size_a >= 0);
eassume (size_b >= 0);
bool a_empty = size_a == 0;
bool b_empty = size_b == 0;
/* Handle trivial cases where at least one accessible portion is
empty. */
if (a_empty && b_empty)
return Qt;
if (a_empty)
{
Finsert_buffer_substring (source, Qnil, Qnil);
return Qt;
}
if (b_empty)
{
del_range_both (BEGV, BEGV_BYTE, ZV, ZV_BYTE, true);
return Qt;
}
specpdl_ref count = SPECPDL_INDEX ();
ptrdiff_t diags = size_a + size_b + 3;
ptrdiff_t del_bytes = size_a / CHAR_BIT + 1;
ptrdiff_t ins_bytes = size_b / CHAR_BIT + 1;
@ -2020,6 +2063,18 @@ nil. */)
unsigned char *deletions_insertions = memset (buffer + 2 * diags, 0,
del_bytes + ins_bytes);
/* The rest of the code is not prepared to handle a string SOURCE. */
if (!b)
{
Lisp_Object workbuf
= code_conversion_save (true, STRING_MULTIBYTE (source));
b = XBUFFER (workbuf);
set_buffer_internal (b);
CALLN (Finsert, source);
set_buffer_internal (a);
}
Lisp_Object source_buffer = make_lisp_ptr (b, Lisp_Vectorlike);
/* FIXME: It is not documented how to initialize the contents of the
context structure. This code cargo-cults from the existing
caller in src/analyze.c of GNU Diffutils, which appears to
@ -2053,7 +2108,7 @@ nil. */)
Lisp_Object src = CALLN (Fvector, source_buffer,
make_fixnum (BUF_BEGV (b)),
make_fixnum (BUF_ZV (b)));
replace_range (BEGV, ZV, src, true, false, false);
replace_range (min_a, min_a + size_a, src, true, false, inh);
SAFE_FREE_UNBIND_TO (count, Qnil);
return Qnil;
}
@ -2069,7 +2124,7 @@ nil. */)
modification hooks, because then they don't want that. */
if (!inhibit_modification_hooks)
{
prepare_to_modify_buffer (BEGV, ZV, NULL);
prepare_to_modify_buffer (min_a, min_a + size_a, NULL);
specbind (Qinhibit_modification_hooks, Qt);
modification_hooks_inhibited = true;
}
@ -2102,10 +2157,9 @@ nil. */)
eassert (beg_a <= end_a);
eassert (beg_b <= end_b);
eassert (beg_a < end_a || beg_b < end_b);
/* FIXME: Use 'replace_range'! */
ASET (src, 1, make_fixed_natnum (beg_b));
ASET (src, 2, make_fixed_natnum (end_b));
replace_range (beg_a, end_a, src, true, false, false);
replace_range (beg_a, end_a, src, true, false, inh);
}
--i;
--j;
@ -2115,8 +2169,8 @@ nil. */)
if (modification_hooks_inhibited)
{
signal_after_change (BEGV, size_a, ZV - BEGV);
update_compositions (BEGV, ZV, CHECK_INSIDE);
signal_after_change (min_a, size_a, size_b);
update_compositions (min_a, min_a + size_b, CHECK_INSIDE);
/* We've locked the buffer's file above in
prepare_to_modify_buffer; if the buffer is unchanged at this
point, i.e. no insertions or deletions have been made, unlock
@ -4787,7 +4841,7 @@ it to be non-nil. */);
defsubr (&Sinsert_buffer_substring);
defsubr (&Scompare_buffer_substrings);
defsubr (&Sreplace_buffer_contents);
defsubr (&Sreplace_region_contents);
defsubr (&Ssubst_char_in_region);
defsubr (&Stranslate_region_internal);
defsubr (&Sdelete_region);

31
src/insdel.c
View file

@ -348,12 +348,20 @@ adjust_markers_for_replace (ptrdiff_t from, ptrdiff_t from_byte,
ptrdiff_t diff_chars = new_chars - old_chars;
ptrdiff_t diff_bytes = new_bytes - old_bytes;
if (old_chars == 0)
{
/* Just an insertion: markers at FROM may need to move or not depending
on their marker type. Delegate this special case to
'adjust_markers_for_insert' so the loop below can remain oblivious
to marker types. */
adjust_markers_for_insert (from, from_byte,
from + new_chars, from_byte + new_bytes,
false);
return;
}
adjust_suspend_auto_hscroll (from, from + old_chars);
/* FIXME: When OLD_CHARS is 0, this "replacement" is really just an
insertion, but the behavior we provide here in that case is that of
`insert-before-markers` rather than that of `insert`.
Maybe not a bug, but not a feature either. */
for (m = BUF_MARKERS (current_buffer); m; m = m->next)
{
if (m->bytepos >= prev_to_byte)
@ -371,8 +379,7 @@ adjust_markers_for_replace (ptrdiff_t from, ptrdiff_t from_byte,
check_markers ();
adjust_overlays_for_insert (from + old_chars, new_chars, true);
if (old_chars)
adjust_overlays_for_delete (from, old_chars);
adjust_overlays_for_delete (from, old_chars);
}
/* Starting at POS (BYTEPOS), find the byte position corresponding to
@ -1409,9 +1416,9 @@ adjust_after_insert (ptrdiff_t from, ptrdiff_t from_byte,
adjust_after_replace (from, from_byte, Qnil, newlen, len_byte);
}
/* Replace the text from character positions FROM to TO with NEW.
NEW could either be a string, the replacement text, or a vector
[BUFFER BEG END], where BUFFER is the buffer with the replacement
/* Replace the text from character positions FROM to TO with the
replacement text NEW. NEW could either be a string, a buffer, or
a vector [BUFFER BEG END], where BUFFER is the buffer with the replacement
text and BEG and END are buffer positions in BUFFER that give the
replacement text beginning and end.
If PREPARE, call prepare_to_modify_buffer.
@ -1439,6 +1446,12 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new,
insbeg = 0;
inschars = SCHARS (new);
}
else if (BUFFERP (new))
{
insbuf = XBUFFER (new);
insbeg = BUF_BEGV (insbuf);
inschars = BUF_ZV (insbuf) - insbeg;
}
else
{
CHECK_VECTOR (new);

82
test/src/editfns-tests.el
View file

@ -289,7 +289,7 @@
(narrow-to-region 8 13)
(goto-char 12)
(should (looking-at " \\'"))
(replace-buffer-contents source)
(replace-region-contents (point-min) (point-max) source)
(should (looking-at " \\'")))
(should (equal (marker-buffer marker) (current-buffer)))
(should (equal (marker-position marker) 16)))
@ -306,7 +306,7 @@
(let ((source (current-buffer)))
(with-temp-buffer
(insert "foo BAR baz qux")
(replace-buffer-contents source)
(replace-region-contents (point-min) (point-max) source)
(should (equal-including-properties
(buffer-string)
"foo bar baz qux"))))))
@ -318,44 +318,58 @@
(switch-to-buffer "b")
(insert-char (char-from-name "SMILE"))
(insert "5678")
(replace-buffer-contents "a")
(replace-region-contents (point-min) (point-max) (get-buffer "a"))
(should (equal (buffer-substring-no-properties (point-min) (point-max))
(concat (string (char-from-name "SMILE")) "1234"))))
(defun editfns--replace-region (from to string)
(save-excursion
(save-restriction
(narrow-to-region from to)
(let ((buf (current-buffer)))
(with-temp-buffer
(let ((str-buf (current-buffer)))
(insert string)
(with-current-buffer buf
(replace-buffer-contents str-buf))))))))
(ert-deftest editfns-tests--replace-region ()
;; :expected-result :failed
(with-temp-buffer
(insert "here is some text")
(let ((m5n (copy-marker (+ (point-min) 5)))
(m5a (copy-marker (+ (point-min) 5) t))
(m6n (copy-marker (+ (point-min) 6)))
(m6a (copy-marker (+ (point-min) 6) t))
(m7n (copy-marker (+ (point-min) 7)))
(m7a (copy-marker (+ (point-min) 7) t)))
(editfns--replace-region (+ (point-min) 5) (+ (point-min) 7) "be")
(should (equal (buffer-string) "here be some text"))
(should (equal (point) (point-max)))
;; Markers before the replaced text stay before.
(should (= m5n (+ (point-min) 5)))
(should (= m5a (+ (point-min) 5)))
;; Markers in the replaced text can end up at either end, depending
;; on whether they're advance-after-insert or not.
(should (= m6n (+ (point-min) 5)))
(should (<= (+ (point-min) 5) m6a (+ (point-min) 7)))
;; Markers after the replaced text stay after.
(should (= m7n (+ (point-min) 7)))
(should (= m7a (+ (point-min) 7))))))
(let ((tmpbuf (current-buffer)))
(insert " be ")
(narrow-to-region (+ (point-min) 2) (- (point-max) 2))
(dolist (args `((,tmpbuf)
(,(vector tmpbuf (point-min) (point-max)))
(,"be")
(,(vector tmpbuf (point-min) (point-max)) 0)
(,"be" 0)))
(with-temp-buffer
(insert "here is some text")
(let ((m5n (copy-marker (+ (point-min) 5)))
(m5a (copy-marker (+ (point-min) 5) t))
(m6n (copy-marker (+ (point-min) 6)))
(m6a (copy-marker (+ (point-min) 6) t))
(m7n (copy-marker (+ (point-min) 7)))
(m7a (copy-marker (+ (point-min) 7) t)))
(apply #'replace-region-contents
(+ (point-min) 5) (+ (point-min) 7) args)
(should (equal (buffer-string) "here be some text"))
(should (equal (point) (point-max)))
;; Markers before the replaced text stay before.
(should (= m5n (+ (point-min) 5)))
(should (= m5a (+ (point-min) 5)))
;; Markers in the replaced text can end up at either end, depending
;; on whether they're advance-after-insert or not.
(should (= m6n (+ (point-min) 5)))
(should (<= (+ (point-min) 5) m6a (+ (point-min) 7)))
;; Markers after the replaced text stay after.
(should (= m7n (+ (point-min) 7)))
(should (= m7a (+ (point-min) 7)))))
(widen)))))
(ert-deftest editfns-tests--insert-via-replace ()
(with-temp-buffer
(insert "bar")
(goto-char (point-min))
;; Check that markers insertion type is respected when an insertion
;; happens via a "replace" operation.
(let ((m1 (copy-marker (point) nil))
(m2 (copy-marker (point) t)))
(looking-at "\\(\\)")
(replace-match "foo")
(should (equal "foobar" (buffer-string)))
(should (= (point-min) m1))
(should (= (+ (point-min) 3) m2)))))
(ert-deftest delete-region-undo-markers-1 ()
"Make sure we don't end up with freed markers reachable from Lisp."