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; Design of commands operating on rectangular regions Date: Tue, 30 Jun 2015 23:42:55 +0300 Organization: LINKOV.NET Message-ID: <87d20dszao.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> <87r3tnax8h.fsf@mail.linkov.net> <877fvdu34b.fsf@mail.linkov.net> <87mw44phaf.fsf@mail.linkov.net> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: ger.gmane.org 1435697065 29982 80.91.229.3 (30 Jun 2015 20:44:25 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 30 Jun 2015 20:44:25 +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 Tue Jun 30 22:44:14 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 1ZA2O6-0007SB-7e for geb-bug-gnu-emacs@m.gmane.org; Tue, 30 Jun 2015 22:44:14 +0200 Original-Received: from localhost ([::1]:48657 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZA2O5-0003Aw-6d for geb-bug-gnu-emacs@m.gmane.org; Tue, 30 Jun 2015 16:44:13 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:40405) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZA2O0-0002x4-Su for bug-gnu-emacs@gnu.org; Tue, 30 Jun 2015 16:44:11 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ZA2Nv-0006qr-Pd for bug-gnu-emacs@gnu.org; Tue, 30 Jun 2015 16:44:08 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:33360) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZA2Nv-0006qk-M6 for bug-gnu-emacs@gnu.org; Tue, 30 Jun 2015 16:44:03 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1ZA2Nv-0002V8-4I for bug-gnu-emacs@gnu.org; Tue, 30 Jun 2015 16:44:03 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Juri Linkov Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 30 Jun 2015 20:44:02 +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.14356970299536 (code B ref 19829); Tue, 30 Jun 2015 20:44:02 +0000 Original-Received: (at 19829) by debbugs.gnu.org; 30 Jun 2015 20:43:49 +0000 Original-Received: from localhost ([127.0.0.1]:34806 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1ZA2Nf-0002Tc-Re for submit@debbugs.gnu.org; Tue, 30 Jun 2015 16:43:49 -0400 Original-Received: from sub3.mail.dreamhost.com ([69.163.253.7]:47193 helo=homiemail-a23.g.dreamhost.com) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1ZA2Nb-0002T8-Hs for 19829@debbugs.gnu.org; Tue, 30 Jun 2015 16:43:45 -0400 Original-Received: from homiemail-a23.g.dreamhost.com (localhost [127.0.0.1]) by homiemail-a23.g.dreamhost.com (Postfix) with ESMTP id 3907B4B0091; Tue, 30 Jun 2015 13:43:42 -0700 (PDT) Original-Received: from localhost.linkov.net (m83-191-199-117.cust.tele2.ee [83.191.199.117]) (Authenticated sender: jurta@jurta.org) by homiemail-a23.g.dreamhost.com (Postfix) with ESMTPA id AC9FF4B0084; Tue, 30 Jun 2015 13:43:40 -0700 (PDT) In-Reply-To: (Stefan Monnier's message of "Wed, 11 Mar 2015 16:31:58 -0400") 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:104548 Archived-At: > If you want to avoid the isearch-filter-predicate in the "normal" case, > that's OK, but you should do it by checking the value returned by > region-extract-function. Now that we have enough evidence of diverse needs for commands operating on rectangular regions, it's possible to create a general design. Here is a composite patch with implementation of rectangular regions based on three different use cases: 1. query-replace on rectangle regions 2. downcase-region on rectangle regions 3. shell-command-on-region on rectangle regions First is the common part: diff --git a/lisp/simple.el b/lisp/simple.el index 4ef45c5..df6aa10 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -958,15 +958,34 @@ (defvar region-extract-function (lambda (delete) (when (region-beginning) - (if (eq delete 'delete-only) - (delete-region (region-beginning) (region-end)) - (filter-buffer-substring (region-beginning) (region-end) delete)))) + (cond + ((eq delete '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 is undefined. If DELETE is nil, just return the content as a string. +If DELETE is `positions', then don't delete, but just return the +positions of the region as a list of (START . END) boundaries. If anything else, delete the region and return its content as a string.") +(defvar region-insert-function + (lambda (lines) + (let ((first t)) + (while lines + (or first + (insert ?\n)) + (insert-for-yank (car lines)) + (setq lines (cdr lines) + first nil)))) + "Function to insert the region's content. +Called with one argument LINES. +Insert the region as a list of lines.") + (defun delete-backward-char (n &optional killflag) "Delete the previous N characters (following if N is negative). If Transient Mark mode is enabled, the mark is active, and N is 1, @@ -4950,6 +4989,9 @@ (defun region-active-p () ;; region is active when there's no mark. (progn (cl-assert (mark)) t))) +(defun region () + `(region + (positions ,@(funcall region-extract-function 'positions)))) (defvar redisplay-unhighlight-region-function (lambda (rol) (when (overlayp rol) (delete-overlay rol)))) diff --git a/lisp/rect.el b/lisp/rect.el index acd3a48..3d3370c 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -257,6 +257,19 @@ (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) boundaries, one for each line of +the rectangle." + (let (positions) + (apply-on-rectangle + (lambda (startcol endcol) + (move-to-column startcol) + (push (cons (prog1 (point) (move-to-column endcol)) (point)) + positions)) + start end) + (nreverse positions))) + (defvar killed-rectangle nil "Rectangle for `yank-rectangle' to insert.") @@ -563,6 +576,8 @@ (add-function :around redisplay-unhighlight-region-function #'rectangle--unhighlight-for-redisplay) (add-function :around region-extract-function #'rectangle--extract-region) +(add-function :around region-insert-function + #'rectangle--insert-region) (defvar rectangle-mark-mode-map (let ((map (make-sparse-keymap))) @@ -681,8 +696,12 @@ (defun rectangle--extract-region (orig &optional delete) - (if (not rectangle-mark-mode) - (funcall orig delete) + (cond + ((not rectangle-mark-mode) + (funcall orig delete)) + ((eq delete 'positions) + (extract-rectangle-positions (region-beginning) (region-end))) + (t (let* ((strs (funcall (if delete #'delete-extract-rectangle #'extract-rectangle) @@ -696,7 +715,14 @@ (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-region (orig strings) + (cond + ((not rectangle-mark-mode) + (funcall orig strings)) + (t + (funcall #'insert-rectangle strings)))) (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..98b7a3a 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 @@ -1394,6 +1410,8 @@ (defun cua--rectangle-post-command () (add-function :around region-extract-function #'cua--rectangle-region-extract) +(add-function :around region-insert-function + #'cua--insert-rectangle) (add-function :around redisplay-highlight-region-function #'cua--rectangle-highlight-for-redisplay) @@ -1405,8 +1423,12 @@ (defun cua--rectangle-region-extract (orig &optional delete) (cond - ((not cua--rectangle) (funcall orig delete)) - ((eq delete 'delete-only) (cua--delete-rectangle)) + ((not cua--rectangle) + (funcall orig delete)) + ((eq delete 'positions) + (cua--extract-rectangle-positions)) + ((eq delete 'delete-only) + (cua--delete-rectangle)) (t (let* ((strs (cua--extract-rectangle)) (str (mapconcat #'identity strs "\n"))) 1. query-replace on rectangle regions diff --git a/lisp/replace.el b/lisp/replace.el index 1bf1343..de6298f 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -274,7 +274,7 @@ (defun query-replace-read-args (prompt regexp-flag &optional noerror) (and current-prefix-arg (not (eq current-prefix-arg '-))) (and current-prefix-arg (eq current-prefix-arg '-))))) -(defun query-replace (from-string to-string &optional delimited start end backward) +(defun query-replace (from-string to-string &optional delimited start end backward region) "Replace some occurrences of FROM-STRING with TO-STRING. As each match is found, the user must type a character saying what to do with it. For directions, type \\[help-command] at that time. @@ -318,22 +318,21 @@ (defun query-replace (from-string to-string &optional delimited start end backwa (if current-prefix-arg (if (eq current-prefix-arg '-) " backward" " word") "") - (if (and transient-mark-mode mark-active) " in region" "")) + (if (use-region-p) " in region" "")) nil))) (list (nth 0 common) (nth 1 common) (nth 2 common) ;; These are done separately here ;; so that command-history will record these expressions ;; rather than the values they had this time. - (if (and transient-mark-mode mark-active) - (region-beginning)) - (if (and transient-mark-mode mark-active) - (region-end)) - (nth 3 common)))) - (perform-replace from-string to-string t nil delimited nil nil start end backward)) + (if (use-region-p) (region-beginning)) + (if (use-region-p) (region-end)) + (nth 3 common) + (if (use-region-p) (region))))) + (perform-replace from-string to-string t nil delimited nil nil start end backward region)) (define-key esc-map "%" 'query-replace) -(defun query-replace-regexp (regexp to-string &optional delimited start end backward) +(defun query-replace-regexp (regexp to-string &optional delimited start end backward region) "Replace some things after point matching REGEXP with TO-STRING. As each match is found, the user must type a character saying what to do with it. For directions, type \\[help-command] at that time. @@ -398,18 +397,17 @@ (defun query-replace-regexp (regexp to-string &optional delimited start end back (if (eq current-prefix-arg '-) " backward" " word") "") " regexp" - (if (and transient-mark-mode mark-active) " in region" "")) + (if (use-region-p) " in region" "")) t))) (list (nth 0 common) (nth 1 common) (nth 2 common) ;; These are done separately here ;; so that command-history will record these expressions ;; rather than the values they had this time. - (if (and transient-mark-mode mark-active) - (region-beginning)) - (if (and transient-mark-mode mark-active) - (region-end)) - (nth 3 common)))) - (perform-replace regexp to-string t t delimited nil nil start end backward)) + (if (use-region-p) (region-beginning)) + (if (use-region-p) (region-end)) + (nth 3 common) + (if (use-region-p) (region))))) + (perform-replace regexp to-string t t delimited nil nil start end backward region)) (define-key esc-map [?\C-%] 'query-replace-regexp) @@ -2054,7 +2052,7 @@ (defun perform-replace (from-string replacements query-flag regexp-flag delimited-flag - &optional repeat-count map start end backward) + &optional repeat-count map start end backward region) "Subroutine of `query-replace'. Its complexity handles interactive queries. Don't use this in your own program unless you want to query and set the mark just as `query-replace' does. Instead, write a simple loop like this: @@ -2095,6 +2093,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) + (region-positions (cdr-safe (assq 'positions region))) ;; 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. @@ -2107,6 +2108,24 @@ (defun perform-replace (from-string replacements "Query replacing %s with %s: (\\\\[help] for help) ") minibuffer-prompt-properties)))) + ;; Unless a single contiguous chunk is selected, operate on multiple chunks. + (when (> (length region-positions) 1) + (setq region-positions + (mapcar (lambda (position) + (cons (copy-marker (car position)) + (copy-marker (cdr position)))) + region-positions)) + (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)))) + region-positions))))) + ;; If region is active, in Transient Mark mode, operate on region. (if backward (when end 2. downcase-region on rectangle regions diff --git a/src/casefiddle.c b/src/casefiddle.c index 8755353..c09d5a8 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -306,14 +306,30 @@ return Qnil; } -DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 2, "r", +DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 3, + "(list (region-beginning) (region-end) (region))", doc: /* Convert the region to lower case. In programs, wants two arguments. These arguments specify the starting and ending character numbers of the region to operate on. When used as a command, the text between point and the mark is operated on. */) - (Lisp_Object beg, Lisp_Object end) + (Lisp_Object beg, Lisp_Object end, Lisp_Object region) { - casify_region (CASE_DOWN, beg, end); + Lisp_Object positions = Qnil; + + if (!NILP (region)) + positions = CDR_SAFE (Fassq (intern ("positions"), region)); + + if (positions) + { + while (CONSP (positions)) + { + casify_region (CASE_DOWN, XCAR (XCAR (positions)), XCDR (XCAR (positions))); + positions = XCDR (positions); + } + } + else + casify_region (CASE_DOWN, beg, end); + return Qnil; } 3. shell-command-on-region on rectangle regions diff --git a/lisp/simple.el b/lisp/simple.el index 4ef45c5..df6aa10 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -3267,7 +3291,8 @@ (defun shell-command-on-region (start end command &optional output-buffer replace - error-buffer display-error-buffer) + error-buffer display-error-buffer + region) "Execute string COMMAND in inferior shell with region as input. Normally display output (if any) in temp buffer `*Shell Command Output*'; Prefix arg means replace the region with it. Return the exit code of @@ -3330,7 +3355,8 @@ (defun shell-command-on-region (start end command current-prefix-arg current-prefix-arg shell-command-default-error-buffer - t))) + t + (region)))) (let ((error-file (if error-buffer (make-temp-file @@ -3339,6 +3365,19 @@ (defun shell-command-on-region (start end command temporary-file-directory))) nil)) exit-status) + ;; Unless a single contiguous chunk is selected, operate on multiple chunks. + (if (> (length (cdr-safe (assq 'positions region))) 1) + (let ((input (concat (funcall region-extract-function 'delete) "\n")) + output) + (with-temp-buffer + (insert input) + (call-process-region (point-min) (point-max) + shell-file-name t t + nil shell-command-switch + command) + (setq output (split-string (buffer-string) "\n"))) + (goto-char start) + (funcall region-insert-function output)) (if (or replace (and output-buffer (not (or (bufferp output-buffer) (stringp output-buffer))))) @@ -3428,7 +3467,7 @@ (defun shell-command-on-region (start end command exit-status output)))) ;; Don't kill: there might be useful info in the undo-log. ;; (kill-buffer buffer) - )))) + ))))) (when (and error-file (file-exists-p error-file)) (if (< 0 (nth 7 (file-attributes error-file)))