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>
* 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.
......
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