Commit 31f6e939 authored by Juri Linkov's avatar Juri Linkov

Support rectangular regions for more commands

* 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)
parent f103a277
......@@ -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")))
......
......@@ -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)
......
......@@ -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
......
This diff is collapsed.
......@@ -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;
}
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment