X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c1b8b17a7ac22123fe8d2d647265f19d2cc92625..cd950da:/lisp/rect.el diff --git a/lisp/rect.el b/lisp/rect.el index 75585d2f08..73790f2f92 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -1,6 +1,6 @@ ;;; rect.el --- rectangle functions for GNU Emacs -*- lexical-binding:t -*- -;; Copyright (C) 1985, 1999-2015 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1999-2016 Free Software Foundation, Inc. ;; Maintainer: Didier Verna ;; Keywords: internal @@ -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.") @@ -346,7 +359,8 @@ no text on the right side of the rectangle." (defun delete-whitespace-rectangle-line (startcol _endcol fill) (when (= (move-to-column startcol (if fill t 'coerce)) startcol) (unless (= (point) (point-at-eol)) - (delete-region (point) (progn (skip-syntax-forward " ") (point)))))) + (delete-region (point) (progn (skip-syntax-forward " " (point-at-eol)) + (point)))))) ;;;###autoload (defalias 'close-rectangle 'delete-whitespace-rectangle) ;; Old name @@ -389,6 +403,7 @@ With a prefix (or a FILL) argument, also fill too short lines." (defcustom rectangle-preview t "If non-nil, `string-rectangle' will show an-the-fly preview." + :version "25.1" :type 'boolean) (defun rectangle--string-preview () @@ -562,6 +577,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))) @@ -680,8 +697,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) @@ -695,7 +716,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)