Use delete-selection-mode in cua-mode.

* lisp/emulation/cua-base.el (cua--prefix-copy-handler)
(cua--prefix-cut-handler): Rely on region-extract-function rather than
checking cua--rectangle.
(cua-delete-region): Use region-extract-function.
(cua-replace-region): Delete function.
(cua-copy-region, cua-cut-region): Obey region-extract-function.
(cua--pre-command-handler-1): Don't do the delete-selection thing.
(cua--self-insert-char-p): Ignore `self-insert-iso'.
(cua--init-keymaps): Don't remap delete-selection commands.
(cua-mode): Use delete-selection-mode instead of rolling our own.
* lisp/emulation/cua-rect.el (cua--rectangle-region-extract): New function.
(region-extract-function): Use it.
(cua-mouse-save-then-kill-rectangle): Use cua-copy-region.
(cua-copy-rectangle, cua-cut-rectangle, cua-delete-rectangle):
Delete functions.
(cua--init-rectangles): Don't re-remap copy-region-as-kill,
kill-ring-save, kill-region, delete-char, delete-forward-char.
Ignore self-insert-iso.
* lisp/menu-bar.el (clipboard-kill-ring-save, clipboard-kill-region):
Obey region-extract-function.
* lisp/emulation/cua-gmrk.el (cua--init-global-mark):
Ignore `self-insert-iso'.

Fixes: debbugs:16085

5 files changed, 80 insertions, 108 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index fafeb959d43..1e384f25579 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,32 @@
 2013-12-08  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+        * emulation/cua-rect.el (cua--rectangle-region-extract): New function.
+        (region-extract-function): Use it.
+        (cua-mouse-save-then-kill-rectangle): Use cua-copy-region.
+        (cua-copy-rectangle, cua-cut-rectangle, cua-delete-rectangle):
+        Delete functions.
+        (cua--init-rectangles): Don't re-remap copy-region-as-kill,
+        kill-ring-save, kill-region, delete-char, delete-forward-char.
+        Ignore self-insert-iso.
+
+        * emulation/cua-gmrk.el (cua--init-global-mark):
+        Ignore `self-insert-iso'.
+
+        * emulation/cua-base.el (cua--prefix-copy-handler)
+        (cua--prefix-cut-handler): Rely on region-extract-function rather than
+        checking cua--rectangle.
+        (cua-delete-region): Use region-extract-function.
+        (cua-replace-region): Delete function.
+        (cua-copy-region, cua-cut-region): Obey region-extract-function.
+        (cua--pre-command-handler-1): Don't do the delete-selection thing.
+        (cua--self-insert-char-p): Ignore `self-insert-iso'.
+        (cua--init-keymaps): Don't remap delete-selection commands.
+        (cua-mode): Use delete-selection-mode instead of rolling our own
+        (bug#16085).
+
+        * menu-bar.el (clipboard-kill-ring-save, clipboard-kill-region):
+        Obey region-extract-function.
+
         Make registers and delete-selection-mode work on rectangles.
         * register.el (describe-register-1): Don't modify the register's value.
         (copy-to-register): Obey region-extract-function.
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index 292fd401a56..66afcc29525 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -96,10 +96,6 @@
 ;; This is done by highlighting the first occurrence of "redo"
 ;; and type "repeat" M-v M-v.
 
-;; Note: Since CUA-mode duplicates the functionality of the
-;; delete-selection-mode, that mode is automatically disabled when
-;; CUA-mode is enabled.
-
 
 ;; CUA mode indications
 ;; --------------------
@@ -601,8 +597,6 @@ a cons (TYPE . COLOR), then both properties are affected."
         cua--last-killed-rectangle nil))
 
 ;; All behind cua--rectangle tests.
-(declare-function cua-copy-rectangle    "cua-rect" (arg))
-(declare-function cua-cut-rectangle     "cua-rect" (arg))
 (declare-function cua--rectangle-left   "cua-rect" (&optional val))
 (declare-function cua--delete-rectangle "cua-rect" ())
 (declare-function cua--insert-rectangle "cua-rect"
@@ -733,9 +727,7 @@ Repeating prefix key when region is active works as a single prefix key."
 (defun cua--prefix-copy-handler (arg)
   "Copy region/rectangle, then replay last key."
   (interactive "P")
-  (if cua--rectangle
-      (cua-copy-rectangle arg)
-    (cua-copy-region arg))
+  (cua-copy-region arg)
   (let ((keys (this-single-command-keys)))
     (setq unread-command-events
           (cons (aref keys (1- (length keys))) unread-command-events))))
@@ -743,9 +735,7 @@ Repeating prefix key when region is active works as a single prefix key."
 (defun cua--prefix-cut-handler (arg)
   "Cut region/rectangle, then replay last key."
   (interactive "P")
-  (if cua--rectangle
-      (cua-cut-rectangle arg)
-    (cua-cut-region arg))
+  (cua-cut-region arg)
   (let ((keys (this-single-command-keys)))
     (setq unread-command-events
           (cons (aref keys (1- (length keys))) unread-command-events))))
@@ -815,10 +805,10 @@ Save a copy in register 0 if `cua-delete-copy-to-register-0' is non-nil."
   (let ((start (mark)) (end (point)))
     (or (<= start end)
         (setq start (prog1 end (setq end start))))
-    (setq cua--last-deleted-region-text (filter-buffer-substring start end))
+    (setq cua--last-deleted-region-text
+          (funcall region-extract-function t))
     (if cua-delete-copy-to-register-0
         (set-register ?0 cua--last-deleted-region-text))
-    (delete-region start end)
     (setq cua--last-deleted-region-pos
           (cons (current-buffer)
                 (and (consp buffer-undo-list)
@@ -826,17 +816,6 @@ Save a copy in register 0 if `cua-delete-copy-to-register-0' is non-nil."
     (cua--deactivate)
     (/= start end)))
 
