1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-25 07:28:20 +00:00

* lisp/rect.el: Return correct positions of region-beginning/end (bug#55234)

(rectangle-mark-mode): Add advices for region-beginning and region-end.
(rectangle--region-beginning, rectangle--region-end): New advices.
(rectangle--extract-region): Let-bind rectangle-mark-mode around
region-beginning and region-end to use the original functions.
This commit is contained in:
Juri Linkov 2022-06-08 20:10:12 +03:00
parent 4ad75a50a2
commit c754f277a6

View File

@ -656,6 +656,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 +756,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