From 31f6e939334180add7bc11240343615a2e6350f6 Mon Sep 17 00:00:00 2001
From: Juri Linkov <juri@linkov.net>
Date: Sat, 14 Nov 2015 01:28:03 +0200
Subject: [PATCH] Support rectangular regions for more commands
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

* lisp/simple.el (region-extract-function): Handle the arg value ‘bounds’.
(region-insert-function): New function.
(shell-command-on-region): Add arg ‘region-noncontiguous-p’.
If non-nil, operate on multiple chunks.
(region-noncontiguous-p): New function.

* lisp/rect.el: Add function rectangle--insert-region
around region-insert-function.
(extract-rectangle-bounds): New function.
(rectangle--extract-region): Handle the arg value ‘bounds’.
(rectangle--insert-region): New function.

* lisp/emulation/cua-rect.el: Add function cua--insert-rectangle
around region-insert-function.
(cua--extract-rectangle-bounds): New function.
(cua--rectangle-region-extract): Handle the arg value ‘bounds’.

* lisp/replace.el (query-replace, query-replace-regexp): Add arg
‘region-noncontiguous-p’.  Use ‘use-region-p’.
(query-replace-regexp-eval, map-query-replace-regexp)
(replace-string, replace-regexp): Use ‘use-region-p’.
(keep-lines, flush-lines, how-many): Use ‘use-region-p’.
(perform-replace): Add arg ‘region-noncontiguous-p’.
If non-nil, operate on multiple chunks.

* src/casefiddle.c (Fdowncase_region): Add arg ‘region-noncontiguous-p’.
If non-nil, operate on multiple chunks. (Bug#19829)
---
 lisp/emulation/cua-rect.el |  26 ++++-
 lisp/rect.el               |  32 +++++-
 lisp/replace.el            |  87 ++++++++------
 lisp/simple.el             | 229 ++++++++++++++++++++++---------------
 src/casefiddle.c           |  22 +++-
 5 files changed, 255 insertions(+), 141 deletions(-)

diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index ea8b52476f7..d389f6ec0a2 100644
--- a/lisp/emulation/cua-rect.el
+++ b/lisp/emulation/cua-rect.el
@@ -666,6 +666,22 @@ If command is repeated at same position, delete the rectangle."
     	     (setq rect (cons row rect))))))
     (nreverse rect)))
 
+(defun cua--extract-rectangle-bounds ()
+  (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 @@ With prefix arg, indent to that column."
 
 (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 @@ With prefix arg, indent to that column."
 
 (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 'bounds)
+    (cua--extract-rectangle-bounds))
+   ((eq delete 'delete-only)
+    (cua--delete-rectangle))
    (t
     (let* ((strs (cua--extract-rectangle))
            (str (mapconcat #'identity strs "\n")))
diff --git a/lisp/rect.el b/lisp/rect.el
index acd3a48f2da..46ebbf259cf 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -257,6 +257,19 @@ Return it as a list of strings, one for each line of the rectangle."
     (apply-on-rectangle 'extract-rectangle-line start end lines)
     (nreverse (cdr lines))))
 
+(defun extract-rectangle-bounds (start end)
+  "Return the bounds of the rectangle with corners at START and END.
+Return it as a list of (START . END) positions, one for each line of
+the rectangle."
+  (let (bounds)
+    (apply-on-rectangle
+     (lambda (startcol endcol)
+       (move-to-column startcol)
+       (push (cons (prog1 (point) (move-to-column endcol)) (point))
+	     bounds))
+     start end)
+    (nreverse bounds)))
+
 (defvar killed-rectangle nil
   "Rectangle for `yank-rectangle' to insert.")
 
@@ -563,6 +576,8 @@ with a prefix argument, prompt for START-AT and FORMAT."
               #'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 @@ Ignores `line-move-visual'."
 
 
 (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 'bounds)
+    (extract-rectangle-bounds (region-beginning) (region-end)))
+   (t
     (let* ((strs (funcall (if delete
                               #'delete-extract-rectangle
                             #'extract-rectangle)
@@ -696,7 +715,14 @@ Ignores `line-move-visual'."
         (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/replace.el b/lisp/replace.el
index d6590c5516a..b6802aeaf57 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -284,7 +284,7 @@ the original string if not."
 	  (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-noncontiguous-p)
   "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.
@@ -328,22 +328,21 @@ To customize possible responses, change the bindings in `query-replace-map'."
 		   (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-noncontiguous-p)))))
+  (perform-replace from-string to-string t nil delimited nil nil start end backward region-noncontiguous-p))
 
 (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-noncontiguous-p)
   "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.
@@ -408,18 +407,17 @@ Use \\[repeat-complex-command] after this command for details."
 		       (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-noncontiguous-p)))))
+  (perform-replace regexp to-string t t delimited nil nil start end backward region-noncontiguous-p))
 
 (define-key esc-map [?\C-%] 'query-replace-regexp)
 
@@ -485,10 +483,8 @@ for Lisp calls." "22.1"))
        ;; and the user might enter a single token.
        (replace-match-string-symbols to)
        (list from (car to) current-prefix-arg
-	     (if (and transient-mark-mode mark-active)
-		 (region-beginning))
-	     (if (and transient-mark-mode mark-active)
-		 (region-end))))))
+	     (if (use-region-p) (region-beginning))
+	     (if (use-region-p) (region-end))))))
   (perform-replace regexp (cons 'replace-eval-replacement to-expr)
 		   t 'literal delimited nil nil start end))
 
@@ -523,10 +519,8 @@ Fourth and fifth arg START and END specify the region to operate on."
      (list from to
 	   (and current-prefix-arg
 		(prefix-numeric-value current-prefix-arg))
-	   (if (and transient-mark-mode mark-active)
-	       (region-beginning))
-	   (if (and transient-mark-mode mark-active)
-	       (region-end)))))
+	   (if (use-region-p) (region-beginning))
+	   (if (use-region-p) (region-end)))))
   (let (replacements)
     (if (listp to-strings)
 	(setq replacements to-strings)
@@ -587,13 +581,11 @@ and TO-STRING is also null.)"
 		       (if (eq current-prefix-arg '-) " backward" " word")
 		     "")
 		   " string"
-		   (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)
-	   (if (and transient-mark-mode mark-active)
-	       (region-beginning))
-	   (if (and transient-mark-mode mark-active)
-	       (region-end))
+	   (if (use-region-p) (region-beginning))
+	   (if (use-region-p) (region-end))
 	   (nth 3 common))))
   (perform-replace from-string to-string nil nil delimited nil nil start end backward))
 
