upstream

[gnu-emacs] / lisp / emulation / cua-rect.el

diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index fba8003328150d089e0c87932dae0e592f3529b0..d516bd4c7ccda1257436f9d9e5a3f7fe170415f6 100644 (file)
--- a/lisp/emulation/cua-rect.el
+++ b/lisp/emulation/cua-rect.el
@@ -1,6 +1,6 @@
 ;;; cua-rect.el --- CUA unified rectangle support
 
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2014 Free Software Foundation, Inc.
 
 ;; Author: Kim F. Storm <storm@cua.dk>
 ;; Keywords: keyboard emulations convenience CUA
@@ -78,7 +78,7 @@
       (push (list 'apply 0 s e
                  'cua--rect-undo-handler
                  (copy-sequence cua--rectangle) t s e)
-         buffer-undo-list))))
+            buffer-undo-list))))
 
 (defun cua--rect-undo-handler (rect on s e)
   (if (setq on (not on))
@@ -89,6 +89,21 @@
              'cua--rect-undo-handler rect on s e)
        buffer-undo-list))
 
+;;;###autoload
+(define-minor-mode cua-rectangle-mark-mode
+  "Toggle the region as rectangular.
+Activates the region if needed.  Only lasts until the region is deactivated."
+  :keymap cua--rectangle-keymap
+  (cond
+   (cua-rectangle-mark-mode
+    (add-hook 'deactivate-mark-hook
+              (lambda () (cua-rectangle-mark-mode -1)))
+    (add-hook 'post-command-hook #'cua--rectangle-post-command nil t)
+    (cua-set-rectangle-mark))
+   (t
+    (cua--deactivate-rectangle)
+    (remove-hook 'post-command-hook #'cua--rectangle-post-command t))))
+
 ;;; Rectangle geometry
 
 (defun cua--rectangle-top (&optional val)
@@ -708,8 +723,7 @@ If command is repeated at same position, delete the rectangle."
                    killed-rectangle "")))))
 
 (defun cua--activate-rectangle ()
-  ;; Turn on rectangular marking mode by disabling transient mark mode
-  ;; and manually handling highlighting from a post command hook.
+  ;; Set cua--rectangle to indicate we're marking a rectangle.
   ;; Be careful if we are already marking a rectangle.
   (setq cua--rectangle
         (if (and cua--last-rectangle
@@ -718,20 +732,25 @@ If command is repeated at same position, delete the rectangle."
             (cdr (cdr cua--last-rectangle))
           (cua--rectangle-get-corners))
         cua--status-string (if (cua--rectangle-virtual-edges) " [R]" "")
-        cua--last-rectangle nil))
+        cua--last-rectangle nil)
+  (activate-mark))
 
 ;; (defvar cua-save-point nil)
 
 (defun cua--deactivate-rectangle ()
   ;; This is used to clean up after `cua--activate-rectangle'.
-  (mapc (function delete-overlay) cua--rectangle-overlays)
+  (mapc #'delete-overlay cua--rectangle-overlays)
   (setq cua--last-rectangle (cons (current-buffer)
                                   (cons (point) ;; cua-save-point
                                         cua--rectangle))
         cua--rectangle nil
         cua--rectangle-overlays nil
         cua--status-string nil
-        cua--mouse-last-pos nil))
+        cua--mouse-last-pos nil)
+  ;; FIXME: This call to cua-rectangle-mark-mode is a workaround.
+  ;; Deactivation can happen in various different ways, and we
+  ;; currently don't handle them all in a coherent way.
+  (if cua-rectangle-mark-mode (cua-rectangle-mark-mode -1)))
 
 (defun cua--highlight-rectangle ()
   ;; This function is used to highlight the rectangular region.
@@ -877,8 +896,6 @@ With prefix argument, activate previous rectangle if possible."
           (push-mark nil nil t)))
     (cua--activate-rectangle)
     (cua--rectangle-set-corners)
-    (setq mark-active t
-          cua--explicit-region-start t)
     (if cua-enable-rectangle-auto-help
         (cua-help-for-rectangle t))))
 
@@ -886,8 +903,7 @@ With prefix argument, activate previous rectangle if possible."
   "Cancel current rectangle."
   (interactive)
   (when cua--rectangle
-    (setq mark-active nil
-          cua--explicit-region-start nil)
+    (setq mark-active nil)
     (cua--deactivate-rectangle)))
 
 (defun cua-toggle-rectangle-mark ()
@@ -1378,6 +1394,14 @@ With prefix arg, indent to that column."
 
 (add-function :around region-extract-function
               #'cua--rectangle-region-extract)
+(add-function :around redisplay-highlight-region-function
+              #'cua--rectangle-highlight-for-redisplay)
+
+(defun cua--rectangle-highlight-for-redisplay (orig &rest args)
+  (if (not cua--rectangle) (apply orig args)
+    ;; When cua--rectangle is active, just don't highlight at all, since we
+    ;; already do it elsewhere.
+    (funcall redisplay-unhighlight-region-function (nth 3 args))))
 
 (defun cua--rectangle-region-extract (orig &optional delete)
   (cond