Merge from origin/emacs-25

[gnu-emacs] / lisp / rect.el

diff --git a/lisp/rect.el b/lisp/rect.el
index 90c8f94f0abd3b34cc50f521714c193cc036356d..73790f2f92a6092acf5c120f1df37ad823b0daf3 100644 (file)
--- 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-2014 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1999-2016 Free Software Foundation, Inc.
 
 ;; Maintainer: Didier Verna <didier@xemacs.org>
 ;; 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)))
@@ -586,8 +603,7 @@ Activates the region if needed.  Only lasts until the region is deactivated."
     (add-hook 'deactivate-mark-hook
               (lambda () (rectangle-mark-mode -1)))
     (unless (region-active-p)
-      (push-mark)
-      (activate-mark)
+      (push-mark (point) t t)
       (message "Mark set (rectangle mode)"))))
 
 (defun rectangle-exchange-point-and-mark (&optional arg)
@@ -681,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)
@@ -696,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)