Subject: Re: bug#19829: 25.0.50; query-replace in rectangle regions do not honor boundaries

From: Juri Linkov <[email-masked]>
Date: Wed, 18 Feb 2015 20:30:22 +0200

> That would also work, yes.  We could make region-extract-function accept
> yet another value of its argument (say `positions') such that instead of
> returning the textual content, it just returns a list of
> (START . END) bounds.

Now this is ready.  The first part of the patch adds a new argument
`positions' to `region-extract-function', and the second part for
replace.el uses it in `perform-replace':

diff --git a/lisp/simple.el b/lisp/simple.el
index 25293ed..34b8bb4 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -956,11 +956,15 @@ (defcustom delete-active-region t
   :version "24.1")
 
 (defvar region-extract-function
-  (lambda (delete)
+  (lambda (delete &optional positions)
     (when (region-beginning)
-      (if (eq delete 'delete-only)
-          (delete-region (region-beginning) (region-end))
-        (filter-buffer-substring (region-beginning) (region-end) delete))))
+      (cond
+       (positions
+        (list (cons (region-beginning) (region-end))))
+       ((eq delete 'delete-only)
+        (delete-region (region-beginning) (region-end)))
+       (t
+        (filter-buffer-substring (region-beginning) (region-end) delete)))))
   "Function to get the region's content.
 Called with one argument DELETE.
 If DELETE is `delete-only', then only delete the region and the return value
diff --git a/lisp/rect.el b/lisp/rect.el
index c5a5486..7bb017d 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -216,6 +216,14 @@ (defun extract-rectangle-line (startcol endcol lines)
 			   (spaces-string endextra))))
     (setcdr lines (cons line (cdr lines)))))
 
+(defun extract-rectangle-position (startcol endcol positions)
+  (let (start end)
+    (move-to-column startcol)
+    (setq start (point))
+    (move-to-column endcol)
+    (setq end (point))
+    (setcdr positions (cons (cons start end) (cdr positions)))))
+
 (defconst spaces-strings
   '["" " " "  " "   " "    " "     " "      " "       " "        "])
 
@@ -257,6 +265,15 @@ (defun extract-rectangle (start end)
     (apply-on-rectangle 'extract-rectangle-line start end lines)
     (nreverse (cdr lines))))
 
+(defun extract-rectangle-positions (start end)
+  "Return the positions of the rectangle with corners at START and END.
+Return it as a list of (START . END) bounds, one for each line of
+the rectangle."
+  (let ((positions (list nil)))
+    (apply-on-rectangle 'extract-rectangle-position
+                        start end positions)
+    (nreverse (cdr positions))))
+
 (defvar killed-rectangle nil
   "Rectangle for `yank-rectangle' to insert.")
 
@@ -680,9 +697,13 @@ (defun rectangle-previous-line (&optional n)
     (rectangle--col-pos col 'point)))

-(defun rectangle--extract-region (orig &optional delete)
-  (if (not rectangle-mark-mode)
-      (funcall orig delete)
+(defun rectangle--extract-region (orig &optional delete positions)
+  (cond
+   ((not rectangle-mark-mode)
+    (funcall orig delete))
+   (positions
+    (extract-rectangle-positions (region-beginning) (region-end)))
+   (t
     (let* ((strs (funcall (if delete
                               #'delete-extract-rectangle
                             #'extract-rectangle)
@@ -696,7 +717,7 @@ (defun rectangle--extract-region (orig &optional delete)
         (put-text-property 0 (length str) 'yank-handler
                            `(rectangle--insert-for-yank ,strs t)
                            str)
-        str))))
+        str)))))
 
 (defun rectangle--insert-for-yank (strs)
   (push (point) buffer-undo-list)
diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index ea8b524..a631984 100644
--- a/lisp/emulation/cua-rect.el
+++ b/lisp/emulation/cua-rect.el
@@ -666,6 +666,22 @@ (defun cua--extract-rectangle ()
     	     (setq rect (cons row rect))))))
     (nreverse rect)))
 
+(defun cua--extract-rectangle-positions ()
+  (let (rect)
+    (if (not (cua--rectangle-virtual-edges))
+        (cua--rectangle-operation nil nil nil nil nil ; do not tabify
+          (lambda (s e _l _r)
+             (setq rect (cons (cons s e) rect))))
+      (cua--rectangle-operation nil 1 nil nil nil ; do not tabify
+        (lambda (s e l r _v)
+           (goto-char s)
+           (move-to-column l)
+           (setq s (point))
+           (move-to-column r)
+           (setq e (point))
+           (setq rect (cons (cons s e) rect)))))
+    (nreverse rect)))
+
 (defun cua--insert-rectangle (rect &optional below paste-column line-count)
   ;; Insert rectangle as insert-rectangle, but don't set mark and exit with
   ;; point at either next to top right or below bottom left corner
@@ -1403,10 +1419,14 @@ (defun cua--rectangle-highlight-for-redisplay (orig &rest args)
     ;; already do it elsewhere.
     (funcall redisplay-unhighlight-region-function (nth 3 args))))
 
-(defun cua--rectangle-region-extract (orig &optional delete)
+(defun cua--rectangle-region-extract (orig &optional delete positions)
   (cond
-   ((not cua--rectangle) (funcall orig delete))
-   ((eq delete 'delete-only) (cua--delete-rectangle))
+   ((not cua--rectangle)
+    (funcall orig delete))
+   (positions
+    (cua--extract-rectangle-positions))
+   ((eq delete 'delete-only)
+    (cua--delete-rectangle))
    (t
     (let* ((strs (cua--extract-rectangle))
            (str (mapconcat #'identity strs "\n")))

diff --git a/lisp/replace.el b/lisp/replace.el
index e0636e0..aec348f 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -2089,6 +2089,9 @@ (defun perform-replace (from-string replacements
 
          ;; If non-nil, it is marker saying where in the buffer to stop.
          (limit nil)
+         ;; Use local binding in add-function below.
+         (isearch-filter-predicate isearch-filter-predicate)
+         (rectangular-region-positions nil)
 
          ;; Data for the next match.  If a cons, it has the same format as
          ;; (match-data); otherwise it is t if a match is possible at point.
@@ -2101,6 +2104,24 @@ (defun perform-replace (from-string replacements
                       "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) ")
                      minibuffer-prompt-properties))))
 
+    ;; If rectangle is active, operate on rectangular region.
+    (when (and (boundp 'rectangle-mark-mode) rectangle-mark-mode)
+      (setq rectangular-region-positions
+            (mapcar (lambda (position)
+                      (cons (copy-marker (car position))
+                            (copy-marker (cdr position))))
+                    (funcall region-extract-function nil t)))
+      (add-function :after-while isearch-filter-predicate
+                    (lambda (start end)
+                      (delq nil (mapcar
+                                 (lambda (positions)
+                                   (and
+                                    (>= start (car positions))
+                                    (<= start (cdr positions))
+                                    (>= end   (car positions))
+                                    (<= end   (cdr positions))))
+                                 rectangular-region-positions)))))
+
     ;; If region is active, in Transient Mark mode, operate on region.
     (if backward
 	(when end