Commit 6f8dfccf authored by Stefan Monnier's avatar Stefan Monnier
Browse files

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
parent 95b3d095
2013-12-08 Stefan Monnier <monnier@iro.umontreal.ca> 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. Make registers and delete-selection-mode work on rectangles.
* register.el (describe-register-1): Don't modify the register's value. * register.el (describe-register-1): Don't modify the register's value.
(copy-to-register): Obey region-extract-function. (copy-to-register): Obey region-extract-function.
......
...@@ -96,10 +96,6 @@ ...@@ -96,10 +96,6 @@
;; This is done by highlighting the first occurrence of "redo" ;; This is done by highlighting the first occurrence of "redo"
;; and type "repeat" M-v M-v. ;; 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 ;; CUA mode indications
;; -------------------- ;; --------------------
...@@ -601,8 +597,6 @@ a cons (TYPE . COLOR), then both properties are affected." ...@@ -601,8 +597,6 @@ a cons (TYPE . COLOR), then both properties are affected."
cua--last-killed-rectangle nil)) cua--last-killed-rectangle nil))
;; All behind cua--rectangle tests. ;; 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--rectangle-left "cua-rect" (&optional val))
(declare-function cua--delete-rectangle "cua-rect" ()) (declare-function cua--delete-rectangle "cua-rect" ())
(declare-function cua--insert-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." ...@@ -733,9 +727,7 @@ Repeating prefix key when region is active works as a single prefix key."
(defun cua--prefix-copy-handler (arg) (defun cua--prefix-copy-handler (arg)
"Copy region/rectangle, then replay last key." "Copy region/rectangle, then replay last key."
(interactive "P") (interactive "P")
(if cua--rectangle (cua-copy-region arg)
(cua-copy-rectangle arg)
(cua-copy-region arg))
(let ((keys (this-single-command-keys))) (let ((keys (this-single-command-keys)))
(setq unread-command-events (setq unread-command-events
(cons (aref keys (1- (length keys))) 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." ...@@ -743,9 +735,7 @@ Repeating prefix key when region is active works as a single prefix key."
(defun cua--prefix-cut-handler (arg) (defun cua--prefix-cut-handler (arg)
"Cut region/rectangle, then replay last key." "Cut region/rectangle, then replay last key."
(interactive "P") (interactive "P")
(if cua--rectangle (cua-cut-region arg)
(cua-cut-rectangle arg)
(cua-cut-region arg))
(let ((keys (this-single-command-keys))) (let ((keys (this-single-command-keys)))
(setq unread-command-events (setq unread-command-events
(cons (aref keys (1- (length keys))) 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." ...@@ -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))) (let ((start (mark)) (end (point)))
(or (<= start end) (or (<= start end)
(setq start (prog1 end (setq end start)))) (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 (if cua-delete-copy-to-register-0
(set-register ?0 cua--last-deleted-region-text)) (set-register ?0 cua--last-deleted-region-text))
(delete-region start end)
(setq cua--last-deleted-region-pos (setq cua--last-deleted-region-pos
(cons (current-buffer) (cons (current-buffer)
(and (consp buffer-undo-list) (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." ...@@ -826,17 +816,6 @@ Save a copy in register 0 if `cua-delete-copy-to-register-0' is non-nil."
(cua--deactivate) (cua--deactivate)
(/= start end))) (/= 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) (defun cua-copy-region (arg)
"Copy the region to the kill ring. "Copy the region to the kill ring.
With numeric prefix arg, copy to register 0-9 instead." With numeric prefix arg, copy to register 0-9 instead."
...@@ -848,11 +827,11 @@ 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)))) (setq start (prog1 end (setq end start))))
(cond (cond
(cua--register (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) ((eq this-original-command 'clipboard-kill-ring-save)
(clipboard-kill-ring-save start end)) (clipboard-kill-ring-save start end 'region))
(t (t
(copy-region-as-kill start end))) (copy-region-as-kill start end 'region)))
(if cua-keep-region-after-copy (if cua-keep-region-after-copy
(cua--keep-active) (cua--keep-active)
(cua--deactivate)))) (cua--deactivate))))
...@@ -870,11 +849,11 @@ With numeric prefix arg, copy to register 0-9 instead." ...@@ -870,11 +849,11 @@ With numeric prefix arg, copy to register 0-9 instead."
(setq start (prog1 end (setq end start)))) (setq start (prog1 end (setq end start))))
(cond (cond
(cua--register (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) ((eq this-original-command 'clipboard-kill-region)
(clipboard-kill-region start end)) (clipboard-kill-region start end 'region))
(t (t
(kill-region start end)))) (kill-region start end 'region))))
(cua--deactivate))) (cua--deactivate)))
;;; Generic commands for regions, rectangles, and global marks ;;; Generic commands for regions, rectangles, and global marks
...@@ -1135,9 +1114,9 @@ With a double \\[universal-argument] prefix argument, unconditionally set mark." ...@@ -1135,9 +1114,9 @@ With a double \\[universal-argument] prefix argument, unconditionally set mark."
(if cua-enable-region-auto-help (if cua-enable-region-auto-help
(cua-help-for-region t))))) (cua-help-for-region t)))))
;;; Scrolling commands which does not signal errors at top/bottom ;; Scrolling commands which do not signal errors at top/bottom
;;; of buffer at first key-press (instead moves to top/bottom ;; of buffer at first key-press (instead moves to top/bottom
;;; of buffer). ;; of buffer).
(defun cua-scroll-up (&optional arg) (defun cua-scroll-up (&optional arg)
"Scroll text of current window upward ARG lines; or near full screen if no 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." ...@@ -1221,30 +1200,8 @@ If ARG is the atom `-', scroll upward by nearly full screen."
((not (symbolp this-command)) ((not (symbolp this-command))
nil) nil)
;; Handle delete-selection property on non-movement commands
((not (eq (get this-command 'CUA) 'move)) ((not (eq (get this-command 'CUA) 'move))
(when (and mark-active (not deactivate-mark)) nil)
(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)))))
;; Handle shifted cursor keys and other movement commands. ;; Handle shifted cursor keys and other movement commands.
;; If region is not active, region is activated if key is shifted. ;; 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." ...@@ -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 ;; Return DEF if current key sequence is self-inserting in
;; global-map. ;; global-map.
(if (memq (global-key-binding (this-single-command-keys)) (if (memq (global-key-binding (this-single-command-keys))
'(self-insert-command self-insert-iso)) '(self-insert-command))
def nil)) def nil))
(defvar cua-global-keymap (make-sparse-keymap) (defvar cua-global-keymap (make-sparse-keymap)
...@@ -1457,13 +1414,6 @@ If ARG is the atom `-', scroll upward by nearly full screen." ...@@ -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 x)] 'cua--shift-control-x-prefix)
(define-key cua--region-keymap [(shift control c)] 'cua--shift-control-c-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 ;; delete current region
(define-key cua--region-keymap [remap delete-backward-char] 'cua-delete-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) (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'." ...@@ -1589,8 +1539,10 @@ shifted movement key, set `cua-highlight-region-shift-only'."
(and (boundp 'delete-selection-mode) delete-selection-mode) (and (boundp 'delete-selection-mode) delete-selection-mode)
(and (boundp 'pc-selection-mode) pc-selection-mode) (and (boundp 'pc-selection-mode) pc-selection-mode)
shift-select-mode)) shift-select-mode))
(if (and (boundp 'delete-selection-mode) delete-selection-mode) (if cua-delete-selection
(delete-selection-mode -1)) (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) (if (and (boundp 'pc-selection-mode) pc-selection-mode)
(pc-selection-mode -1)) (pc-selection-mode -1))
(cua--deactivate) (cua--deactivate)
...@@ -1602,7 +1554,9 @@ shifted movement key, set `cua-highlight-region-shift-only'." ...@@ -1602,7 +1554,9 @@ shifted movement key, set `cua-highlight-region-shift-only'."
(cua--saved-state (cua--saved-state
(setq transient-mark-mode (car cua--saved-state)) (setq transient-mark-mode (car cua--saved-state))
(if (nth 1 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) (if (nth 2 cua--saved-state)
(pc-selection-mode 1)) (pc-selection-mode 1))
(setq shift-select-mode (nth 3 cua--saved-state)) (setq shift-select-mode (nth 3 cua--saved-state))
......
...@@ -362,7 +362,6 @@ With prefix argument, don't jump to global mark when canceling it." ...@@ -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] '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 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-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 ;; Catch self-inserting characters which are "stolen" by other modes
(define-key cua--global-mark-keymap [t] (define-key cua--global-mark-keymap [t]
......
...@@ -461,7 +461,7 @@ If command is repeated at same position, delete the rectangle." ...@@ -461,7 +461,7 @@ If command is repeated at same position, delete the rectangle."
(cua--deactivate)) (cua--deactivate))
(cua-mouse-resize-rectangle event) (cua-mouse-resize-rectangle event)
(let ((cua-keep-region-after-copy t)) (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))))) (setq cua--mouse-last-pos (cons (point) cua--last-killed-rectangle)))))
(defun cua--mouse-ignore (_event) (defun cua--mouse-ignore (_event)
...@@ -945,32 +945,6 @@ With prefix argument, toggle restriction." ...@@ -945,32 +945,6 @@ With prefix argument, toggle restriction."
(interactive) (interactive)
(cua--rectangle-move 'right)) (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 () (defun cua-rotate-rectangle ()
(interactive) (interactive)
(cua--rectangle-corner (if (= (cua--rectangle-left) (cua--rectangle-right)) 0 1)) (cua--rectangle-corner (if (= (cua--rectangle-left) (cua--rectangle-right)) 0 1))
...@@ -1402,6 +1376,30 @@ With prefix arg, indent to that column." ...@@ -1402,6 +1376,30 @@ With prefix arg, indent to that column."
(goto-char cua--rect-undo-set-point) (goto-char cua--rect-undo-set-point)
(setq cua--rect-undo-set-point nil))) (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 ;;; Initialization
(defun cua--rect-M/H-key (key cmd) (defun cua--rect-M/H-key (key cmd)
...@@ -1414,11 +1412,6 @@ With prefix arg, indent to that column." ...@@ -1414,11 +1412,6 @@ With prefix arg, indent to that column."
(cua--rect-M/H-key ?\s 'cua-clear-rectangle-mark) (cua--rect-M/H-key ?\s 'cua-clear-rectangle-mark)
(cua--M/H-key cua--region-keymap ?\s 'cua-toggle-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 set-mark-command] 'cua-toggle-rectangle-mark)
(define-key cua--rectangle-keymap [remap forward-char] 'cua-resize-rectangle-right) (define-key cua--rectangle-keymap [remap forward-char] 'cua-resize-rectangle-right)
...@@ -1440,7 +1433,6 @@ With prefix arg, indent to that column." ...@@ -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] 'cua-delete-char-rectangle)
(define-key cua--rectangle-keymap [remap backward-delete-char-untabify] '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-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 ;; Catch self-inserting characters which are "stolen" by other modes
(define-key cua--rectangle-keymap [t] (define-key cua--rectangle-keymap [t]
......
...@@ -545,17 +545,17 @@ ...@@ -545,17 +545,17 @@
(let ((x-select-enable-clipboard t)) (let ((x-select-enable-clipboard t))
(yank))) (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." "Copy region to kill ring, and save in the X clipboard."
(interactive "r") (interactive "r\np")
(let ((x-select-enable-clipboard t)) (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." "Kill the region, and save it in the X clipboard."
(interactive "r") (interactive "r\np")
(let ((x-select-enable-clipboard t)) (let ((x-select-enable-clipboard t))
(kill-region beg end))) (kill-region beg end region)))
(defun menu-bar-enable-clipboard () (defun menu-bar-enable-clipboard ()
"Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard. "Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment