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
......
......@@ -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))))
......
......@@ -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