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
This commit is contained in:
Stefan Monnier
parent
95b3d095f8
commit
6f8dfccfe3
5 changed files with 80 additions and 108 deletions
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue