diff options
Diffstat (limited to 'lisp/rect.el')
| -rw-r--r-- | lisp/rect.el | 50 |
1 files changed, 36 insertions, 14 deletions
diff --git a/lisp/rect.el b/lisp/rect.el index 15d636f074e..47df95b04e4 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -634,18 +634,17 @@ with a prefix argument, prompt for START-AT and FORMAT." (add-function :around region-insert-function #'rectangle--insert-region) -(defvar rectangle-mark-mode-map - (let ((map (make-sparse-keymap))) - (define-key map [?\C-o] 'open-rectangle) - (define-key map [?\C-t] 'string-rectangle) - (define-key map [remap exchange-point-and-mark] - 'rectangle-exchange-point-and-mark) - (dolist (cmd '(right-char left-char forward-char backward-char - next-line previous-line)) - (define-key map (vector 'remap cmd) - (intern (format "rectangle-%s" cmd)))) - map) - "Keymap used while marking a rectangular region.") +(defvar-keymap rectangle-mark-mode-map + :doc "Keymap used while marking a rectangular region." + "C-o" #'open-rectangle + "C-t" #'string-rectangle + "<remap> <exchange-point-and-mark>" #'rectangle-exchange-point-and-mark + "<remap> <right-char>" #'rectangle-right-char + "<remap> <left-char>" #'rectangle-left-char + "<remap> <forward-char>" #'rectangle-forward-char + "<remap> <backward-char>" #'rectangle-backward-char + "<remap> <next-line>" #'rectangle-next-line + "<remap> <previous-line>" #'rectangle-previous-line) ;;;###autoload (define-minor-mode rectangle-mark-mode @@ -656,6 +655,8 @@ on. Only lasts until the region is next deactivated." :lighter nil (rectangle--reset-crutches) (when rectangle-mark-mode + (advice-add 'region-beginning :around #'rectangle--region-beginning) + (advice-add 'region-end :around #'rectangle--region-end) (add-hook 'deactivate-mark-hook (lambda () (rectangle-mark-mode -1))) (unless (region-active-p) @@ -754,17 +755,38 @@ Ignores `line-move-visual'." (rectangle--col-pos col 'point))) +(defun rectangle--region-beginning (orig) + "Like `region-beginning' but supports rectangular regions." + (cond + ((not rectangle-mark-mode) + (funcall orig)) + (t + (apply #'min (mapcar #'car (region-bounds)))))) + +(defun rectangle--region-end (orig) + "Like `region-end' but supports rectangular regions." + (cond + ((not rectangle-mark-mode) + (funcall orig)) + (t + (apply #'max (mapcar #'cdr (region-bounds)))))) + (defun rectangle--extract-region (orig &optional delete) (cond ((not rectangle-mark-mode) (funcall orig delete)) ((eq delete 'bounds) - (extract-rectangle-bounds (region-beginning) (region-end))) + (extract-rectangle-bounds + ;; Avoid recursive calls from advice + (let (rectangle-mark-mode) (region-beginning)) + (let (rectangle-mark-mode) (region-end)))) (t (let* ((strs (funcall (if delete #'delete-extract-rectangle #'extract-rectangle) - (region-beginning) (region-end))) + ;; Avoid recursive calls from advice + (let (rectangle-mark-mode) (region-beginning)) + (let (rectangle-mark-mode) (region-end)))) (str (mapconcat #'identity strs "\n"))) (when (eq last-command 'kill-region) ;; Try to prevent kill-region from appending this to some |