From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Juri Linkov Newsgroups: gmane.emacs.bugs Subject: bug#19829: 25.0.50; query-replace in rectangle regions do not honor boundaries Date: Wed, 18 Feb 2015 20:30:22 +0200 Organization: LINKOV.NET Message-ID: <87r3tnax8h.fsf@mail.linkov.net> References: <87r3txhkz1.fsf@ceis-strat.com> <87twyt5o8q.fsf@mail.linkov.net> <874mqsq6ar.fsf@mail.linkov.net> <87zj8iljfk.fsf@mail.linkov.net> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: ger.gmane.org 1424284337 5535 80.91.229.3 (18 Feb 2015 18:32:17 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Wed, 18 Feb 2015 18:32:17 +0000 (UTC) Cc: Bastien , 19829@debbugs.gnu.org To: Stefan Monnier Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Wed Feb 18 19:32:10 2015 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1YO9Pt-00069A-UE for geb-bug-gnu-emacs@m.gmane.org; Wed, 18 Feb 2015 19:32:10 +0100 Original-Received: from localhost ([::1]:52225 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YO9Pt-0005ON-6k for geb-bug-gnu-emacs@m.gmane.org; Wed, 18 Feb 2015 13:32:09 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:52091) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YO9Pp-0005OI-Sc for bug-gnu-emacs@gnu.org; Wed, 18 Feb 2015 13:32:07 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1YO9Pm-0000hJ-Mk for bug-gnu-emacs@gnu.org; Wed, 18 Feb 2015 13:32:05 -0500 Original-Received: from debbugs.gnu.org ([140.186.70.43]:56764) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YO9Pm-0000hF-K3 for bug-gnu-emacs@gnu.org; Wed, 18 Feb 2015 13:32:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1YO9Pl-0005Ip-O0 for bug-gnu-emacs@gnu.org; Wed, 18 Feb 2015 13:32:01 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Juri Linkov Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 18 Feb 2015 18:32:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 19829 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 19829-submit@debbugs.gnu.org id=B19829.142428427820332 (code B ref 19829); Wed, 18 Feb 2015 18:32:01 +0000 Original-Received: (at 19829) by debbugs.gnu.org; 18 Feb 2015 18:31:18 +0000 Original-Received: from localhost ([127.0.0.1]:48004 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1YO9P4-0005Hr-0j for submit@debbugs.gnu.org; Wed, 18 Feb 2015 13:31:18 -0500 Original-Received: from ps18281.dreamhost.com ([69.163.222.226]:40553 helo=ps18281.dreamhostps.com) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1YO9P0-0005Hi-GU for 19829@debbugs.gnu.org; Wed, 18 Feb 2015 13:31:15 -0500 Original-Received: from localhost.linkov.net (ps18281.dreamhostps.com [69.163.222.226]) by ps18281.dreamhostps.com (Postfix) with ESMTP id A9419300828EEB; Wed, 18 Feb 2015 10:31:12 -0800 (PST) In-Reply-To: (Stefan Monnier's message of "Fri, 13 Feb 2015 22:59:11 -0500") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.0.50 (x86_64-pc-linux-gnu) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:99554 Archived-At: > 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: (\\\\[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