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; Design of commands operating on rectangular regions
Date: Fri, 03 Jul 2015 01:40:37 +0300	[thread overview]
Message-ID: <877fqi89ii.fsf@mail.linkov.net> (raw)
In-Reply-To: <jwvd20bz304.fsf-monnier+emacsbugs@gnu.org> (Stefan Monnier's message of "Wed, 01 Jul 2015 23:02:51 -0400")

> IOW, either your REGION arg uses a standard format (e.g. a list of
> (START . END) boundaries), or it should be just a constant saying "use
> things like region-extract-function ".

Or better to check the value returned by region-extract-function
in `interactive' with:

  (defun region-nonstandard ()
    (> (length (funcall region-extract-function 'positions)) 1))

like the patch below does.

Alternative names for this predicate:

  region-noncontiguous
  region-special

> I agree that hijacking one of the two existing args is ugly, but that's
> only because it's asymmetric.  If the region had always been passed as
> a single arg (e.g., a pair (START . END)), then it would be very natural
> to extend it with more cases.
>
> [ Tangentially related side-note: "r" is the only option in `interactive'
>   which provides 2 arguments.  IMO this special case should never have
>   existed, but of course we now have to live with it.  ]

Then we could replace in `interactive' calls `region-beginning'
with `region-beginning-nonstandard' defined as:

  (defun region-beginning-nonstandard ()
    (or (region-nonstandard) (region-beginning)))

and then in a command operating on the region check if the START arg is
`t' or a number.

But I'm still not sure whether ugly is nicer than hideous,
so this patch doesn't use it yet.

The common part:

diff --git a/lisp/simple.el b/lisp/simple.el
index 4ef45c5..680f89f 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -958,15 +958,34 @@ (defcustom delete-active-region t
 (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,8 @@ (defun region-active-p ()
        ;; region is active when there's no mark.
        (progn (cl-assert (mark)) t)))
 
+(defun region-nonstandard ()
+  (> (length (funcall region-extract-function 'positions)) 1))
 
 (defvar redisplay-unhighlight-region-function
   (lambda (rol) (when (overlayp rol) (delete-overlay rol))))

1. query-replace on rectangle regions

diff --git a/lisp/replace.el b/lisp/replace.el
index 1bf1343..36ce5a0 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-nonstandard)
   "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
 	   ;; 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-nonstandard)))))
+  (perform-replace from-string to-string t nil delimited nil nil start end backward region-nonstandard))
 
 (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-nonstandard)
   "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
 	   ;; 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-nonstandard)))))
+  (perform-replace regexp to-string t t delimited nil nil start end backward region-nonstandard))
 
 (define-key esc-map [?\C-%] 'query-replace-regexp)
 
@@ -2054,7 +2052,7 @@ (defun replace-dehighlight ()
 
 (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-nonstandard)
   "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 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.
@@ -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 region-nonstandard
+      (setq region-positions
+            (mapcar (lambda (position)
+                      (cons (copy-marker (car position))
+                            (copy-marker (cdr position))))
+                    (funcall region-extract-function '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..65f005f 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-nonstandard))",
        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_nonstandard)
 {
-  casify_region (CASE_DOWN, beg, end);
+  Lisp_Object positions = Qnil;
+
+  if (!NILP (region_nonstandard))
+    {
+      positions = call1 (Fsymbol_value (intern ("region-extract-function")),
+			 intern ("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..680f89f 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -3267,7 +3291,8 @@ (defun shell-command-sentinel (process signal)
 
 (defun shell-command-on-region (start end command
 				      &optional output-buffer replace
-				      error-buffer display-error-buffer)
+				      error-buffer display-error-buffer
+				      region-nonstandard)
   "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-nonstandard))))
   (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 region-nonstandard
+        (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)))





  reply	other threads:[~2015-07-02 22:40 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
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 [this message]
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=877fqi89ii.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.