;;; cua-base.el --- emulate CUA key bindings
-;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Keywords: keyboard emulation convenience cua
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; 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
+;; - press the prefix key and the following key within 0.2 seconds, or
;; - use the SHIFT key with the prefix key, i.e. C-X or C-C
;;
;; This behaviour can be customized via the
;; left edge of a rectangle start in the middle of a TAB character.
;; Sounds strange? Try it!
;;
-;; To start a rectangle, use [S-return] and extend it using the normal
+;; To start a rectangle, use [C-return] and extend it using the normal
;; movement keys (up, down, left, right, home, end, C-home,
;; C-end). Once the rectangle has the desired size, you can cut or
;; copy it using C-x and C-c (or C-w and M-w), and you can
;; subsequently insert it - as a rectangle - using C-v (or C-y). So
;; the only new command you need to know to work with cua-mode
-;; rectangles is S-return!
+;; rectangles is C-return!
;;
;; Normally, when you paste a rectangle using C-v (C-y), each line of
;; the rectangle is inserted into the existing lines in the buffer.
;; entire rectangle overlay (but not the contents) in the given
;; direction.
;;
-;; [S-return] cancels the rectangle
+;; [C-return] cancels the rectangle
;; [C-space] activates the region bounded by the rectangle
;; If you type a normal (self-inserting) character when the rectangle is
;; bottom of the rectangle. So, for example, to comment out an entire
;; paragraph like this one, just place the cursor on the first character
;; of the first line, and enter the following:
-;; S-return M-} ; ; <space> S-return
+;; C-return M-} ; ; <space> C-return
;; cua-mode's rectangle support also includes all the normal rectangle
;; functions with easy access:
(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
+`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)
"*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
+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
+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)
:group 'cua)
(defcustom cua-use-hyper-key nil
- "*If non-nil, bind rectangle commands to H-? instead of M-?.
-If set to 'also, toggle region command is also on S-return.
+ "*If non-nil, bind rectangle commands to H-... instead of M-....
+If set to `also', toggle region command is also on C-return.
Must be set prior to enabling CUA."
- :type '(choice (const :tag "Meta key and S-return" nil)
+ :type '(choice (const :tag "Meta key and C-return" nil)
(const :tag "Hyper key only" only)
- (const :tag "Hyper key and S-return" also))
+ (const :tag "Hyper key and C-return" also))
:group 'cua)
(defcustom cua-enable-region-auto-help nil
(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
+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)
"*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."
+M-p toggles this feature when a rectangle is active."
:type 'boolean
:group 'cua)
"*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
+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 'boolean
:group 'cua)
-(defface cua-rectangle-face
+(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-face
+(defface cua-rectangle-noselect
'((default :inherit region)
(((class color)) :foreground "white" :background "dimgray"))
"*Font used by CUA for highlighting the non-selected rectangle lines."
:type 'boolean
:group 'cua)
-(defface cua-global-mark-face
+(defface cua-global-mark
'((((min-colors 88)(class color)) :foreground "black" :background "yellow1")
(((class color)) :foreground "black" :background "yellow")
(t :bold t))
(choice :tag "Type"
(const :tag "Filled box" box)
(const :tag "Vertical bar" bar)
- (const :tag "Horisontal bar" hbar)
+ (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 "Horisontal bar" hbar)
+ (const :tag "Horizontal bar" hbar)
(const :tag "Hollow box" hollow))
(color :tag "Color")))
:group 'cua)
(choice :tag "Type"
(const :tag "Filled box" box)
(const :tag "Vertical bar" bar)
- (const :tag "Horisontal bar" hbar)
+ (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 "Horisontal bar" hbar)
+ (const :tag "Horizontal bar" hbar)
(const :tag "Hollow box" hollow))
(color :tag "Color")))
:group 'cua)
(choice :tag "Type"
(const :tag "Filled box" box)
(const :tag "Vertical bar" bar)
- (const :tag "Horisontal bar" hbar)
+ (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 "Horisontal bar" hbar)
+ (const :tag "Horizontal bar" hbar)
(const :tag "Hollow box" hollow))
(color :tag "Color")))
:group 'cua)
(choice :tag "Type"
(const :tag "Filled box" box)
(const :tag "Vertical bar" bar)
- (const :tag "Horisontal bar" hbar)
+ (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 "Horisontal bar" hbar)
+ (const :tag "Horizontal bar" hbar)
(const :tag "Hollow box" hollow))
(color :tag "Color")))
:group 'cua)
;;; Low-level Interface
(defvar cua-inhibit-cua-keys nil
- "Buffer-local variable that may disable the cua keymappings.")
+ "Buffer-local variable that may disable the CUA keymappings.")
(make-variable-buffer-local 'cua-inhibit-cua-keys)
;;; Aux. variables
;; Current region was started using cua-set-mark.
(defvar cua--explicit-region-start nil)
+(make-variable-buffer-local 'cua--explicit-region-start)
;; Latest region was started using shifted movement command.
(defvar cua--last-region-shifted nil)
;; status string for mode line indications
(defvar cua--status-string nil)
+(make-variable-buffer-local 'cua--status-string)
(defvar cua--debug nil)
(cons (current-buffer)
(and (consp buffer-undo-list)
(car buffer-undo-list))))
- (cua--deactivate)))
+ (cua--deactivate)
+ (/= start end)))
(defun cua-replace-region ()
"Replace the active region with the character you type."
(interactive)
- (cua-delete-region)
- (unless (eq this-original-command this-command)
- (cua--fallback)))
+ (let ((not-empty (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.
(let ((start (mark)) (end (point)))
(or (<= start end)
(setq start (prog1 end (setq end start))))
- (if cua--register
- (copy-to-register cua--register start end nil)
- (copy-region-as-kill start end))
+ (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))))
(let ((start (mark)) (end (point)))
(or (<= start end)
(setq start (prog1 end (setq end start))))
- (if cua--register
- (copy-to-register cua--register start end t)
- (kill-region start end)))
+ (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)))
;;; Generic commands for regions, rectangles, and global marks
(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))
(t (yank arg)))))))
(defun cua-paste-pop (arg)
(defun cua-repeat-replace-region (arg)
"Repeat replacing text of highlighted region with typed text.
-Searches for the next streach of text identical to the region last
-replaced by typing text over it and replaces it with the same streach
+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
;;; 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 '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
+ ;; 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))))))
+
(defun cua--pre-command-handler ()
- (condition-case nil
- (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 '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
- ;; 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))))
- )
- (error nil)))
+ (when cua-mode
+ (condition-case nil
+ (cua--pre-command-handler-1)
+ (error nil))))
;;; Post-command hook
-(defun cua--post-command-handler ()
- (condition-case nil
- (progn
- (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))
-
- ;; Debugging
- (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))))
-
- ;; Disable transient-mark-mode if rectangle active in current buffer.
- (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))
+(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))
+
+ ;; Debugging
+ (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))))
+
+ ;; Disable transient-mark-mode if rectangle active in current buffer.
+ (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)
- )
+ (cua--select-keymaps))
- (error nil)))
+(defun cua--post-command-handler ()
+ (when cua-mode
+ (condition-case nil
+ (cua--post-command-handler-1)
+ (error nil))))
;;; Keymaps
(defun cua--M/H-key (map key fct)
;; bind H-KEY or M-KEY to FCT in MAP
- (if (eq key 'space) (setq key ? ))
+ (if (eq key 'space) (setq key ?\s))
(unless (listp key) (setq key (list key)))
(define-key map (vector (cons (if cua-use-hyper-key 'hyper 'meta) key)) fct))
(defun cua--init-keymaps ()
(unless (eq cua-use-hyper-key 'only)
- (define-key cua-global-keymap [(shift return)] 'cua-set-rectangle-mark))
+ (define-key cua-global-keymap [(control return)] 'cua-set-rectangle-mark))
(when cua-use-hyper-key
(cua--M/H-key cua-global-keymap 'space 'cua-set-rectangle-mark)
(define-key cua-global-keymap [(hyper mouse-1)] 'cua-mouse-set-rectangle-mark))
- (define-key cua-global-keymap [(shift control ? )] 'cua-toggle-global-mark)
+ (define-key cua-global-keymap [(shift control ?\s)] 'cua-toggle-global-mark)
;; replace region with rectangle or element on kill ring
(define-key cua-global-keymap [remap yank] 'cua-paste)
(define-key cua--region-keymap [remap delete-char] 'cua-delete-region)
;; kill region
(define-key cua--region-keymap [remap kill-region] 'cua-cut-region)
+ (define-key cua--region-keymap [remap clipboard-kill-region] 'cua-cut-region)
;; copy 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)
;; cancel current region/rectangle
(define-key cua--region-keymap [remap keyboard-escape-quit] 'cua-cancel)
(define-key cua--region-keymap [remap keyboard-quit] 'cua-cancel)
;;;###autoload
(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. C-z, C-x, C-c, and C-v will undo, cut, copy, and
-paste (in addition to the normal emacs bindings)."
+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."
:global t
:group 'cua
:set-after '(cua-enable-modeline-indications cua-use-hyper-key)
:link '(emacs-commentary-link "cua-base.el")
(setq mark-even-if-inactive t)
(setq highlight-nonselected-windows nil)
- (make-variable-buffer-local 'cua--explicit-region-start)
- (make-variable-buffer-local 'cua--status-string)
(unless cua--keymaps-initalized
(cua--init-keymaps)
(if (not cua-mode)
(setq emulation-mode-map-alists (delq 'cua--keymap-alist emulation-mode-map-alists))
- (add-to-list 'emulation-mode-map-alists 'cua--keymap-alist)
+ (add-to-ordered-list 'emulation-mode-map-alists 'cua--keymap-alist 400)
(cua--select-keymaps))
(cond
(if (or (nth 1 cua--saved-state) (nth 2 cua--saved-state)) " enabled" "")))
(setq cua--saved-state nil))))
+
+;;;###autoload
+(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."
+ "Toggle CUA debugging."
(interactive)
(setq cua--debug (not cua--debug)))
;;;###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 "Your " (file-name-nondirectory user-init-file) " loads an older version of CUA-mode which does\n"
-;;;###autoload "not work correctly with this version of GNU Emacs.\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
;;;###autoload "To correct this, remove the loading and customization of the\n"
-;;;###autoload "old version from the " user-init-file " file.\n\n")))
+;;;###autoload "old version from the " user-init-file " file.\n\n")))))
(provide 'cua)