Commit 5b4f37ab authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* lisp/emulation/cua-base.el (cua-paste): Add `delete-selection' property

instead of deleting the selection "by hand".
Rely on insert-for-yank to yank rectangles.
(cua-highlight-region-shift-only): Mark obsolete.
(cua-mode): Don't enable/disable transient-mark-mode,
shift-select-mode (cua-mode works both with and without them), and
pc-selection-mode (obsolete).
* lisp/emulation/cua-rect.el (cua--activate-rectangle): Activate the mark.
(cua--deactivate-rectangle): Deactivate it.

Fixes: debbugs:16098
parent 4ec52e2f
2013-12-11 Stefan Monnier <monnier@iro.umontreal.ca> 2013-12-11 Stefan Monnier <monnier@iro.umontreal.ca>
* emulation/cua-base.el (cua-paste): Add `delete-selection' property
instead of deleting the selection "by hand" (bug#16098).
Rely on insert-for-yank to yank rectangles.
(cua-highlight-region-shift-only): Mark obsolete.
(cua-mode): Don't enable/disable transient-mark-mode,
shift-select-mode (cua-mode works both with and without them), and
pc-selection-mode (obsolete).
* emulation/cua-rect.el (cua--activate-rectangle): Activate the mark.
(cua--deactivate-rectangle): Deactivate it.
* delsel.el (delete-selection-mode): Don't enable transient-mark-mode. * delsel.el (delete-selection-mode): Don't enable transient-mark-mode.
(delete-selection-helper): Make sure yank starts at the top of the (delete-selection-helper): Make sure yank starts at the top of the
deleted region. deleted region.
......
...@@ -294,6 +294,8 @@ But when the mark was set using \\[cua-set-mark], Transient Mark mode ...@@ -294,6 +294,8 @@ But when the mark was set using \\[cua-set-mark], Transient Mark mode
is not turned on." is not turned on."
:type 'boolean :type 'boolean
:group 'cua) :group 'cua)
(make-obsolete-variable 'cua-highlight-region-shift-only
'transient-mark-mode "24.4")
(defcustom cua-prefix-override-inhibit-delay 0.2 (defcustom cua-prefix-override-inhibit-delay 0.2
"If non-nil, time in seconds to delay before overriding prefix key. "If non-nil, time in seconds to delay before overriding prefix key.
...@@ -858,6 +860,7 @@ With numeric prefix arg, copy to register 0-9 instead." ...@@ -858,6 +860,7 @@ With numeric prefix arg, copy to register 0-9 instead."
(declare-function x-clipboard-yank "../term/x-win" ()) (declare-function x-clipboard-yank "../term/x-win" ())
(put 'cua-paste 'delete-selection 'yank)
(defun cua-paste (arg) (defun cua-paste (arg)
"Paste last cut or copied region or rectangle. "Paste last cut or copied region or rectangle.
An active region is deleted before executing the command. An active region is deleted before executing the command.
...@@ -866,8 +869,7 @@ If global mark is active, copy from register or one character." ...@@ -866,8 +869,7 @@ If global mark is active, copy from register or one character."
(interactive "P") (interactive "P")
(setq arg (cua--prefix-arg arg)) (setq arg (cua--prefix-arg arg))
(let ((regtxt (and cua--register (get-register cua--register))) (let ((regtxt (and cua--register (get-register cua--register)))
(count (prefix-numeric-value arg)) (count (prefix-numeric-value arg)))
paste-column paste-lines)
(cond (cond
((and cua--register (not regtxt)) ((and cua--register (not regtxt))
(message "Nothing in register %c" cua--register)) (message "Nothing in register %c" cua--register))
...@@ -875,30 +877,12 @@ If global mark is active, copy from register or one character." ...@@ -875,30 +877,12 @@ If global mark is active, copy from register or one character."
(if regtxt (if regtxt
(cua--insert-at-global-mark regtxt) (cua--insert-at-global-mark regtxt)
(when (not (eobp)) (when (not (eobp))
(cua--insert-at-global-mark (filter-buffer-substring (point) (+ (point) count))) (cua--insert-at-global-mark
(filter-buffer-substring (point) (+ (point) count)))
(forward-char count)))) (forward-char count))))
(buffer-read-only (buffer-read-only
(error "Cannot paste into a read-only buffer")) (error "Cannot paste into a read-only buffer"))
(t (t
;; Must save register here, since delete may override reg 0.
(if mark-active
(if cua--rectangle
(progn
(goto-char (min (mark) (point)))
(setq paste-column (cua--rectangle-left))
(setq paste-lines (cua--delete-rectangle))
(if (= paste-lines 1)
(setq paste-lines nil))) ;; paste all
;; Before a yank command, make sure we don't yank the
;; head of the kill-ring that really comes from the
;; currently active region we are going to delete.
;; That would make yank a no-op.
(if (and (string= (filter-buffer-substring (point) (mark))
(car kill-ring))
(fboundp 'mouse-region-match)
(mouse-region-match))
(current-kill 1))
(cua-delete-region)))
(cond (cond
(regtxt (regtxt
(cond (cond
...@@ -906,16 +890,6 @@ If global mark is active, copy from register or one character." ...@@ -906,16 +890,6 @@ If global mark is active, copy from register or one character."
((consp regtxt) (cua--insert-rectangle regtxt)) ((consp regtxt) (cua--insert-rectangle regtxt))
((stringp regtxt) (insert-for-yank regtxt)) ((stringp regtxt) (insert-for-yank regtxt))
(t (message "Unknown data in register %c" cua--register)))) (t (message "Unknown data in register %c" cua--register))))
((and cua--last-killed-rectangle
(eq (and kill-ring (car kill-ring)) (car cua--last-killed-rectangle)))
(let ((pt (point)))
(when (not (eq buffer-undo-list t))
(setq this-command 'cua--paste-rectangle)
(undo-boundary)
(setq buffer-undo-list (cons pt buffer-undo-list)))
(cua--insert-rectangle (cdr cua--last-killed-rectangle)
nil paste-column paste-lines)
(if arg (goto-char pt))))
((eq this-original-command 'clipboard-yank) ((eq this-original-command 'clipboard-yank)
(clipboard-yank)) (clipboard-yank))
((eq this-original-command 'x-clipboard-yank) ((eq this-original-command 'x-clipboard-yank)
...@@ -1426,9 +1400,7 @@ If ARG is the atom `-', scroll upward by nearly full screen." ...@@ -1426,9 +1400,7 @@ If ARG is the atom `-', scroll upward by nearly full screen."
;; State prior to enabling cua-mode ;; State prior to enabling cua-mode
;; Value is a list with the following elements: ;; Value is a list with the following elements:
;; transient-mark-mode
;; delete-selection-mode ;; delete-selection-mode
;; pc-selection-mode
(defvar cua--saved-state nil) (defvar cua--saved-state nil)
...@@ -1488,7 +1460,8 @@ shifted movement key, set `cua-highlight-region-shift-only'." ...@@ -1488,7 +1460,8 @@ shifted movement key, set `cua-highlight-region-shift-only'."
(remove-hook 'post-command-hook 'cua--post-command-handler)) (remove-hook 'post-command-hook 'cua--post-command-handler))
(if (not cua-mode) (if (not cua-mode)
(setq emulation-mode-map-alists (delq 'cua--keymap-alist emulation-mode-map-alists)) (setq emulation-mode-map-alists
(delq 'cua--keymap-alist emulation-mode-map-alists))
(add-to-ordered-list 'emulation-mode-map-alists 'cua--keymap-alist 400) (add-to-ordered-list 'emulation-mode-map-alists 'cua--keymap-alist 400)
(cua--select-keymaps)) (cua--select-keymaps))
...@@ -1496,34 +1469,21 @@ shifted movement key, set `cua-highlight-region-shift-only'." ...@@ -1496,34 +1469,21 @@ shifted movement key, set `cua-highlight-region-shift-only'."
(cua-mode (cua-mode
(setq cua--saved-state (setq cua--saved-state
(list (list
transient-mark-mode (and (boundp 'delete-selection-mode) delete-selection-mode)))
(and (boundp 'delete-selection-mode) delete-selection-mode)
(and (boundp 'pc-selection-mode) pc-selection-mode)
shift-select-mode))
(if cua-delete-selection (if cua-delete-selection
(delete-selection-mode 1) (delete-selection-mode 1)
(if (and (boundp 'delete-selection-mode) delete-selection-mode) (if (and (boundp 'delete-selection-mode) delete-selection-mode)
(delete-selection-mode -1))) (delete-selection-mode -1)))
(if (and (boundp 'pc-selection-mode) pc-selection-mode) (if cua-highlight-region-shift-only (transient-mark-mode -1))
(pc-selection-mode -1)) (cua--deactivate))
(cua--deactivate)
(setq shift-select-mode t)
(transient-mark-mode (if cua-highlight-region-shift-only -1 1)))
(cua--saved-state (cua--saved-state
(setq transient-mark-mode (car cua--saved-state)) (if (nth 0 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) (if (and (boundp 'delete-selection-mode) delete-selection-mode)
(delete-selection-mode -1))) (delete-selection-mode -1)))
(if (nth 2 cua--saved-state)
(pc-selection-mode 1))
(setq shift-select-mode (nth 3 cua--saved-state))
(if (called-interactively-p 'interactive) (if (called-interactively-p 'interactive)
(message "CUA mode disabled.%s%s%s%s" (message "CUA mode disabled.%s"
(if (nth 1 cua--saved-state) " Delete-Selection" "") (if (nth 0 cua--saved-state) " Delete-Selection enabled" "")))
(if (and (nth 1 cua--saved-state) (nth 2 cua--saved-state)) " and" "")
(if (nth 2 cua--saved-state) " PC-Selection" "")
(if (or (nth 1 cua--saved-state) (nth 2 cua--saved-state)) " enabled" "")))
(setq cua--saved-state nil)))) (setq cua--saved-state nil))))
......
...@@ -718,7 +718,8 @@ If command is repeated at same position, delete the rectangle." ...@@ -718,7 +718,8 @@ If command is repeated at same position, delete the rectangle."
(cdr (cdr cua--last-rectangle)) (cdr (cdr cua--last-rectangle))
(cua--rectangle-get-corners)) (cua--rectangle-get-corners))
cua--status-string (if (cua--rectangle-virtual-edges) " [R]" "") cua--status-string (if (cua--rectangle-virtual-edges) " [R]" "")
cua--last-rectangle nil)) cua--last-rectangle nil)
(activate-mark))
;; (defvar cua-save-point nil) ;; (defvar cua-save-point nil)
...@@ -731,7 +732,8 @@ If command is repeated at same position, delete the rectangle." ...@@ -731,7 +732,8 @@ If command is repeated at same position, delete the rectangle."
cua--rectangle nil cua--rectangle nil
cua--rectangle-overlays nil cua--rectangle-overlays nil
cua--status-string nil cua--status-string nil
cua--mouse-last-pos nil)) cua--mouse-last-pos nil)
(deactivate-mark))
(defun cua--highlight-rectangle () (defun cua--highlight-rectangle ()
;; This function is used to highlight the rectangular region. ;; This function is used to highlight the rectangular region.
......
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