diff options
Diffstat (limited to 'lisp/rect.el')
| -rw-r--r-- | lisp/rect.el | 75 |
1 files changed, 59 insertions, 16 deletions
diff --git a/lisp/rect.el b/lisp/rect.el index 15d636f074e..6babd046051 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -407,7 +407,7 @@ no text on the right side of the rectangle." (point)))))) ;;;###autoload -(defalias 'close-rectangle 'delete-whitespace-rectangle) ;; Old name +(define-obsolete-function-alias 'close-rectangle #'delete-whitespace-rectangle "29.1") ;;;###autoload (defun delete-whitespace-rectangle (start end &optional fill) @@ -536,7 +536,7 @@ Called from a program, takes three args; START, END and STRING." (apply-on-rectangle 'string-rectangle-line start end string t))) ;;;###autoload -(defalias 'replace-rectangle 'string-rectangle) +(define-obsolete-function-alias 'replace-rectangle #'string-rectangle "29.1") ;;;###autoload (defun string-insert-rectangle (start end string) @@ -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 @@ -908,6 +930,27 @@ Ignores `line-move-visual'." (mapc #'delete-overlay (nthcdr 5 rol)) (setcar (cdr rol) nil))) +(defun rectangle--duplicate-right (n) + "Duplicate the rectangular region N times on the right-hand side." + (let ((cols (rectangle--pos-cols (point) (mark)))) + (apply-on-rectangle + (lambda (startcol endcol) + (let ((lines (list nil))) + (extract-rectangle-line startcol endcol lines) + (move-to-column endcol t) + (dotimes (_ n) + (insert (cadr lines))))) + (region-beginning) (region-end)) + ;; Recompute the rectangle state; no crutches should be needed now. + (let ((p (point)) + (m (mark))) + (rectangle--reset-crutches) + (goto-char m) + (move-to-column (cdr cols) t) + (set-mark (point)) + (goto-char p) + (move-to-column (car cols) t)))) + (provide 'rect) ;;; rect.el ends here |