@@ -661,13 +653,11 @@ which will run faster and will not set the mark or print anything."
 		       (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)
-	   (if (and transient-mark-mode mark-active)
-	       (region-beginning))
-	   (if (and transient-mark-mode mark-active)
-	       (region-end))
+	   (if (use-region-p) (region-beginning))
+	   (if (use-region-p) (region-end))
 	   (nth 3 common))))
   (perform-replace regexp to-string nil t delimited nil nil start end backward))
 
@@ -832,7 +822,7 @@ a previously found match."
 		  (unless (or (bolp) (eobp))
 		    (forward-line 0))
 		  (point-marker)))))
-    (if (and interactive transient-mark-mode mark-active)
+    (if (and interactive (use-region-p))
 	(setq rstart (region-beginning)
 	      rend (progn
 		     (goto-char (region-end))
@@ -901,7 +891,7 @@ starting on the same line at which another match ended is ignored."
       (progn
 	(goto-char (min rstart rend))
 	(setq rend (copy-marker (max rstart rend))))
-    (if (and interactive transient-mark-mode mark-active)
+    (if (and interactive (use-region-p))
 	(setq rstart (region-beginning)
 	      rend (copy-marker (region-end)))
       (setq rstart (point)
@@ -951,7 +941,7 @@ a previously found match."
               (setq rend (max rstart rend)))
           (goto-char rstart)
           (setq rend (point-max)))
-      (if (and interactive transient-mark-mode mark-active)
+      (if (and interactive (use-region-p))
 	  (setq rstart (region-beginning)
 		rend (region-end))
 	(setq rstart (point)
@@ -2068,7 +2058,7 @@ It is called with three arguments, as if it were
 
 (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-noncontiguous-p)
   "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:
@@ -2115,6 +2105,9 @@ It must return a string."
 
          ;; 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-bounds 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.
@@ -2127,6 +2120,24 @@ It must return a string."
                       "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 region-noncontiguous-p
+      (setq region-bounds
+            (mapcar (lambda (position)
+                      (cons (copy-marker (car position))
+                            (copy-marker (cdr position))))
+                    (funcall region-extract-function 'bounds)))
+      (add-function :after-while isearch-filter-predicate
+                    (lambda (start end)
+                      (delq nil (mapcar
+                                 (lambda (bounds)
+                                   (and
+                                    (>= start (car bounds))
+                                    (<= start (cdr bounds))
+                                    (>= end   (car bounds))
+                                    (<= end   (cdr bounds))))
+                                 region-bounds)))))
+
     ;; If region is active, in Transient Mark mode, operate on region.
     (if backward
 	(when end
diff --git a/lisp/simple.el b/lisp/simple.el
index b115a2a0cbb..deb5c888c92 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -970,15 +970,34 @@ instead of deleted."
 (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 'bounds)
+        (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 `bounds', then don't delete, but just return the
+boundaries of the region as a list of (START . END) positions.
 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,
@@ -3419,7 +3438,8 @@ and only used if a buffer is displayed."
 
 (defun shell-command-on-region (start end command
 				      &optional output-buffer replace
-				      error-buffer display-error-buffer)
+				      error-buffer display-error-buffer
+				      region-noncontiguous-p)
   "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
@@ -3482,7 +3502,8 @@ interactively, this is t."
 		       current-prefix-arg
 		       current-prefix-arg
 		       shell-command-default-error-buffer
-		       t)))
+		       t
+		       (region-noncontiguous-p))))
   (let ((error-file
 	 (if error-buffer
 	     (make-temp-file
@@ -3491,96 +3512,109 @@ interactively, this is t."
 				    temporary-file-directory)))
 	   nil))
 	exit-status)
-    (if (or replace
-	    (and output-buffer
-		 (not (or (bufferp output-buffer) (stringp output-buffer)))))
-	;; Replace specified region with output from command.
-	(let ((swap (and replace (< start end))))
-	  ;; Don't muck with mark unless REPLACE says we should.
-	  (goto-char start)
-	  (and replace (push-mark (point) 'nomsg))
-	  (setq exit-status
-		(call-process-region start end shell-file-name replace
-				     (if error-file
-					 (list t error-file)
-				       t)
-				     nil shell-command-switch command))
-	  ;; It is rude to delete a buffer which the command is not using.
-	  ;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
-	  ;;   (and shell-buffer (not (eq shell-buffer (current-buffer)))
-	  ;; 	 (kill-buffer shell-buffer)))
-	  ;; Don't muck with mark unless REPLACE says we should.
-	  (and replace swap (exchange-point-and-mark)))
-      ;; No prefix argument: put the output in a temp buffer,
-      ;; replacing its entire contents.
-      (let ((buffer (get-buffer-create
-		     (or output-buffer "*Shell Command Output*"))))
-	(unwind-protect
-	    (if (eq buffer (current-buffer))
-		;; If the input is the same buffer as the output,
-		;; delete everything but the specified region,
-		;; then replace that region with the output.
-		(progn (setq buffer-read-only nil)
-		       (delete-region (max start end) (point-max))
-		       (delete-region (point-min) (min start end))
-		       (setq exit-status
-			     (call-process-region (point-min) (point-max)
-						  shell-file-name t
-						  (if error-file
-						      (list t error-file)
-						    t)
-						  nil shell-command-switch
-						  command)))
-	      ;; Clear the output buffer, then run the command with
-	      ;; output there.
-	      (let ((directory default-directory))
-		(with-current-buffer buffer
-		  (setq buffer-read-only nil)
-		  (if (not output-buffer)
-		      (setq default-directory directory))
-		  (erase-buffer)))
-	      (setq exit-status
-		    (call-process-region start end shell-file-name nil
-					 (if error-file
-					     (list buffer error-file)
-					   buffer)
-					 nil shell-command-switch command)))
-	  ;; Report the output.
-	  (with-current-buffer buffer
-	    (setq mode-line-process
-		  (cond ((null exit-status)
-			 " - Error")
-			((stringp exit-status)
-			 (format " - Signal [%s]" exit-status))
-			((not (equal 0 exit-status))
-			 (format " - Exit [%d]" exit-status)))))
-	  (if (with-current-buffer buffer (> (point-max) (point-min)))
-	      ;; There's some output, display it
-	      (display-message-or-buffer buffer)
-	    ;; No output; error?
-	    (let ((output
-		   (if (and error-file
-			    (< 0 (nth 7 (file-attributes error-file))))
-		       (format "some error output%s"
-			       (if shell-command-default-error-buffer
-				   (format " to the \"%s\" buffer"
-					   shell-command-default-error-buffer)
-				 ""))
-		     "no output")))
-	      (cond ((null exit-status)
-		     (message "(Shell command failed with error)"))
-		    ((equal 0 exit-status)
-		     (message "(Shell command succeeded with %s)"
-			      output))
-		    ((stringp exit-status)
-		     (message "(Shell command killed by signal %s)"
-			      exit-status))
-		    (t
-		     (message "(Shell command failed with code %d and %s)"
-			      exit-status output))))
-	    ;; Don't kill: there might be useful info in the undo-log.
-	    ;; (kill-buffer buffer)
-	    ))))
+    ;; Unless a single contiguous chunk is selected, operate on multiple chunks.
+    (if region-noncontiguous-p
+        (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)))))
+          ;; Replace specified region with output from command.
+          (let ((swap (and replace (< start end))))
+            ;; Don't muck with mark unless REPLACE says we should.
+            (goto-char start)
+            (and replace (push-mark (point) 'nomsg))
+            (setq exit-status
+                  (call-process-region start end shell-file-name replace
+                                       (if error-file
+                                           (list t error-file)
+                                         t)
+                                       nil shell-command-switch command))
+            ;; It is rude to delete a buffer which the command is not using.
+            ;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
+            ;;   (and shell-buffer (not (eq shell-buffer (current-buffer)))
+            ;; 	 (kill-buffer shell-buffer)))
+            ;; Don't muck with mark unless REPLACE says we should.
+            (and replace swap (exchange-point-and-mark)))
+        ;; No prefix argument: put the output in a temp buffer,
+        ;; replacing its entire contents.
+        (let ((buffer (get-buffer-create
+                       (or output-buffer "*Shell Command Output*"))))
+          (unwind-protect
+              (if (eq buffer (current-buffer))
+                  ;; If the input is the same buffer as the output,
+                  ;; delete everything but the specified region,
+                  ;; then replace that region with the output.
+                  (progn (setq buffer-read-only nil)
+                         (delete-region (max start end) (point-max))
+                         (delete-region (point-min) (min start end))
+                         (setq exit-status
+                               (call-process-region (point-min) (point-max)
+                                                    shell-file-name t
+                                                    (if error-file
+                                                        (list t error-file)
+                                                      t)
+                                                    nil shell-command-switch
+                                                    command)))
+                ;; Clear the output buffer, then run the command with
+                ;; output there.
+                (let ((directory default-directory))
+                  (with-current-buffer buffer
+                    (setq buffer-read-only nil)
+                    (if (not output-buffer)
+                        (setq default-directory directory))
+                    (erase-buffer)))
+                (setq exit-status
+                      (call-process-region start end shell-file-name nil
+                                           (if error-file
+                                               (list buffer error-file)
+                                             buffer)
+                                           nil shell-command-switch command)))
+            ;; Report the output.
+            (with-current-buffer buffer
+              (setq mode-line-process
+                    (cond ((null exit-status)
+                           " - Error")
+                          ((stringp exit-status)
+                           (format " - Signal [%s]" exit-status))
+                          ((not (equal 0 exit-status))
+                           (format " - Exit [%d]" exit-status)))))
+            (if (with-current-buffer buffer (> (point-max) (point-min)))
+                ;; There's some output, display it
+                (display-message-or-buffer buffer)
+              ;; No output; error?
+              (let ((output
+                     (if (and error-file
+                              (< 0 (nth 7 (file-attributes error-file))))
+                         (format "some error output%s"
+                                 (if shell-command-default-error-buffer
+                                     (format " to the \"%s\" buffer"
+                                             shell-command-default-error-buffer)
+                                   ""))
+                       "no output")))
+                (cond ((null exit-status)
+                       (message "(Shell command failed with error)"))
+                      ((equal 0 exit-status)
+                       (message "(Shell command succeeded with %s)"
+                                output))
+                      ((stringp exit-status)
+                       (message "(Shell command killed by signal %s)"
+                                exit-status))
+                      (t
+                       (message "(Shell command failed with code %d and %s)"
+                                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)))
@@ -5175,6 +5209,11 @@ also checks the value of `use-empty-active-region'."
        ;; region is active when there's no mark.
        (progn (cl-assert (mark)) t)))
 
+(defun region-noncontiguous-p ()
+  "Return non-nil if the region contains several pieces.
+An example is a rectangular region handled as a list of
+separate contiguous regions for each line."
+  (> (length (funcall region-extract-function 'bounds)) 1))
 
 (defvar redisplay-unhighlight-region-function
   (lambda (rol) (when (overlayp rol) (delete-overlay rol))))
diff --git a/src/casefiddle.c b/src/casefiddle.c
index b94ea8e212e..6a2983ef018 100644
--- a/src/casefiddle.c
+++ b/src/casefiddle.c
@@ -306,14 +306,30 @@ See also `capitalize-region'.  */)
   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-noncontiguous-p))",
        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_noncontiguous_p)
 {
-  casify_region (CASE_DOWN, beg, end);
+  Lisp_Object bounds = Qnil;
+
+  if (!NILP (region_noncontiguous_p))
+    {
+      bounds = call1 (Fsymbol_value (intern ("region-extract-function")),
+		      intern ("bounds"));
+
+      while (CONSP (bounds))
+	{
+	  casify_region (CASE_DOWN, XCAR (XCAR (bounds)), XCDR (XCAR (bounds)));
+	  bounds = XCDR (bounds);
+	}
+    }
+  else
+    casify_region (CASE_DOWN, beg, end);
+
   return Qnil;
 }
 
-- 
2.39.5