-(defun cua-replace-region ()
-  "Replace the active region with the character you type."
-  (interactive)
-  (let ((not-empty (and cua-delete-selection (cua-delete-region))))
-    (unless (eq this-original-command this-command)
-      (let ((overwrite-mode
-             (and overwrite-mode
-                  not-empty
-                  (not (eq this-original-command 'self-insert-command)))))
-        (cua--fallback)))))
-
 (defun cua-copy-region (arg)
   "Copy the region to the kill ring.
 With numeric prefix arg, copy to register 0-9 instead."
@@ -848,11 +827,11 @@ With numeric prefix arg, copy to register 0-9 instead."
         (setq start (prog1 end (setq end start))))
     (cond
      (cua--register
-      (copy-to-register cua--register start end nil))
+      (copy-to-register cua--register start end nil 'region))
      ((eq this-original-command 'clipboard-kill-ring-save)
-      (clipboard-kill-ring-save start end))
+      (clipboard-kill-ring-save start end 'region))
      (t
-      (copy-region-as-kill start end)))
+      (copy-region-as-kill start end 'region)))
     (if cua-keep-region-after-copy
         (cua--keep-active)
       (cua--deactivate))))
@@ -870,11 +849,11 @@ With numeric prefix arg, copy to register 0-9 instead."
           (setq start (prog1 end (setq end start))))
       (cond
        (cua--register
-        (copy-to-register cua--register start end t))
+        (copy-to-register cua--register start end t 'region))
        ((eq this-original-command 'clipboard-kill-region)
-        (clipboard-kill-region start end))
+        (clipboard-kill-region start end 'region))
        (t
-        (kill-region start end))))
+        (kill-region start end 'region))))
     (cua--deactivate)))
 
 ;;; Generic commands for regions, rectangles, and global marks
@@ -1135,9 +1114,9 @@ With a double \\[universal-argument] prefix argument, unconditionally set mark."
     (if cua-enable-region-auto-help
         (cua-help-for-region t)))))
 
-;;; Scrolling commands which does not signal errors at top/bottom
-;;; of buffer at first key-press (instead moves to top/bottom
-;;; of buffer).
+;; Scrolling commands which do not signal errors at top/bottom
+;; of buffer at first key-press (instead moves to top/bottom
+;; of buffer).
 
 (defun cua-scroll-up (&optional arg)
   "Scroll text of current window upward ARG lines; or near full screen if no ARG.
@@ -1221,30 +1200,8 @@ If ARG is the atom `-', scroll upward by nearly full screen."
    ((not (symbolp this-command))
     nil)
 
-   ;; Handle delete-selection property on non-movement commands
    ((not (eq (get this-command 'CUA) 'move))
-    (when (and mark-active (not deactivate-mark))
-      (let* ((ds (or (get this-command 'delete-selection)
-                     (get this-command 'pending-delete)))
-             (nc (cond
-                  ((not ds) nil)
-                  ((eq ds 'yank)
-                   'cua-paste)
-                  ((eq ds 'kill)
-                   (if cua--rectangle
-                       'cua-copy-rectangle
-                     'cua-copy-region))
-                  ((eq ds 'supersede)
-                   (if cua--rectangle
-                       'cua-delete-rectangle
-                     'cua-delete-region))
-                  (t
-                   (if cua--rectangle
-                       'cua-delete-rectangle ;; replace?
-                     'cua-replace-region)))))
-        (if nc
-            (setq this-original-command this-command
-                  this-command nc)))))
+    nil)
 
    ;; Handle shifted cursor keys and other movement commands.
    ;; If region is not active, region is activated if key is shifted.
@@ -1329,7 +1286,7 @@ If ARG is the atom `-', scroll upward by nearly full screen."
   ;; Return DEF if current key sequence is self-inserting in
   ;; global-map.
   (if (memq (global-key-binding (this-single-command-keys))
-            '(self-insert-command self-insert-iso))
+            '(self-insert-command))
       def nil))
 
 (defvar cua-global-keymap (make-sparse-keymap)
@@ -1457,13 +1414,6 @@ If ARG is the atom `-', scroll upward by nearly full screen."
   (define-key cua--region-keymap [(shift control x)] 'cua--shift-control-x-prefix)
   (define-key cua--region-keymap [(shift control c)] 'cua--shift-control-c-prefix)
 
-  ;; replace current region
-  (define-key cua--region-keymap [remap self-insert-command]    'cua-replace-region)
-  (define-key cua--region-keymap [remap self-insert-iso]        'cua-replace-region)
-  (define-key cua--region-keymap [remap insert-register]        'cua-replace-region)
-  (define-key cua--region-keymap [remap newline-and-indent]     'cua-replace-region)
-  (define-key cua--region-keymap [remap newline]                'cua-replace-region)
-  (define-key cua--region-keymap [remap open-line]              'cua-replace-region)
   ;; delete current region
   (define-key cua--region-keymap [remap delete-backward-char]   'cua-delete-region)
   (define-key cua--region-keymap [remap backward-delete-char]   'cua-delete-region)
@@ -1589,8 +1539,10 @@ shifted movement key, set `cua-highlight-region-shift-only'."
            (and (boundp 'delete-selection-mode) delete-selection-mode)
            (and (boundp 'pc-selection-mode) pc-selection-mode)
            shift-select-mode))
-    (if (and (boundp 'delete-selection-mode) delete-selection-mode)
-        (delete-selection-mode -1))
+    (if cua-delete-selection
+        (delete-selection-mode 1)
+      (if (and (boundp 'delete-selection-mode) delete-selection-mode)
+          (delete-selection-mode -1)))
     (if (and (boundp 'pc-selection-mode) pc-selection-mode)
         (pc-selection-mode -1))
     (cua--deactivate)
@@ -1602,7 +1554,9 @@ shifted movement key, set `cua-highlight-region-shift-only'."
    (cua--saved-state
     (setq transient-mark-mode (car cua--saved-state))
     (if (nth 1 cua--saved-state)
-        (delete-selection-mode 1))
+        (delete-selection-mode 1)
+      (if (and (boundp 'delete-selection-mode) delete-selection-mode)
+          (delete-selection-mode -1)))
     (if (nth 2 cua--saved-state)
         (pc-selection-mode 1))
     (setq shift-select-mode (nth 3 cua--saved-state))
diff --git a/lisp/emulation/cua-gmrk.el b/lisp/emulation/cua-gmrk.el
index 78665624946..5554a7b6f01 100644
--- a/lisp/emulation/cua-gmrk.el
+++ b/lisp/emulation/cua-gmrk.el
@@ -362,7 +362,6 @@ With prefix argument, don't jump to global mark when canceling it."
   (define-key cua--global-mark-keymap [remap backward-delete-char]      'cua-delete-backward-char-at-global-mark)
   (define-key cua--global-mark-keymap [remap backward-delete-char-untabify] 'cua-delete-backward-char-at-global-mark)
   (define-key cua--global-mark-keymap [remap self-insert-command]       'cua-insert-char-at-global-mark)
-  (define-key cua--global-mark-keymap [remap self-insert-iso]           'cua-insert-char-at-global-mark)
 
   ;; Catch self-inserting characters which are "stolen" by other modes
   (define-key cua--global-mark-keymap [t]
diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index 16d109c6360..fba80033281 100644
--- a/lisp/emulation/cua-rect.el
+++ b/lisp/emulation/cua-rect.el
@@ -461,7 +461,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)
@@ -945,32 +945,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))
@@ -1402,6 +1376,30 @@ 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)
+
+(defun cua--rectangle-region-extract (orig &optional delete)
+  (cond
+   ((not cua--rectangle) (funcall orig delete))
+   ((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)
@@ -1414,11 +1412,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)
@@ -1440,7 +1433,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]
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 13c4c36be17..9e267d26c9b 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -545,17 +545,17 @@
   (let ((x-select-enable-clipboard t))
     (yank)))
 
-(defun clipboard-kill-ring-save (beg end)
+(defun clipboard-kill-ring-save (beg end &optional region)
   "Copy region to kill ring, and save in the X clipboard."
-  (interactive "r")
+  (interactive "r\np")
   (let ((x-select-enable-clipboard t))
-    (kill-ring-save beg end)))
+    (kill-ring-save beg end region)))
 
-(defun clipboard-kill-region (beg end)
+(defun clipboard-kill-region (beg end &optional region)
   "Kill the region, and save it in the X clipboard."
-  (interactive "r")
+  (interactive "r\np")
   (let ((x-select-enable-clipboard t))
-    (kill-region beg end)))
+    (kill-region beg end region)))
 
 (defun menu-bar-enable-clipboard ()
   "Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard.