bug#19829: 25.0.50; Design of commands operating on rectangular regions

[Juri Linkov]

> 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: 
(\\<query-replace-map>\\[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)))