[Emacs-diffs] trunk r115417: Use delete-selection-mode in cua-mode.

[Stefan Monnier]

------------------------------------------------------------
revno: 115417
revision-id: address@hidden
parent: address@hidden
fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=16085
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Sun 2013-12-08 01:24:54 -0500
message:
  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'.
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/emulation/cua-base.el     cuabase.el-20091113204419-o5vbwnq5f7feedwu-2415
  lisp/emulation/cua-gmrk.el     cuagmrk.el-20091113204419-o5vbwnq5f7feedwu-2416
  lisp/emulation/cua-rect.el     cuarect.el-20091113204419-o5vbwnq5f7feedwu-2417
  lisp/menu-bar.el               menubar.el-20091113204419-o5vbwnq5f7feedwu-546

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-12-08 04:20:50 +0000
+++ b/lisp/ChangeLog    2013-12-08 06:24:54 +0000
@@ -1,5 +1,32 @@
 2013-12-08  Stefan Monnier  <address@hidden>
 
+       * 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.

=== modified file 'lisp/emulation/cua-base.el'
--- a/lisp/emulation/cua-base.el        2013-08-05 14:26:57 +0000
+++ b/lisp/emulation/cua-base.el        2013-12-08 06:24:54 +0000
@@ -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 @@
         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 @@
 (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 @@
 (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 @@
   (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 @@
     (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 @@
        (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 @@
          (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 @@
     (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 @@
    ((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 @@
   ;; 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 @@
   (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 @@
           (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 @@
    (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))

=== modified file 'lisp/emulation/cua-gmrk.el'
--- a/lisp/emulation/cua-gmrk.el        2013-05-29 02:48:16 +0000
+++ b/lisp/emulation/cua-gmrk.el        2013-12-08 06:24:54 +0000
@@ -362,7 +362,6 @@
   (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]

=== modified file 'lisp/emulation/cua-rect.el'
--- a/lisp/emulation/cua-rect.el        2013-05-29 02:48:16 +0000
+++ b/lisp/emulation/cua-rect.el        2013-12-08 06:24:54 +0000
@@ -461,7 +461,7 @@
         (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 @@
   (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 @@
     (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 @@
     (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 @@
   (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]

=== modified file 'lisp/menu-bar.el'
--- a/lisp/menu-bar.el  2013-11-06 17:18:02 +0000
+++ b/lisp/menu-bar.el  2013-12-08 06:24:54 +0000
@@ -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.