all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: Juri Linkov <juri@linkov.net>
To: Stefan Monnier <monnier@IRO.UMontreal.CA>
Cc: Bastien <bzg@gnu.org>, 19829@debbugs.gnu.org
Subject: bug#19829: 25.0.50; query-replace in rectangle regions do not honor boundaries
Date: Wed, 18 Feb 2015 20:30:22 +0200	[thread overview]
Message-ID: <87r3tnax8h.fsf@mail.linkov.net> (raw)
In-Reply-To: <jwv61b5kuw9.fsf-monnier+emacsbugs@gnu.org> (Stefan Monnier's message of "Fri, 13 Feb 2015 22:59:11 -0500")

> 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





  reply	other threads:[~2015-02-18 18:30 UTC|newest]

Thread overview: 25+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2015-02-10 14:58 bug#19829: 25.0.50; query-replace in rectangle regions do not honor boundaries Bastien
2015-02-10 23:40 ` Juri Linkov
2015-02-12  0:57   ` Juri Linkov
2015-02-12 14:33     ` Stefan Monnier
2015-02-13  0:54       ` Juri Linkov
2015-02-14  3:59         ` Stefan Monnier
2015-02-18 18:30           ` Juri Linkov [this message]
2015-02-18 22:56             ` Stefan Monnier
2015-02-19 19:12               ` Juri Linkov
2015-02-19 21:29                 ` Stefan Monnier
2015-02-23 19:19                   ` Juri Linkov
2015-03-11 20:31                     ` Stefan Monnier
2015-03-12 19:19                       ` Juri Linkov
2015-03-13  1:04                         ` Stefan Monnier
2015-06-30 20:42                       ` bug#19829: 25.0.50; Design of commands operating on rectangular regions Juri Linkov
2015-07-01  2:29                         ` Stefan Monnier
2015-07-01 22:17                           ` Juri Linkov
2015-07-02  3:02                             ` Stefan Monnier
2015-07-02 22:40                               ` Juri Linkov
2015-07-07 12:20                                 ` Stefan Monnier
2015-07-07 22:12                                   ` Juri Linkov
2015-07-07 21:27                         ` Richard Stallman
2015-07-07 22:15                           ` Juri Linkov
2015-02-19 14:27             ` bug#19829: 25.0.50; query-replace in rectangle regions do not honor boundaries Bastien
2015-11-13 23:32 ` Juri Linkov

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87r3tnax8h.fsf@mail.linkov.net \
    --to=juri@linkov.net \
    --cc=19829@debbugs.gnu.org \
    --cc=bzg@gnu.org \
    --cc=monnier@IRO.UMontreal.CA \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.