aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2025-03-28 01:01:17 -0400
committerStefan Monnier2025-03-29 17:49:49 -0400
commit1d07a6d7e34677be1653b1d4d464ff00cabfa102 (patch)
tree9f27c30bd71b3ab9f7f5ed14e31f66e6b0fa85a6
parent468c2aebae0ee13273f4b06e92f4188c4c46d2b3 (diff)
downloademacs-1d07a6d7e34677be1653b1d4d464ff00cabfa102.tar.gz
emacs-1d07a6d7e34677be1653b1d4d464ff00cabfa102.zip
Use `replace-region-contents` to replace insert+delete
* lisp/minibuffer.el (completion--replace): * lisp/emacs-lisp/cl-lib.el (cl--set-buffer-substring): * lisp/subr.el (replace-string-in-region): Use `replace-region-contents` instead of insert+delete. * lisp/help-fns.el (help-fns--signature): Use `replace-region-contents` instead of `cl--set-buffer-substring`. * lisp/language/japan-util.el (japanese-replace-region): Rewrite using `replace-region-contents` and mark obsolete. (japanese-katakana-region, japanese-hankaku-region): Use `replace-region-contents` instead. * lisp/progmodes/flymake-proc.el (flymake-proc--replace-region): Rewrite using `replace-region-contents` and mark obsolete. (flymake-proc--check-patch-master-file-buffer): Use `replace-region-contents` instead.
-rw-r--r--lisp/emacs-lisp/cl-lib.el8
-rw-r--r--lisp/emacs-lisp/gv.el2
-rw-r--r--lisp/help-fns.el2
-rw-r--r--lisp/language/japan-util.el43
-rw-r--r--lisp/minibuffer.el33
-rw-r--r--lisp/progmodes/flymake-proc.el14
-rw-r--r--lisp/subr.el4
7 files changed, 42 insertions, 64 deletions
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 4208160bd12..4645b4dffb1 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -154,12 +154,10 @@ to an element already in the list stored in PLACE.
154 `(setq ,place (cl-adjoin ,x ,place ,@keys))) 154 `(setq ,place (cl-adjoin ,x ,place ,@keys)))
155 `(cl-callf2 cl-adjoin ,x ,place ,@keys))) 155 `(cl-callf2 cl-adjoin ,x ,place ,@keys)))
156 156
157(defun cl--set-buffer-substring (start end val) 157(defun cl--set-buffer-substring (start end val &optional inherit)
158 "Delete region from START to END and insert VAL." 158 "Delete region from START to END and insert VAL."
159 (save-excursion (delete-region start end) 159 (replace-region-contents start end val 0 nil inherit)
160 (goto-char start) 160 val)
161 (insert val)
162 val))
163 161
164(defun cl--set-substring (str start end val) 162(defun cl--set-substring (str start end val)
165 (if end (if (< end 0) (incf end (length str))) 163 (if end (if (< end 0) (incf end (length str)))
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index b44f7dc87f3..6c949f1016b 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -684,6 +684,8 @@ REF must have been previously obtained with `gv-ref'."
684 `(insert (prog1 ,store (erase-buffer)))) 684 `(insert (prog1 ,store (erase-buffer))))
685(make-obsolete-generalized-variable 'buffer-string nil "29.1") 685(make-obsolete-generalized-variable 'buffer-string nil "29.1")
686 686
687;; FIXME: Can't use `replace-region-contents' because it's not
688;; expected to be costly, so we need to pass MAX-SECS==0.
687(gv-define-simple-setter buffer-substring cl--set-buffer-substring) 689(gv-define-simple-setter buffer-substring cl--set-buffer-substring)
688(make-obsolete-generalized-variable 'buffer-substring nil "29.1") 690(make-obsolete-generalized-variable 'buffer-substring nil "29.1")
689 691
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index cd5a0a6883f..dacf1ecbbd4 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -777,7 +777,7 @@ the C sources, too."
777 (save-excursion 777 (save-excursion
778 (forward-char -1) 778 (forward-char -1)
779 (<= (current-column) (- fill-column 12))) 779 (<= (current-column) (- fill-column 12)))
780 (cl--set-buffer-substring (- beg 3) beg " "))))) 780 (replace-region-contents (- beg 3) beg " " 0)))))
781 high-doc))))) 781 high-doc)))))
782 782
783(defun help-fns--parent-mode (function) 783(defun help-fns--parent-mode (function)
diff --git a/lisp/language/japan-util.el b/lisp/language/japan-util.el
index 718c469d562..6fbb52b627e 100644
--- a/lisp/language/japan-util.el
+++ b/lisp/language/japan-util.el
@@ -217,9 +217,9 @@ The argument object is not altered--the value is a copy."
217 217
218(defun japanese-replace-region (from to string) 218(defun japanese-replace-region (from to string)
219 "Replace the region specified by FROM and TO to STRING." 219 "Replace the region specified by FROM and TO to STRING."
220 (goto-char from) 220 (declare (obsolete replace-region-contents "31.1"))
221 (insert string) 221 (goto-char to)
222 (delete-char (- to from))) 222 (replace-region-contents from to string 0))
223 223
224;;;###autoload 224;;;###autoload
225(defun japanese-katakana-region (from to &optional hankaku) 225(defun japanese-katakana-region (from to &optional hankaku)
@@ -238,13 +238,15 @@ of which charset is `japanese-jisx0201-kana'."
238 (get-char-code-property kana 'kana-composition))) 238 (get-char-code-property kana 'kana-composition)))
239 slot) ;; next 239 slot) ;; next
240 (if (and composition (setq slot (assq (following-char) composition))) 240 (if (and composition (setq slot (assq (following-char) composition)))
241 (japanese-replace-region (match-beginning 0) (1+ (point)) 241 (progn
242 (cdr slot)) 242 (goto-char (1+ (point)))
243 (replace-region-contents (match-beginning 0) (point)
244 (cdr slot) 0))
243 (let ((kata (get-char-code-property 245 (let ((kata (get-char-code-property
244 kana (if hankaku 'jisx0201 'katakana)))) 246 kana (if hankaku 'jisx0201 'katakana))))
245 (if kata 247 (if kata
246 (japanese-replace-region (match-beginning 0) (point) 248 (replace-region-contents (match-beginning 0) (point)
247 kata))))))))) 249 kata 0)))))))))
248 250
249 251
250;;;###autoload 252;;;###autoload
@@ -260,13 +262,16 @@ of which charset is `japanese-jisx0201-kana'."
260 (composition (get-char-code-property kata 'kana-composition)) 262 (composition (get-char-code-property kata 'kana-composition))
261 slot) ;; next 263 slot) ;; next
262 (if (and composition (setq slot (assq (following-char) composition))) 264 (if (and composition (setq slot (assq (following-char) composition)))
263 (japanese-replace-region (match-beginning 0) (1+ (point)) 265 (progn
264 (get-char-code-property 266 (goto-char (1+ (point)))
265 (cdr slot) 'hiragana)) 267 (replace-region-contents (match-beginning 0) (point)
268 (get-char-code-property
269 (cdr slot) 'hiragana)
270 0))
266 (let ((hira (get-char-code-property kata 'hiragana))) 271 (let ((hira (get-char-code-property kata 'hiragana)))
267 (if hira 272 (if hira
268 (japanese-replace-region (match-beginning 0) (point) 273 (replace-region-contents (match-beginning 0) (point)
269 hira))))))))) 274 hira 0)))))))))
270 275
271;;;###autoload 276;;;###autoload
272(defun japanese-hankaku-region (from to &optional ascii-only) 277(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."
285 (get-char-code-property zenkaku 'jisx0201)) 290 (get-char-code-property zenkaku 'jisx0201))
286 (get-char-code-property zenkaku 'ascii)))) 291 (get-char-code-property zenkaku 'ascii))))
287 (if hankaku 292 (if hankaku
288 (japanese-replace-region (match-beginning 0) (match-end 0) 293 (replace-region-contents (match-beginning 0) (match-end 0)
289 hankaku))))))) 294 hankaku 0)))))))
290 295
291;;;###autoload 296;;;###autoload
292(defun japanese-zenkaku-region (from to &optional katakana-only) 297(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."
307 (composition (get-char-code-property hankaku 'kana-composition)) 312 (composition (get-char-code-property hankaku 'kana-composition))
308 slot) ;; next 313 slot) ;; next
309 (if (and composition (setq slot (assq (following-char) composition))) 314 (if (and composition (setq slot (assq (following-char) composition)))
310 (japanese-replace-region (match-beginning 0) (1+ (point)) 315 (progn
311 (cdr slot)) 316 (goto-char (1+ (point)))
317 (replace-region-contents (match-beginning 0) (point)
318 (cdr slot) 0))
312 (let ((zenkaku (japanese-zenkaku hankaku))) 319 (let ((zenkaku (japanese-zenkaku hankaku)))
313 (if zenkaku 320 (if zenkaku
314 (japanese-replace-region (match-beginning 0) (match-end 0) 321 (replace-region-contents (match-beginning 0) (match-end 0)
315 zenkaku))))))))) 322 zenkaku 0)))))))))
316 323
317;;;###autoload 324;;;###autoload
318(defun read-hiragana-string (prompt &optional initial-input) 325(defun read-hiragana-string (prompt &optional initial-input)
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index becb2a7faba..e9c064b89e8 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1398,35 +1398,8 @@ Moves point to the end of the new text."
1398 newtext) 1398 newtext)
1399 ;; Remove all text properties. 1399 ;; Remove all text properties.
1400 (set-text-properties 0 (length newtext) nil newtext)) 1400 (set-text-properties 0 (length newtext) nil newtext))
1401 ;; Maybe this should be in subr.el. 1401 (replace-region-contents beg end newtext 0.1 nil 'inherit)
1402 ;; You'd think this is trivial to do, but details matter if you want 1402 (goto-char (+ beg (length newtext))))
1403 ;; to keep markers "at the right place" and be robust in the face of
1404 ;; after-change-functions that may themselves modify the buffer.
1405 (let ((prefix-len 0))
1406 ;; Don't touch markers in the shared prefix (if any).
1407 (while (and (< prefix-len (length newtext))
1408 (< (+ beg prefix-len) end)
1409 (eq (char-after (+ beg prefix-len))
1410 (aref newtext prefix-len)))
1411 (setq prefix-len (1+ prefix-len)))
1412 (unless (zerop prefix-len)
1413 (setq beg (+ beg prefix-len))
1414 (setq newtext (substring newtext prefix-len))))
1415 (let ((suffix-len 0))
1416 ;; Don't touch markers in the shared suffix (if any).
1417 (while (and (< suffix-len (length newtext))
1418 (< beg (- end suffix-len))
1419 (eq (char-before (- end suffix-len))
1420 (aref newtext (- (length newtext) suffix-len 1))))
1421 (setq suffix-len (1+ suffix-len)))
1422 (unless (zerop suffix-len)
1423 (setq end (- end suffix-len))
1424 (setq newtext (substring newtext 0 (- suffix-len))))
1425 (goto-char beg)
1426 (let ((length (- end beg))) ;Read `end' before we insert the text.
1427 (insert-and-inherit newtext)
1428 (delete-region (point) (+ (point) length)))
1429 (forward-char suffix-len)))
1430 1403
1431(defcustom completion-cycle-threshold nil 1404(defcustom completion-cycle-threshold nil
1432 "Number of completion candidates below which cycling is used. 1405 "Number of completion candidates below which cycling is used.
@@ -2951,7 +2924,7 @@ This calls the function that `completion-in-region-function' specifies
2951\(passing the same four arguments that it received) to do the work, 2924\(passing the same four arguments that it received) to do the work,
2952and returns whatever it does. The return value should be nil 2925and returns whatever it does. The return value should be nil
2953if there was no valid completion, else t." 2926if there was no valid completion, else t."
2954 (cl-assert (<= start (point)) (<= (point) end)) 2927 (cl-assert (<= start (point) end) t)
2955 (funcall completion-in-region-function start end collection predicate)) 2928 (funcall completion-in-region-function start end collection predicate))
2956 2929
2957(defcustom read-file-name-completion-ignore-case 2930(defcustom read-file-name-completion-ignore-case
diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el
index df6571311e4..0418d9fd07c 100644
--- a/lisp/progmodes/flymake-proc.el
+++ b/lisp/progmodes/flymake-proc.el
@@ -331,7 +331,7 @@ max-level parent dirs. File contents are not checked."
331 (setq dirs (cdr dirs))) 331 (setq dirs (cdr dirs)))
332 (when files 332 (when files
333 (let ((flymake-proc--included-file-name (file-name-nondirectory file-name))) 333 (let ((flymake-proc--included-file-name (file-name-nondirectory file-name)))
334 (setq files (sort files 'flymake-proc--master-file-compare)))) 334 (setq files (sort files #'flymake-proc--master-file-compare))))
335 (flymake-log 3 "found %d possible master file(s)" (length files)) 335 (flymake-log 3 "found %d possible master file(s)" (length files))
336 files)) 336 files))
337 337
@@ -407,9 +407,10 @@ instead of reading master file from disk."
407 ;; replace-match is not used here as it fails in 407 ;; replace-match is not used here as it fails in
408 ;; XEmacs with 'last match not a buffer' error as 408 ;; XEmacs with 'last match not a buffer' error as
409 ;; check-includes calls replace-in-string 409 ;; check-includes calls replace-in-string
410 (flymake-proc--replace-region 410 (replace-region-contents
411 match-beg match-end 411 match-beg match-end
412 (file-name-nondirectory patched-source-file-name)))) 412 (file-name-nondirectory patched-source-file-name)
413 0)))
413 (forward-line 1))) 414 (forward-line 1)))
414 (when found 415 (when found
415 (flymake-proc--save-buffer-in-file patched-master-file-name))) 416 (flymake-proc--save-buffer-in-file patched-master-file-name)))
@@ -424,11 +425,8 @@ instead of reading master file from disk."
424;;; XXX: remove 425;;; XXX: remove
425(defun flymake-proc--replace-region (beg end rep) 426(defun flymake-proc--replace-region (beg end rep)
426 "Replace text in BUFFER in region (BEG END) with REP." 427 "Replace text in BUFFER in region (BEG END) with REP."
427 (save-excursion 428 (declare (obsolete replace-region-contents "31"))
428 (goto-char end) 429 (replace-region-contents beg end rep 0))
429 ;; Insert before deleting, so as to better preserve markers's positions.
430 (insert rep)
431 (delete-region beg end)))
432 430
433(defun flymake-proc--read-file-to-temp-buffer (file-name) 431(defun flymake-proc--read-file-to-temp-buffer (file-name)
434 "Insert contents of FILE-NAME into newly created temp buffer." 432 "Insert contents of FILE-NAME into newly created temp buffer."
diff --git a/lisp/subr.el b/lisp/subr.el
index 66b73cbf6cc..017ab3e16bb 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4798,8 +4798,8 @@ Comparisons and replacements are done with fixed case."
4798 (let ((matches 0) 4798 (let ((matches 0)
4799 (case-fold-search nil)) 4799 (case-fold-search nil))
4800 (while (search-forward string nil t) 4800 (while (search-forward string nil t)
4801 (delete-region (match-beginning 0) (match-end 0)) 4801 (replace-region-contents (match-beginning 0) (match-end 0)
4802 (insert replacement) 4802 replacement 0)
4803 (setq matches (1+ matches))) 4803 (setq matches (1+ matches)))
4804 (and (not (zerop matches)) 4804 (and (not (zerop matches))
4805 matches))))) 4805 matches)))))