mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-29 08:31:35 -08:00
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)
This commit is contained in:
parent
f103a2771b
commit
31f6e93933
5 changed files with 255 additions and 141 deletions
|
|
@ -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")))
|
||||
|
|
|
|||
32
lisp/rect.el
32
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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
229
lisp/simple.el
229
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))))
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue