;;; cua-base.el --- emulate CUA key bindings
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005 Free Software Foundation, Inc.
+;; 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Keywords: keyboard emulation convenience cua
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
(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
: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)
;;; Rectangle Customization
(other :tag "Enabled" t))
:group 'cua)
+(defvar cua-global-keymap) ; forward
+(defvar cua--region-keymap) ; forward
+
+(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 "Hyper key" hyper )
+ (const :tag "Alt key" alt)
+ (const :tag "Hyper key" hyper)
(const :tag "Super key" super))
:group 'cua)
(let ((start (mark)) (end (point)))
(or (<= start end)
(setq start (prog1 end (setq end start))))
- (setq cua--last-deleted-region-text (buffer-substring start end))
+ (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)
(defun cua-replace-region ()
"Replace the active region with the character you type."
(interactive)
- (let ((not-empty (cua-delete-region)))
+ (let ((not-empty (and cua-delete-selection (cua-delete-region))))
(unless (eq this-original-command this-command)
(let ((overwrite-mode
(and overwrite-mode
(if regtxt
(cua--insert-at-global-mark regtxt)
(when (not (eobp))
- (cua--insert-at-global-mark (buffer-substring (point) (+ (point) count)))
+ (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
;; Must save register here, since delete may override reg 0.
(if mark-active
- ;; Before a yank command, make sure we don't yank
- ;; the same region that we are going to delete.
- ;; That would make yank a no-op.
(if cua--rectangle
(progn
(goto-char (min (mark) (point)))
(setq paste-lines (cua--delete-rectangle))
(if (= paste-lines 1)
(setq paste-lines nil))) ;; paste all
- (if (string= (buffer-substring (point) (mark))
- (car kill-ring))
+ ;; 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
+ ;; (when last-command is one that uses copy-region-as-kill
+ ;; or kill-new). That would make yank a no-op.
+ (if (and (string= (filter-buffer-substring (point) (mark))
+ (car kill-ring))
+ (memq last-command
+ '(mouse-set-region mouse-drag-region
+ mouse-save-then-kill mouse-secondary-save-then-kill)))
(current-kill 1))
(cua-delete-region)))
(cond
(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)))))))
+
+;; cua-paste-pop-rotate-temporarily == t mechanism:
+;;
+;; C-y M-y M-y => only rotates kill ring temporarily,
+;; so next C-y yanks what previous C-y yanked,
+;;
+;; M-y M-y M-y => equivalent to C-y M-y M-y
+;;
+;; But: After another command, C-u M-y remembers the temporary
+;; kill-ring position, so
+;; C-u M-y => yanks what the last M-y yanked
+;;
+
+(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."
+See `yank-pop' for details about the default behaviour. For an alternative
+behaviour, see `cua-paste-pop-rotate-temporarily'."
(interactive "P")
- (if (eq last-command 'cua--paste-rectangle)
- (progn
- (undo)
- (yank arg))
- (yank-pop (prefix-numeric-value arg))))
+ (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)))))
+ ;; Undo rotating the kill-ring, so next C-y will
+ ;; yank the original head.
+ (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.
(if (and s (= (cdr u) s))
(setq s (car u))
(setq s (car u) e (cdr u)))))))
- (setq cua--repeat-replace-text
- (cond ((and s e (<= s e) (= s (mark t)))
- (buffer-substring-no-properties s e))
- ((and (null s) (eq u elt)) ;; nothing inserted
- "")
- (t
- (message "Cannot locate replacement text")
- nil))))))
+ (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)) ;; nothing inserted
+ (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
;;; Shift activated / extended region
+(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.
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\).
+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'\).
+\(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.
+off the local (or global) mark ring.
With a double \\[universal-argument] prefix argument, unconditionally set mark."
(interactive "P")
(pop-global-mark))
(arg
(setq this-command 'pop-to-mark-command)
- (pop-to-mark-command))
- (mark-active
+ (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
;;; Pre-command hook
(defun cua--pre-command-handler-1 ()
- (let ((movement (eq (get this-command 'CUA) 'move)))
-
- ;; Cancel prefix key timeout if user enters another key.
- (when cua--prefix-override-timer
- (if (timerp cua--prefix-override-timer)
- (cancel-timer cua--prefix-override-timer))
- (setq cua--prefix-override-timer nil))
-
- ;; Handle shifted cursor keys and other movement commands.
- ;; If region is not active, region is activated if key is shifted.
- ;; If region is active, region is cancelled if key is unshifted (and region not started with C-SPC).
- ;; If rectangle is active, expand rectangle in specified direction and ignore the movement.
- (if movement
- (cond
- ((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)))
- ;; See if raw escape sequence maps to a shifted event, e.g. S-up or C-S-home.
- (and (boundp 'local-function-key-map)
- local-function-key-map
- (let ((ev (lookup-key local-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
- ;; If we set mark-active to nil here, the region highlight will not be
- ;; removed by the direct_output_ commands.
- (setq deactivate-mark t)))
-
- ;; Handle delete-selection property on other commands
- (if (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)))))
-
- ;; Detect extension of rectangles by mouse or other movement
- (setq cua--buffer-and-point-before-command
- (if cua--rectangle (cons (current-buffer) (point))))))
+ ;; Cancel prefix key timeout if user enters another key.
+ (when cua--prefix-override-timer
+ (if (timerp cua--prefix-override-timer)
+ (cancel-timer cua--prefix-override-timer))
+ (setq cua--prefix-override-timer nil))
+
+ (cond
+ ;; Only symbol commands can have necessary properties
+ ((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)))))
+
+ ;; Handle shifted cursor keys and other movement commands.
+ ;; If region is not active, region is activated if key is shifted.
+ ;; If region is active, region is cancelled if key is unshifted (and region not started with C-SPC).
+ ;; If rectangle is active, expand rectangle in specified direction and ignore the movement.
+ ((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)))
+ ;; See if raw escape sequence maps to a shifted event, e.g. S-up or C-S-home.
+ (and (boundp 'local-function-key-map)
+ local-function-key-map
+ (let ((ev (lookup-key local-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))
+
+ ;; Set mark if user explicitly said to do so
+ ((or cua--explicit-region-start cua--rectangle)
+ (unless mark-active
+ (push-mark-command nil nil)))
+
+ ;; Else clear mark after this command.
+ (t
+ ;; If we set mark-active to nil here, the region highlight will not be
+ ;; removed by the direct_output_ commands.
+ (setq deactivate-mark t)))
+
+ ;; Detect extension of rectangles by mouse or other movement
+ (setq cua--buffer-and-point-before-command
+ (if cua--rectangle (cons (current-buffer) (point)))))
(defun cua--pre-command-handler ()
(when cua-mode
cua-rectangle-modifier-key
'meta))
;; C-return always toggles rectangle mark
- (define-key cua-global-keymap [(control return)] 'cua-set-rectangle-mark)
+ (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
;; replace region with rectangle or element on kill ring
(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)
;; replace current yank with previous kill ring element
(define-key cua-global-keymap [remap yank-pop] 'cua-paste-pop)
;; set mark
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."
+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-modifier-key)
+ :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)
;;;###autoload (eval-after-load 'CUA-mode
;;;###autoload '(error (concat "\n\n"
-;;;###autoload "CUA-mode is now part of the standard GNU Emacs distribution,\n"
-;;;###autoload "so you may now enable and customize CUA via the Options menu.\n\n"
+;;;###autoload "CUA-mode is now part of the standard GNU Emacs distribution, so you may\n"
+;;;###autoload "now enable CUA via the Options menu or by customizing option `cua-mode'.\n\n"
;;;###autoload "You have loaded an older version of CUA-mode which does\n"
;;;###autoload "not work correctly with this version of GNU Emacs.\n\n"
;;;###autoload (if user-init-file (concat
HCoop / bpt / emacs.git / blobdiff