(defgroup cua nil
"Emulate CUA key bindings including C-x and C-c."
:prefix "cua"
:group 'editing-basics
:group 'convenience
:group 'emulations
:version "22.1"
:link '(emacs-commentary-link :tag "Commentary" "cua-base.el")
:link '(emacs-library-link :tag "Lisp File" "cua-base.el"))
(defcustom cua-enable-cua-keys t
"*Enable using C-z, C-x, C-c, and C-v for undo, cut, copy, and paste.
If the value is t, these mappings are always enabled. If the value is
`shift', these keys are only enabled if the last region was marked with
a shifted movement key. If the value is nil, these keys are never
enabled."
:type '(choice (const :tag "Disabled" nil)
(const :tag "Shift region only" shift)
(other :tag "Enabled" t))
:group 'cua)
(defcustom cua-highlight-region-shift-only nil
"*If non-nil, only highlight region if marked with S-<move>.
When this is non-nil, CUA toggles `transient-mark-mode' on when the region
is marked using shifted movement keys, and off when the mark is cleared.
But when the mark was set using \\[cua-set-mark], transient-mark-mode
is not turned on."
:type 'boolean
:group 'cua)
(defcustom cua-prefix-override-inhibit-delay
(if (featurep 'lisp-float-type) (/ (float 1) (float 5)) nil)
"*If non-nil, time in seconds to delay before overriding prefix key.
If there is additional input within this time, the prefix key is
used as a normal prefix key. So typing a key sequence quickly will
inhibit overriding the prefix key.
As a special case, if the prefix keys repeated within this time, the
first prefix key is discarded, so typing a prefix key twice in quick
succession will also inhibit overriding the prefix key.
If the value is nil, use a shifted prefix key to inhibit the override."
:type '(choice (number :tag "Inhibit delay")
(const :tag "No delay" nil))
:group 'cua)
(defcustom cua-delete-selection t
"*If non-nil, typed text replaces text in the active selection."
:type '(choice (const :tag "Disabled" nil)
(other :tag "Enabled" t))
:group 'cua)
(defcustom cua-keep-region-after-copy nil
"If non-nil, don't deselect the region after copying."
:type 'boolean
:group 'cua)
(defcustom cua-toggle-set-mark t
"*If non-nil, the `cua-set-mark' command toggles the mark."
:type '(choice (const :tag "Disabled" nil)
(other :tag "Enabled" t))
:group 'cua)
(defcustom cua-auto-mark-last-change nil
"*If non-nil, set implicit mark at position of last buffer change.
This means that \\[universal-argument] \\[cua-set-mark] will jump to the position
of the last buffer change before jumping to the explicit marks on the mark ring.
See `cua-set-mark' for details."
:type 'boolean
:group 'cua)
(defcustom cua-enable-register-prefix 'not-ctrl-u
"*If non-nil, registers are supported via numeric prefix arg.
If the value is t, any numeric prefix arg in the range 0 to 9 will be
interpreted as a register number.
If the value is `not-ctrl-u', using C-u to enter a numeric prefix is not
interpreted as a register number.
If the value is `ctrl-u-only', only numeric prefix entered with C-u is
interpreted as a register number."
:type '(choice (const :tag "Disabled" nil)
(const :tag "Enabled, but C-u arg is not a register" not-ctrl-u)
(const :tag "Enabled, but only for C-u arg" ctrl-u-only)
(other :tag "Enabled" t))
:group 'cua)
(defcustom cua-delete-copy-to-register-0 t
"*If non-nil, save last deleted region or rectangle to register 0."
:type 'boolean
:group 'cua)
(defcustom cua-enable-region-auto-help nil
"*If non-nil, automatically show help for active region."
:type 'boolean
:group 'cua)
(defcustom cua-enable-modeline-indications nil
"*If non-nil, use minor-mode hook to show status in mode line."
:type 'boolean
:group 'cua)
(defcustom cua-check-pending-input t
"*If non-nil, don't override prefix key if input pending.
It is rumoured that `input-pending-p' is unreliable under some window
managers, so try setting this to nil, if prefix override doesn't work."
:type 'boolean
:group 'cua)
(defcustom cua-paste-pop-rotate-temporarily nil
"*If non-nil, \\[cua-paste-pop] only rotates the kill-ring temporarily.
This means that both \\[yank] and the first \\[yank-pop] in a sequence always insert
the most recently killed text. Each immediately following \\[cua-paste-pop] replaces
the previous text with the next older element on the `kill-ring'.
With prefix arg, \\[universal-argument] \\[yank-pop] inserts the same text as the most
recent \\[yank-pop] (or \\[yank]) command."
:type 'boolean
:group 'cua)
(defcustom cua-virtual-rectangle-edges t
"*If non-nil, rectangles have virtual straight edges.
Note that although rectangles are always DISPLAYED with straight edges, the
buffer is NOT modified, until you execute a command that actually modifies it.
M-p toggles this feature when a rectangle is active."
:type 'boolean
:group 'cua)
(defcustom cua-auto-tabify-rectangles 1000
"*If non-nil, automatically tabify after rectangle commands.
This basically means that `tabify' is applied to all lines that
are modified by inserting or deleting a rectangle. If value is
an integer, CUA will look for existing tabs in a region around
the rectangle, and only do the conversion if any tabs are already
present. The number specifies then number of characters before
and after the region marked by the rectangle to search."
:type '(choice (number :tag "Auto detect (limit)")
(const :tag "Disabled" nil)
(other :tag "Enabled" t))
:group 'cua)
(defvar cua-global-keymap) (defvar cua--region-keymap)
(defcustom cua-rectangle-mark-key [(control return)]
"Global key used to toggle the cua rectangle mark."
:set #'(lambda (symbol value)
(set symbol value)
(when (and (boundp 'cua--keymaps-initalized)
cua--keymaps-initalized)
(define-key cua-global-keymap value
'cua-set-rectangle-mark)
(when (boundp 'cua--rectangle-keymap)
(define-key cua--rectangle-keymap value
'cua-clear-rectangle-mark)
(define-key cua--region-keymap value
'cua-toggle-rectangle-mark))))
:type 'key-sequence
:group 'cua)
(defcustom cua-rectangle-modifier-key 'meta
"*Modifier key used for rectangle commands bindings.
On non-window systems, always use the meta modifier.
Must be set prior to enabling CUA."
:type '(choice (const :tag "Meta key" meta)
(const :tag "Alt key" alt)
(const :tag "Hyper key" hyper)
(const :tag "Super key" super))
:group 'cua)
(defcustom cua-enable-rectangle-auto-help t
"*If non-nil, automatically show help for region, rectangle and global mark."
:type 'boolean
:group 'cua)
(defface cua-rectangle
'((default :inherit region)
(((class color)) :foreground "white" :background "maroon"))
"*Font used by CUA for highlighting the rectangle."
:group 'cua)
(defface cua-rectangle-noselect
'((default :inherit region)
(((class color)) :foreground "white" :background "dimgray"))
"*Font used by CUA for highlighting the non-selected rectangle lines."
:group 'cua)
(defcustom cua-global-mark-keep-visible t
"*If non-nil, always keep global mark visible in other window."
:type 'boolean
:group 'cua)
(defface cua-global-mark
'((((min-colors 88)(class color)) :foreground "black" :background "yellow1")
(((class color)) :foreground "black" :background "yellow")
(t :bold t))
"*Font used by CUA for highlighting the global mark."
:group 'cua)
(defcustom cua-global-mark-blink-cursor-interval 0.20
"*Blink cursor at this interval when global mark is active."
:type '(choice (number :tag "Blink interval")
(const :tag "No blink" nil))
:group 'cua)
(defcustom cua-enable-cursor-indications nil
"*If non-nil, use different cursor colors for indications."
:type 'boolean
:group 'cua)
(defcustom cua-normal-cursor-color (or (and (boundp 'initial-cursor-color) initial-cursor-color)
(and (boundp 'initial-frame-alist)
(assoc 'cursor-color initial-frame-alist)
(cdr (assoc 'cursor-color initial-frame-alist)))
(and (boundp 'default-frame-alist)
(assoc 'cursor-color default-frame-alist)
(cdr (assoc 'cursor-color default-frame-alist)))
(frame-parameter nil 'cursor-color)
"red")
"Normal (non-overwrite) cursor color.
Default is to load cursor color from initial or default frame parameters.
If the value is a COLOR name, then only the `cursor-color' attribute will be
affected. If the value is a cursor TYPE (one of: box, hollow, bar, or hbar),
then only the `cursor-type' property will be affected. If the value is
a cons (TYPE . COLOR), then both properties are affected."
:initialize 'custom-initialize-default
:type '(choice
(color :tag "Color")
(choice :tag "Type"
(const :tag "Filled box" box)
(const :tag "Vertical bar" bar)
(const :tag "Horizontal bar" hbar)
(const :tag "Hollow box" hollow))
(cons :tag "Color and Type"
(choice :tag "Type"
(const :tag "Filled box" box)
(const :tag "Vertical bar" bar)
(const :tag "Horizontal bar" hbar)
(const :tag "Hollow box" hollow))
(color :tag "Color")))
:group 'cua)
(defcustom cua-read-only-cursor-color "darkgreen"
"*Cursor color used in read-only buffers, if non-nil.
Only used when `cua-enable-cursor-indications' is non-nil.
If the value is a COLOR name, then only the `cursor-color' attribute will be
affected. If the value is a cursor TYPE (one of: box, hollow, bar, or hbar),
then only the `cursor-type' property will be affected. If the value is
a cons (TYPE . COLOR), then both properties are affected."
:type '(choice
(color :tag "Color")
(choice :tag "Type"
(const :tag "Filled box" box)
(const :tag "Vertical bar" bar)
(const :tag "Horizontal bar" hbar)
(const :tag "Hollow box" hollow))
(cons :tag "Color and Type"
(choice :tag "Type"
(const :tag "Filled box" box)
(const :tag "Vertical bar" bar)
(const :tag "Horizontal bar" hbar)
(const :tag "Hollow box" hollow))
(color :tag "Color")))
:group 'cua)
(defcustom cua-overwrite-cursor-color "yellow"
"*Cursor color used when overwrite mode is set, if non-nil.
Only used when `cua-enable-cursor-indications' is non-nil.
If the value is a COLOR name, then only the `cursor-color' attribute will be
affected. If the value is a cursor TYPE (one of: box, hollow, bar, or hbar),
then only the `cursor-type' property will be affected. If the value is
a cons (TYPE . COLOR), then both properties are affected."
:type '(choice
(color :tag "Color")
(choice :tag "Type"
(const :tag "Filled box" box)
(const :tag "Vertical bar" bar)
(const :tag "Horizontal bar" hbar)
(const :tag "Hollow box" hollow))
(cons :tag "Color and Type"
(choice :tag "Type"
(const :tag "Filled box" box)
(const :tag "Vertical bar" bar)
(const :tag "Horizontal bar" hbar)
(const :tag "Hollow box" hollow))
(color :tag "Color")))
:group 'cua)
(defcustom cua-global-mark-cursor-color "cyan"
"*Indication for active global mark.
Will change cursor color to specified color if string.
Only used when `cua-enable-cursor-indications' is non-nil.
If the value is a COLOR name, then only the `cursor-color' attribute will be
affected. If the value is a cursor TYPE (one of: box, hollow, bar, or hbar),
then only the `cursor-type' property will be affected. If the value is
a cons (TYPE . COLOR), then both properties are affected."
:type '(choice
(color :tag "Color")
(choice :tag "Type"
(const :tag "Filled box" box)
(const :tag "Vertical bar" bar)
(const :tag "Horizontal bar" hbar)
(const :tag "Hollow box" hollow))
(cons :tag "Color and Type"
(choice :tag "Type"
(const :tag "Filled box" box)
(const :tag "Vertical bar" bar)
(const :tag "Horizontal bar" hbar)
(const :tag "Hollow box" hollow))
(color :tag "Color")))
:group 'cua)
(autoload 'cua-set-rectangle-mark "cua-rect" nil t nil)
(when (not (featurep 'cua-rect))
(defvar cua--rectangle)
(setq cua--rectangle nil)
(defvar cua--last-killed-rectangle)
(setq cua--last-killed-rectangle nil))
(autoload 'cua-toggle-global-mark "cua-gmrk" nil t nil)
(when (not (featurep 'cua-gmrk))
(defvar cua--global-mark-active)
(setq cua--global-mark-active nil))
(provide 'cua-base)
(eval-when-compile
(require 'cua-rect)
(require 'cua-gmrk)
)
(defvar cua-inhibit-cua-keys nil
"Buffer-local variable that may disable the CUA keymappings.")
(make-variable-buffer-local 'cua-inhibit-cua-keys)
(defvar cua--explicit-region-start nil)
(make-variable-buffer-local 'cua--explicit-region-start)
(defvar cua--last-region-shifted nil)
(defvar cua--buffer-and-point-before-command nil)
(defvar cua--status-string nil)
(make-variable-buffer-local 'cua--status-string)
(defvar cua--debug nil)
(defvar cua--prefix-override-timer nil)
(defvar cua--prefix-override-length nil)
(defun cua--prefix-override-replay (arg repeat)
(let* ((keys (this-command-keys))
(i (length keys))
(key (aref keys (1- i))))
(setq cua--prefix-override-length (- i repeat))
(setq cua--prefix-override-timer
(or
(> repeat 0)
(and cua-check-pending-input (input-pending-p))
(not (numberp cua-prefix-override-inhibit-delay))
(<= cua-prefix-override-inhibit-delay 0)
(run-with-timer cua-prefix-override-inhibit-delay nil
'cua--prefix-override-timeout)))
(setq this-command last-command)
(setq prefix-arg arg)
(reset-this-command-lengths)
(setq unread-command-events (cons key unread-command-events))))
(defun cua--prefix-override-handler (arg)
"Start timer waiting for prefix key to be followed by another key.
Repeating prefix key when region is active works as a single prefix key."
(interactive "P")
(cua--prefix-override-replay arg 0))
(defun cua--prefix-repeat-handler (arg)
"Repeating prefix key when region is active works as a single prefix key."
(interactive "P")
(cua--prefix-override-replay arg 1))
(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))
(let ((keys (this-single-command-keys)))
(setq unread-command-events
(cons (aref keys (1- (length keys))) unread-command-events))))
(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))
(let ((keys (this-single-command-keys)))
(setq unread-command-events
(cons (aref keys (1- (length keys))) unread-command-events))))
(defun cua--prefix-override-timeout ()
(setq cua--prefix-override-timer t)
(when (= (length (this-command-keys)) cua--prefix-override-length)
(setq unread-command-events (cons 'timeout unread-command-events))
(if prefix-arg
(reset-this-command-lengths)
(setq overriding-terminal-local-map nil))
(cua--select-keymaps)))
(defun cua--fallback ()
(setq this-command this-original-command)
(call-interactively this-command))
(defun cua--keep-active ()
(setq mark-active t
deactivate-mark nil))
(defun cua--deactivate (&optional now)
(setq cua--explicit-region-start nil)
(if (not now)
(setq deactivate-mark t)
(setq mark-active nil)
(run-hooks 'deactivate-mark-hook)))
(defvar cua--register nil)
(defun cua--prefix-arg (arg)
(setq cua--register
(and cua-enable-register-prefix
(integerp arg) (>= arg 0) (< arg 10)
(let* ((prefix (aref (this-command-keys) 0))
(ctrl-u-prefix (and (integerp prefix)
(= prefix ?\C-u))))
(cond
((eq cua-enable-register-prefix 'not-ctrl-u)
(not ctrl-u-prefix))
((eq cua-enable-register-prefix 'ctrl-u-only)
ctrl-u-prefix)
(t t)))
(+ arg ?0)))
(if cua--register nil arg))
(defvar cua--last-deleted-region-pos nil)
(defvar cua--last-deleted-region-text nil)
(defun cua-delete-region ()
"Delete the active region.
Save a copy in register 0 if `cua-delete-copy-to-register-0' is non-nil."
(interactive)
(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))
(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)
(car buffer-undo-list))))
(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."
(interactive "P")
(setq arg (cua--prefix-arg arg))
(setq cua--last-killed-rectangle nil)
(let ((start (mark)) (end (point)))
(or (<= start end)
(setq start (prog1 end (setq end start))))
(cond
(cua--register
(copy-to-register cua--register start end nil))
((eq this-original-command 'clipboard-kill-ring-save)
(clipboard-kill-ring-save start end))
(t
(copy-region-as-kill start end)))
(if cua-keep-region-after-copy
(cua--keep-active)
(cua--deactivate))))
(defun cua-cut-region (arg)
"Cut the region and copy to the kill ring.
With numeric prefix arg, copy to register 0-9 instead."
(interactive "P")
(setq cua--last-killed-rectangle nil)
(if buffer-read-only
(cua-copy-region arg)
(setq arg (cua--prefix-arg arg))
(let ((start (mark)) (end (point)))
(or (<= start end)
(setq start (prog1 end (setq end start))))
(cond
(cua--register
(copy-to-register cua--register start end t))
((eq this-original-command 'clipboard-kill-region)
(clipboard-kill-region start end))
(t
(kill-region start end))))
(cua--deactivate)))
(defun cua-cancel ()
"Cancel the active region, rectangle, or global mark."
(interactive)
(setq mark-active nil)
(setq cua--explicit-region-start nil)
(if (fboundp 'cua--cancel-rectangle)
(cua--cancel-rectangle)))
(defun cua-paste (arg)
"Paste last cut or copied region or rectangle.
An active region is deleted before executing the command.
With numeric prefix arg, paste from register 0-9 instead.
If global mark is active, copy from register or one character."
(interactive "P")
(setq arg (cua--prefix-arg arg))
(let ((regtxt (and cua--register (get-register cua--register)))
(count (prefix-numeric-value arg))
paste-column paste-lines)
(cond
((and cua--register (not regtxt))
(message "Nothing in register %c" cua--register))
(cua--global-mark-active
(if regtxt
(cua--insert-at-global-mark regtxt)
(when (not (eobp))
(cua--insert-at-global-mark (filter-buffer-substring (point) (+ (point) count)))
(forward-char count))))
(buffer-read-only
(message "Cannot paste into a read-only buffer"))
(t
(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))) (if (string= (filter-buffer-substring (point) (mark))
(car kill-ring))
(current-kill 1))
(cua-delete-region)))
(cond
(regtxt
(cond
((consp regtxt) (cua--insert-rectangle regtxt))
((stringp regtxt) (insert-for-yank regtxt))
(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)
(clipboard-yank))
((eq this-original-command 'x-clipboard-yank)
(x-clipboard-yank))
(t (yank arg)))))))
(defvar cua-paste-pop-count nil)
(defun cua-paste-pop (arg)
"Replace a just-pasted text or rectangle with a different text.
See `yank-pop' for details about the default behaviour. For an alternative
behaviour, see `cua-paste-pop-rotate-temporarily'."
(interactive "P")
(cond
((eq last-command 'cua--paste-rectangle)
(undo)
(yank arg))
((not cua-paste-pop-rotate-temporarily)
(yank-pop (prefix-numeric-value arg)))
(t
(let ((rotate (if (consp arg) 1 (prefix-numeric-value arg))))
(cond
((or (null cua-paste-pop-count)
(eq last-command 'yank)
(eq last-command 'cua-paste))
(setq cua-paste-pop-count rotate)
(setq last-command 'yank)
(yank-pop cua-paste-pop-count))
((and (eq last-command 'cua-paste-pop) (not (consp arg)))
(setq cua-paste-pop-count (+ cua-paste-pop-count rotate))
(setq last-command 'yank)
(yank-pop cua-paste-pop-count))
(t
(setq cua-paste-pop-count
(if (consp arg) (+ cua-paste-pop-count rotate -1) 1))
(yank (1+ cua-paste-pop-count)))))
(setq kill-ring-yank-pointer kill-ring)
(setq this-command 'cua-paste-pop))))
(defun cua-exchange-point-and-mark (arg)
"Exchanges point and mark, but don't activate the mark.
Activates the mark if a prefix argument is given."
(interactive "P")
(if arg
(setq mark-active t)
(let (mark-active)
(exchange-point-and-mark)
(if cua--rectangle
(cua--rectangle-corner 0)))))
(defvar cua--repeat-replace-text nil)
(defun cua-repeat-replace-region (arg)
"Repeat replacing text of highlighted region with typed text.
Searches for the next stretch of text identical to the region last
replaced by typing text over it and replaces it with the same stretch
of text."
(interactive "P")
(when cua--last-deleted-region-pos
(save-excursion
(save-restriction
(set-buffer (car cua--last-deleted-region-pos))
(widen)
(let ((ul buffer-undo-list)
(elt (cdr cua--last-deleted-region-pos))
u s e)
(when elt
(while (consp ul)
(setq u (car ul) ul (cdr ul))
(cond
((eq u elt) (setq ul nil))
((and (consp u) (integerp (car u)) (integerp (cdr u)))
(if (and s (= (cdr u) s))
(setq s (car u))
(setq s (car u) e (cdr u)))))))
(cond ((and s e (<= s e) (= s (mark t)))
(setq cua--repeat-replace-text
(filter-buffer-substring s e nil t)))
((and (null s) (eq u elt)) (setq cua--repeat-replace-text
""))
(t
(message "Cannot locate replacement text"))))))
(setq cua--last-deleted-region-pos nil))
(if (and cua--last-deleted-region-text
cua--repeat-replace-text
(search-forward cua--last-deleted-region-text nil t nil))
(replace-match cua--repeat-replace-text arg t)))
(defun cua-help-for-region (&optional help)
"Show region specific help in echo area."
(interactive)
(message
(concat (if help "C-?:help " "")
"C-z:undo C-x:cut C-c:copy C-v:paste S-ret:rect")))
(defun cua-pop-to-last-change ()
(let ((undo-list buffer-undo-list)
pos elt)
(while (and (not pos)
(consp undo-list))
(setq elt (car undo-list)
undo-list (cdr undo-list))
(cond
((integerp elt)
(setq pos elt))
((not (consp elt)))
((and (integerp (cdr elt))
(or (integerp (car elt)) (stringp (car elt))))
(setq pos (cdr elt)))
((and (eq (car elt) 'apply) (consp (cdr elt)) (integerp (cadr elt)))
(setq pos (nth 3 elt)))))
(when (and pos
(/= pos (point))
(>= pos (point-min)) (<= pos (point-max)))
(goto-char pos)
t)))
(defun cua-set-mark (&optional arg)
"Set mark at where point is, clear mark, or jump to mark.
With no prefix argument, clear mark if already set. Otherwise, set
mark, and push old mark position on local mark ring; also push mark on
global mark ring if last mark was set in another buffer.
With argument, jump to mark, and pop a new position for mark off
the local mark ring (this does not affect the global mark ring).
Use \\[pop-global-mark] to jump to a mark off the global mark ring
\(see `pop-global-mark').
If `cua-auto-mark-last-change' is non-nil, this command behaves as if there
was an implicit mark at the position of the last buffer change.
Repeating the command without the prefix jumps to the next position
off the local (or global) mark ring.
With a double \\[universal-argument] prefix argument, unconditionally set mark."
(interactive "P")
(cond
((and (consp arg) (> (prefix-numeric-value arg) 4))
(push-mark-command nil))
((eq last-command 'pop-to-mark-command)
(setq this-command 'pop-to-mark-command)
(pop-to-mark-command))
((and (eq last-command 'pop-global-mark) (not arg))
(setq this-command 'pop-global-mark)
(pop-global-mark))
(arg
(setq this-command 'pop-to-mark-command)
(or (and cua-auto-mark-last-change
(cua-pop-to-last-change))
(pop-to-mark-command)))
((and cua-toggle-set-mark mark-active)
(cua--deactivate)
(message "Mark Cleared"))
(t
(push-mark-command nil nil)
(setq cua--explicit-region-start t)
(setq cua--last-region-shifted nil)
(if cua-enable-region-auto-help
(cua-help-for-region t)))))
(defun cua-scroll-up (&optional arg)
"Scroll text of current window upward ARG lines; or near full screen if no ARG.
If window cannot be scrolled further, move cursor to bottom line instead.
A near full screen is `next-screen-context-lines' less than a full screen.
Negative ARG means scroll downward.
If ARG is the atom `-', scroll downward by nearly full screen."
(interactive "P")
(cond
((eq arg '-) (cua-scroll-down nil))
((< (prefix-numeric-value arg) 0)
(cua-scroll-down (- (prefix-numeric-value arg))))
((eobp)
(scroll-up arg)) (t
(condition-case nil
(scroll-up arg)
(end-of-buffer (goto-char (point-max)))))))
(put 'cua-scroll-up 'CUA 'move)
(defun cua-scroll-down (&optional arg)
"Scroll text of current window downward ARG lines; or near full screen if no ARG.
If window cannot be scrolled further, move cursor to top line instead.
A near full screen is `next-screen-context-lines' less than a full screen.
Negative ARG means scroll upward.
If ARG is the atom `-', scroll upward by nearly full screen."
(interactive "P")
(cond
((eq arg '-) (cua-scroll-up nil))
((< (prefix-numeric-value arg) 0)
(cua-scroll-up (- (prefix-numeric-value arg))))
((bobp)
(scroll-down arg)) (t
(condition-case nil
(scroll-down arg)
(beginning-of-buffer (goto-char (point-min)))))))
(put 'cua-scroll-down 'CUA 'move)
(defun cua--update-indications ()
(let* ((cursor
(cond
((and cua--global-mark-active
cua-global-mark-cursor-color)
cua-global-mark-cursor-color)
((and buffer-read-only
cua-read-only-cursor-color)
cua-read-only-cursor-color)
((and cua-overwrite-cursor-color overwrite-mode)
cua-overwrite-cursor-color)
(t cua-normal-cursor-color)))
(color (if (consp cursor) (cdr cursor) cursor))
(type (if (consp cursor) (car cursor) cursor)))
(if (and color
(stringp color)
(not (equal color (frame-parameter nil 'cursor-color))))
(set-cursor-color color))
(if (and type
(symbolp type)
(not (eq type default-cursor-type)))
(setq default-cursor-type type))))
(defun cua--pre-command-handler-1 ()
(when cua--prefix-override-timer
(if (timerp cua--prefix-override-timer)
(cancel-timer cua--prefix-override-timer))
(setq cua--prefix-override-timer nil))
(cond
((not (symbolp this-command))
nil)
((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 'cua-replace-region)))))
(if nc
(setq this-original-command this-command
this-command nc)))))
((if window-system
(memq 'shift (event-modifiers
(aref (this-single-command-raw-keys) 0)))
(or
(memq 'shift (event-modifiers
(aref (this-single-command-keys) 0)))
(and (boundp 'function-key-map)
function-key-map
(let ((ev (lookup-key function-key-map
(this-single-command-raw-keys))))
(and (vector ev)
(symbolp (setq ev (aref ev 0)))
(string-match "S-" (symbol-name ev)))))))
(unless mark-active
(push-mark-command nil t))
(setq cua--last-region-shifted t)
(setq cua--explicit-region-start nil))
((or cua--explicit-region-start cua--rectangle)
(unless mark-active
(push-mark-command nil nil)))
(t
(setq deactivate-mark t)))
(setq cua--buffer-and-point-before-command
(if cua--rectangle (cons (current-buffer) (point)))))
(defun cua--pre-command-handler ()
(when cua-mode
(condition-case nil
(cua--pre-command-handler-1)
(error nil))))
(defun cua--post-command-handler-1 ()
(when cua--global-mark-active
(cua--global-mark-post-command))
(when (fboundp 'cua--rectangle-post-command)
(cua--rectangle-post-command))
(setq cua--buffer-and-point-before-command nil)
(if (or (not mark-active) deactivate-mark)
(setq cua--explicit-region-start nil))
(if cua--debug
(cond
(cua--rectangle (cua--rectangle-assert))
(mark-active (message "Mark=%d Point=%d Expl=%s"
(mark t) (point) cua--explicit-region-start))))
(if (not (window-minibuffer-p (selected-window)))
(setq transient-mark-mode (and (not cua--rectangle)
(if cua-highlight-region-shift-only
(not cua--explicit-region-start)
t))))
(if cua-enable-cursor-indications
(cua--update-indications))
(cua--select-keymaps))
(defun cua--post-command-handler ()
(when cua-mode
(condition-case nil
(cua--post-command-handler-1)
(error nil))))
(defvar cua--rectangle-modifier-key 'meta)
(defun cua--M/H-key (map key fct)
(unless (listp key) (setq key (list key)))
(define-key map (vector (cons cua--rectangle-modifier-key key)) fct))
(defun cua--self-insert-char-p (def)
(if (memq (global-key-binding (this-single-command-keys))
'(self-insert-command self-insert-iso))
def nil))
(defvar cua-global-keymap (make-sparse-keymap)
"Global keymap for cua-mode; users may add to this keymap.")
(defvar cua--cua-keys-keymap (make-sparse-keymap))
(defvar cua--prefix-override-keymap (make-sparse-keymap))
(defvar cua--prefix-repeat-keymap (make-sparse-keymap))
(defvar cua--global-mark-keymap (make-sparse-keymap)) (defvar cua--rectangle-keymap (make-sparse-keymap)) (defvar cua--region-keymap (make-sparse-keymap))
(defvar cua--ena-cua-keys-keymap nil)
(defvar cua--ena-prefix-override-keymap nil)
(defvar cua--ena-prefix-repeat-keymap nil)
(defvar cua--ena-region-keymap nil)
(defvar cua--ena-global-mark-keymap nil)
(defvar cua--keymap-alist
`((cua--ena-prefix-override-keymap . ,cua--prefix-override-keymap)
(cua--ena-prefix-repeat-keymap . ,cua--prefix-repeat-keymap)
(cua--ena-cua-keys-keymap . ,cua--cua-keys-keymap)
(cua--ena-global-mark-keymap . ,cua--global-mark-keymap)
(cua--rectangle . ,cua--rectangle-keymap)
(cua--ena-region-keymap . ,cua--region-keymap)
(cua-mode . ,cua-global-keymap)))
(defun cua--select-keymaps ()
(setq cua--ena-region-keymap
(and mark-active (not deactivate-mark)))
(setq cua--ena-prefix-override-keymap
(and cua--ena-region-keymap
cua-enable-cua-keys
(not cua-inhibit-cua-keys)
(or (eq cua-enable-cua-keys t)
(not cua--explicit-region-start))
(not executing-kbd-macro)
(not cua--prefix-override-timer)))
(setq cua--ena-prefix-repeat-keymap
(and cua--ena-region-keymap
(or (timerp cua--prefix-override-timer)
(eq cua--prefix-override-timer 'shift))))
(setq cua--ena-cua-keys-keymap
(and cua-enable-cua-keys
(not cua-inhibit-cua-keys)
(or (eq cua-enable-cua-keys t)
cua--last-region-shifted)))
(setq cua--ena-global-mark-keymap
(and cua--global-mark-active
(not (window-minibuffer-p)))))
(defvar cua--keymaps-initalized nil)
(defun cua--shift-control-prefix (prefix arg)
(setq this-command last-command)
(setq prefix-arg arg)
(reset-this-command-lengths)
(setq cua--prefix-override-timer 'shift)
(setq unread-command-events (cons prefix (cons prefix unread-command-events))))
(defun cua--shift-control-c-prefix (arg)
(interactive "P")
(cua--shift-control-prefix ?\C-c arg))
(defun cua--shift-control-x-prefix (arg)
(interactive "P")
(cua--shift-control-prefix ?\C-x arg))
(defun cua--init-keymaps ()
(setq cua--rectangle-modifier-key
(if (and cua-rectangle-modifier-key
(memq window-system '(x)))
cua-rectangle-modifier-key
'meta))
(define-key cua-global-keymap cua-rectangle-mark-key 'cua-set-rectangle-mark)
(unless (eq cua--rectangle-modifier-key 'meta)
(cua--M/H-key cua-global-keymap ?\s 'cua-set-rectangle-mark)
(define-key cua-global-keymap
(vector (list cua--rectangle-modifier-key 'mouse-1)) 'cua-mouse-set-rectangle-mark))
(define-key cua-global-keymap [(shift control ?\s)] 'cua-toggle-global-mark)
(define-key cua-global-keymap [remap yank] 'cua-paste)
(define-key cua-global-keymap [remap clipboard-yank] 'cua-paste)
(define-key cua-global-keymap [remap x-clipboard-yank] 'cua-paste)
(define-key cua-global-keymap [remap yank-pop] 'cua-paste-pop)
(define-key cua-global-keymap [remap set-mark-command] 'cua-set-mark)
(define-key cua-global-keymap [remap scroll-up] 'cua-scroll-up)
(define-key cua-global-keymap [remap scroll-down] 'cua-scroll-down)
(define-key cua--cua-keys-keymap [(control x) timeout] 'kill-region)
(define-key cua--cua-keys-keymap [(control c) timeout] 'copy-region-as-kill)
(define-key cua--cua-keys-keymap [(control z)] 'undo)
(define-key cua--cua-keys-keymap [(control v)] 'yank)
(define-key cua--cua-keys-keymap [(meta v)] 'cua-repeat-replace-region)
(define-key cua--cua-keys-keymap [remap exchange-point-and-mark] 'cua-exchange-point-and-mark)
(define-key cua--prefix-override-keymap [(control x)] 'cua--prefix-override-handler)
(define-key cua--prefix-override-keymap [(control c)] 'cua--prefix-override-handler)
(define-key cua--prefix-repeat-keymap [(control x) (control x)] 'cua--prefix-repeat-handler)
(define-key cua--prefix-repeat-keymap [(control x) up] 'cua--prefix-cut-handler)
(define-key cua--prefix-repeat-keymap [(control x) down] 'cua--prefix-cut-handler)
(define-key cua--prefix-repeat-keymap [(control x) left] 'cua--prefix-cut-handler)
(define-key cua--prefix-repeat-keymap [(control x) right] 'cua--prefix-cut-handler)
(define-key cua--prefix-repeat-keymap [(control c) (control c)] 'cua--prefix-repeat-handler)
(define-key cua--prefix-repeat-keymap [(control c) up] 'cua--prefix-copy-handler)
(define-key cua--prefix-repeat-keymap [(control c) down] 'cua--prefix-copy-handler)
(define-key cua--prefix-repeat-keymap [(control c) left] 'cua--prefix-copy-handler)
(define-key cua--prefix-repeat-keymap [(control c) right] 'cua--prefix-copy-handler)
(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 [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)
(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-untabify] 'cua-delete-region)
(define-key cua--region-keymap [remap delete-char] 'cua-delete-region)
(define-key cua--region-keymap [remap kill-region] 'cua-cut-region)
(define-key cua--region-keymap [remap clipboard-kill-region] 'cua-cut-region)
(define-key cua--region-keymap [remap copy-region-as-kill] 'cua-copy-region)
(define-key cua--region-keymap [remap kill-ring-save] 'cua-copy-region)
(define-key cua--region-keymap [remap clipboard-kill-ring-save] 'cua-copy-region)
(define-key cua--region-keymap [remap keyboard-escape-quit] 'cua-cancel)
(define-key cua--region-keymap [remap keyboard-quit] 'cua-cancel)
)
(dolist (cmd
'(forward-char backward-char
next-line previous-line
forward-word backward-word
end-of-line beginning-of-line
move-end-of-line move-beginning-of-line
end-of-buffer beginning-of-buffer
scroll-up scroll-down
up-list down-list backward-up-list
end-of-defun beginning-of-defun
forward-sexp backward-sexp
forward-list backward-list
forward-sentence backward-sentence
forward-paragraph backward-paragraph))
(put cmd 'CUA 'move))
(defvar cua--saved-state nil)
(define-minor-mode cua-mode
"Toggle CUA key-binding mode.
When enabled, using shifted movement keys will activate the
region (and highlight the region using `transient-mark-mode'),
and typed text replaces the active selection.
Also when enabled, you can use C-z, C-x, C-c, and C-v to undo,
cut, copy, and paste in addition to the normal Emacs bindings.
The C-x and C-c keys only do cut and copy when the region is
active, so in most cases, they do not conflict with the normal
function of these prefix keys.
If you really need to perform a command which starts with one of
the prefix keys even when the region is active, you have three
options:
- press the prefix key twice very quickly (within 0.2 seconds),
- press the prefix key and the following key within 0.2 seconds, or
- use the SHIFT key with the prefix key, i.e. C-S-x or C-S-c.
You can customize `cua-enable-cua-keys' to completely disable the
CUA bindings, or `cua-prefix-override-inhibit-delay' to change
the prefix fallback behavior.
CUA mode manages Transient Mark mode internally. Trying to disable
Transient Mark mode while CUA mode is enabled does not work; if you
only want to highlight the region when it is selected using a
shifted movement key, set `cua-highlight-region-shift-only'."
:global t
:group 'cua
:set-after '(cua-enable-modeline-indications
cua-rectangle-mark-key cua-rectangle-modifier-key)
:require 'cua-base
:link '(emacs-commentary-link "cua-base.el")
(setq mark-even-if-inactive t)
(setq highlight-nonselected-windows nil)
(unless cua--keymaps-initalized
(cua--init-keymaps)
(setq cua--keymaps-initalized t))
(if cua-mode
(progn
(add-hook 'pre-command-hook 'cua--pre-command-handler)
(add-hook 'post-command-hook 'cua--post-command-handler)
(if (and cua-enable-modeline-indications (not (assoc 'cua-mode minor-mode-alist)))
(setq minor-mode-alist (cons '(cua-mode cua--status-string) minor-mode-alist)))
(if cua-enable-cursor-indications
(cua--update-indications)))
(remove-hook 'pre-command-hook 'cua--pre-command-handler)
(remove-hook 'post-command-hook 'cua--post-command-handler))
(if (not cua-mode)
(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)
(cua--select-keymaps))
(cond
(cua-mode
(setq cua--saved-state
(list
transient-mark-mode
(and (boundp 'delete-selection-mode) delete-selection-mode)
(and (boundp 'pc-selection-mode) pc-selection-mode)))
(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)
(setq transient-mark-mode (and cua-mode
(if cua-highlight-region-shift-only
(not cua--explicit-region-start)
t))))
(cua--saved-state
(setq transient-mark-mode (car cua--saved-state))
(if (nth 1 cua--saved-state)
(delete-selection-mode 1))
(if (nth 2 cua--saved-state)
(pc-selection-mode 1))
(if (interactive-p)
(message "CUA mode disabled.%s%s%s%s"
(if (nth 1 cua--saved-state) " Delete-Selection" "")
(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))))
(defun cua-selection-mode (arg)
"Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings."
(interactive "P")
(setq-default cua-enable-cua-keys nil)
(cua-mode arg))
(defun cua-debug ()
"Toggle CUA debugging."
(interactive)
(setq cua--debug (not cua--debug)))
(provide 'cua)