GNU bug report logs - #19829
25.0.50; query-replace in rectangle regions do not honor boundaries

Previous Next

Full log

Message #23 received at 19829 <at> debbugs.gnu.org (full text, mbox):

From: Juri Linkov <juri <at> linkov.net>
To: Stefan Monnier <monnier <at> IRO.UMontreal.CA>
Cc: Bastien <bzg <at> gnu.org>, 19829 <at> debbugs.gnu.org
Subject: Re: bug#19829: 25.0.50;
 query-replace in rectangle regions do not honor boundaries
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

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.