X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/5244bc019bf7376caff3bb198ff674e0ad9fb0e6..89ce83b20249dfb4e45f09dfdddf4c4b66d82968:/lisp/emulation/cua-rect.el

diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index f63d79adf4..efc3c3f678 100644
--- 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-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2016 Free Software Foundation, Inc.
 
 ;; Author: Kim F. Storm <storm@cua.dk>
 ;; Keywords: keyboard emulations convenience CUA
@@ -31,8 +31,7 @@
 
 ;;; Code:
 
-(eval-when-compile
-  (require 'cua-base))
+(require 'cua-base)
 
 ;;; Rectangle support
 
@@ -79,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))
@@ -90,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)
@@ -462,7 +476,7 @@ If command is repeated at same position, delete the rectangle."
         (cua--deactivate))
     (cua-mouse-resize-rectangle event)
     (let ((cua-keep-region-after-copy t))
-      (cua-copy-rectangle arg)
+      (cua-copy-region arg)
       (setq cua--mouse-last-pos (cons (point) cua--last-killed-rectangle)))))
 
 (defun cua--mouse-ignore (_event)
@@ -652,6 +666,22 @@ If command is repeated at same position, delete the rectangle."
     	     (setq rect (cons row rect))))))
     (nreverse rect)))
 
+(defun cua--extract-rectangle-bounds ()
+  (let (rect)
+    (if (not (cua--rectangle-virtual-edges))
+        (cua--rectangle-operation nil nil nil nil nil ; do not tabify
+          (lambda (s e _l _r)
+             (setq rect (cons (cons s e) rect))))
+      (cua--rectangle-operation nil 1 nil nil nil ; do not tabify
+        (lambda (s e l r _v)
+           (goto-char s)
+           (move-to-column l)
+           (setq s (point))
+           (move-to-column r)
+           (setq e (point))
+           (setq rect (cons (cons s e) rect)))))
+    (nreverse rect)))
+
 (defun cua--insert-rectangle (rect &optional below paste-column line-count)
   ;; Insert rectangle as insert-rectangle, but don't set mark and exit with
   ;; point at either next to top right or below bottom left corner
@@ -709,30 +739,34 @@ 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
+        (or (and cua--last-rectangle
                  (eq (car cua--last-rectangle) (current-buffer))
-                 (eq (car (cdr cua--last-rectangle)) (point)))
-            (cdr (cdr cua--last-rectangle))
-          (cua--rectangle-get-corners))
+                 (eq (car (cdr cua--last-rectangle)) (point))
+                 (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.
@@ -776,7 +810,7 @@ If command is repeated at same position, delete the rectangle."
 			       (make-string
 				(- l cl0 (if (and (= le pl) (/= le lb)) 1 0))
 				(if cua--virtual-edges-debug ?. ?\s))
-			       'face (or (get-text-property (1- s) 'face) 'default)))
+			       'face (or (get-text-property (max (1- s) (point-min)) 'face) 'default)))
 		     (if (/= pl le)
 			 (setq s (1- s))))
 		   (cond
@@ -878,8 +912,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))))
 
@@ -887,8 +919,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 ()
@@ -946,32 +977,6 @@ With prefix argument, toggle restriction."
   (interactive)
   (cua--rectangle-move 'right))
 
-(defun cua-copy-rectangle (arg)
-  (interactive "P")
-  (setq arg (cua--prefix-arg arg))
-  (cua--copy-rectangle-as-kill arg)
-  (if cua-keep-region-after-copy
-      (cua--keep-active)
-    (cua--deactivate)))
-
-(defun cua-cut-rectangle (arg)
-  (interactive "P")
-  (if buffer-read-only
-      (cua-copy-rectangle arg)
-    (setq arg (cua--prefix-arg arg))
-    (goto-char (min (mark) (point)))
-    (cua--copy-rectangle-as-kill arg)
-    (cua--delete-rectangle))
-  (cua--deactivate))
-
-(defun cua-delete-rectangle ()
-  (interactive)
-  (goto-char (min (point) (mark)))
-  (if cua-delete-copy-to-register-0
-      (set-register ?0 (cua--extract-rectangle)))
-  (cua--delete-rectangle)
-  (cua--deactivate))
-
 (defun cua-rotate-rectangle ()
   (interactive)
   (cua--rectangle-corner (if (= (cua--rectangle-left) (cua--rectangle-right)) 0 1))
@@ -1403,6 +1408,44 @@ With prefix arg, indent to that column."
     (goto-char cua--rect-undo-set-point)
     (setq cua--rect-undo-set-point nil)))
 
+(add-function :around region-extract-function
+              #'cua--rectangle-region-extract)
+(add-function :around region-insert-function
+              #'cua--insert-rectangle)
+(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
+   ((not cua--rectangle)
+    (funcall orig delete))
+   ((eq delete 'bounds)
+    (cua--extract-rectangle-bounds))
+   ((eq delete 'delete-only)
+    (cua--delete-rectangle))
+   (t
+    (let* ((strs (cua--extract-rectangle))
+           (str (mapconcat #'identity strs "\n")))
+      (if delete (cua--delete-rectangle))
+      (setq killed-rectangle strs)
+      (setq cua--last-killed-rectangle
+            (cons (and kill-ring (car kill-ring)) killed-rectangle))
+      (when (eq last-command 'kill-region)
+        ;; Try to prevent kill-region from appending this to some
+        ;; earlier element.
+        (setq last-command 'kill-region-dont-append))
+      (when strs
+        (put-text-property 0 (length str) 'yank-handler
+                           `(rectangle--insert-for-yank ,strs t)
+                           str)
+        str)))))
+
 ;;; Initialization
 
 (defun cua--rect-M/H-key (key cmd)
@@ -1415,11 +1458,6 @@ With prefix arg, indent to that column."
     (cua--rect-M/H-key ?\s			       'cua-clear-rectangle-mark)
     (cua--M/H-key cua--region-keymap ?\s	       'cua-toggle-rectangle-mark))
 
-  (define-key cua--rectangle-keymap [remap copy-region-as-kill] 'cua-copy-rectangle)
-  (define-key cua--rectangle-keymap [remap kill-ring-save]      'cua-copy-rectangle)
-  (define-key cua--rectangle-keymap [remap kill-region]         'cua-cut-rectangle)
-  (define-key cua--rectangle-keymap [remap delete-char]         'cua-delete-rectangle)
-  (define-key cua--rectangle-keymap [remap delete-forward-char] 'cua-delete-rectangle)
   (define-key cua--rectangle-keymap [remap set-mark-command]    'cua-toggle-rectangle-mark)
 
   (define-key cua--rectangle-keymap [remap forward-char]        'cua-resize-rectangle-right)
@@ -1441,7 +1479,6 @@ With prefix arg, indent to that column."
   (define-key cua--rectangle-keymap [remap backward-delete-char] 'cua-delete-char-rectangle)
   (define-key cua--rectangle-keymap [remap backward-delete-char-untabify] 'cua-delete-char-rectangle)
   (define-key cua--rectangle-keymap [remap self-insert-command]	 'cua-insert-char-rectangle)
-  (define-key cua--rectangle-keymap [remap self-insert-iso]	 'cua-insert-char-rectangle)
 
   ;; Catch self-inserting characters which are "stolen" by other modes
   (define-key cua--rectangle-keymap [t]