;;; cua-base.el --- emulate CUA key bindings
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Keywords: keyboard emulation convenience cua
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; - 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
+;; This behavior can be customized via the
;; cua-prefix-override-inhibit-delay variable.
;; In addition to using the shifted movement keys, you can also use
(other :tag "Enabled" t))
:group 'cua)
+(defcustom cua-remap-control-v t
+ "*If non-nil, C-v binding is used for paste (yank).
+Also, M-v is mapped to `cua-repeat-replace-region'."
+ :type 'boolean
+ :group 'cua)
+
+(defcustom cua-remap-control-z t
+ "*If non-nil, C-z binding is used for undo."
+ :type 'boolean
+ :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
"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)
+ (when (and (boundp 'cua--keymaps-initialized)
+ cua--keymaps-initialized)
(define-key cua-global-keymap value
'cua-set-rectangle-mark)
(when (boundp 'cua--rectangle-keymap)
;;; Rectangle support is in cua-rect.el
-(autoload 'cua-set-rectangle-mark "cua-rect" nil t nil)
+(autoload 'cua-set-rectangle-mark "cua-rect"
+ "Start rectangle at mouse click position." t nil)
;; Stub definitions until it is loaded
-
-(when (not (featurep 'cua-rect))
- (defvar cua--rectangle)
- (setq cua--rectangle nil)
- (defvar cua--last-killed-rectangle)
- (setq cua--last-killed-rectangle nil))
-
-
+(defvar cua--rectangle)
+(defvar cua--last-killed-rectangle)
+(unless (featurep 'cua-rect)
+ (setq cua--rectangle nil
+ 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"
+ (rect &optional below paste-column line-count))
+(declare-function cua--rectangle-corner "cua-rect" (&optional advance))
+(declare-function cua--rectangle-assert "cua-rect" ())
;;; Global Mark support is in cua-gmrk.el
(autoload 'cua-toggle-global-mark "cua-gmrk" nil t nil)
;; Stub definitions until cua-gmrk.el is loaded
-
-(when (not (featurep 'cua-gmrk))
- (defvar cua--global-mark-active)
+(defvar cua--global-mark-active)
+(unless (featurep 'cua-gmrk)
(setq cua--global-mark-active nil))
-
-(provide 'cua-base)
-
-(eval-when-compile
- (require 'cua-rect)
- (require 'cua-gmrk)
- )
+(declare-function cua--insert-at-global-mark "cua-gmrk" (str &optional msg))
+(declare-function cua--global-mark-post-command "cua-gmrk" ())
;;; Low-level Interface
(if (fboundp 'cua--cancel-rectangle)
(cua--cancel-rectangle)))
+(declare-function x-clipboard-yank "../term/x-win" ())
+
(defun cua-paste (arg)
"Paste last cut or copied region or rectangle.
An active region is deleted before executing the command.
(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"))
+ (error "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= (filter-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.
+ ;; 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
(regtxt
(cond
+ ;; This being a cons implies cua-rect is loaded?
((consp regtxt) (cua--insert-rectangle regtxt))
((stringp regtxt) (insert-for-yank regtxt))
(t (message "Unknown data in register %c" cua--register))))
(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)))
+ (filter-buffer-substring s e))
+ (set-text-properties 0 (length cua--repeat-replace-text)
+ nil cua--repeat-replace-text))
((and (null s) (eq u elt)) ;; nothing inserted
(setq cua--repeat-replace-text
""))
(end-of-buffer (goto-char (point-max)))))))
(put 'cua-scroll-up 'CUA 'move)
+(put 'cua-scroll-up 'isearch-scroll t)
(defun cua-scroll-down (&optional arg)
"Scroll text of current window downward ARG lines; or near full screen if no ARG.
(beginning-of-buffer (goto-char (point-min)))))))
(put 'cua-scroll-down 'CUA 'move)
+(put 'cua-scroll-down 'isearch-scroll t)
;;; Cursor indications
(set-cursor-color color))
(if (and type
(symbolp type)
- (not (eq type default-cursor-type)))
- (setq default-cursor-type type))))
+ (not (eq type (default-value 'cursor-type))))
+ (setq-default cursor-type type))))
;;; Pre-command hook
;; 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 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
+ ;; Shortcut for window-system, assuming that input-decode-map is empty.
(memq 'shift (event-modifiers
(aref (this-single-command-raw-keys) 0)))
(or
+ ;; Check if the final key-sequence was shifted.
(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)))))))
+ ;; If not, maybe the raw key-sequence was mapped by input-decode-map
+ ;; to a shifted key (and then mapped down to its unshifted form).
+ (let* ((keys (this-single-command-raw-keys))
+ (ev (lookup-key input-decode-map keys)))
+ (or (and (vector ev) (memq 'shift (event-modifiers (aref ev 0))))
+ ;; Or maybe, the raw key-sequence was not an escape sequence
+ ;; and was shifted (and then mapped down to its unshifted form).
+ (memq 'shift (event-modifiers (aref keys 0)))))))
(unless mark-active
(push-mark-command nil t))
(setq cua--last-region-shifted t)
(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)) ; Initalized when cua-gmrk.el is loaded
-(defvar cua--rectangle-keymap (make-sparse-keymap)) ; Initalized when cua-rect.el is loaded
+(defvar cua--global-mark-keymap (make-sparse-keymap)) ; Initialized when cua-gmrk.el is loaded
+(defvar cua--rectangle-keymap (make-sparse-keymap)) ; Initialized when cua-rect.el is loaded
(defvar cua--region-keymap (make-sparse-keymap))
(defvar cua--ena-cua-keys-keymap nil)
(and cua--global-mark-active
(not (window-minibuffer-p)))))
-(defvar cua--keymaps-initalized nil)
+(defvar cua--keymaps-initialized nil)
(defun cua--shift-control-prefix (prefix arg)
;; handle S-C-x and S-C-c by emulating the fast double prefix function.
;; scrolling
(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-global-keymap [remap scroll-up-command] 'cua-scroll-up)
+ (define-key cua-global-keymap [remap scroll-down-command] '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)
+ (when cua-remap-control-z
+ (define-key cua--cua-keys-keymap [(control z)] 'undo))
+ (when cua-remap-control-v
+ (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)
+ (dolist (key '(up down left right home end next prior))
+ (define-key cua--prefix-repeat-keymap (vector '(control x) key) 'cua--prefix-cut-handler)
+ (define-key cua--prefix-repeat-keymap (vector '(control c) key) 'cua--prefix-copy-handler))
;; Enable shifted fallbacks for C-x and C-c when region is active
(define-key cua--region-keymap [(shift control x)] 'cua--shift-control-x-prefix)
next-line previous-line
forward-word backward-word
end-of-line beginning-of-line
+ end-of-visual-line beginning-of-visual-line
move-end-of-line move-beginning-of-line
end-of-buffer beginning-of-buffer
scroll-up scroll-down
+ scroll-up-command scroll-down-command
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))
+ forward-paragraph backward-paragraph
+ ;; CC mode motion commands
+ c-forward-conditional c-backward-conditional
+ c-down-conditional c-up-conditional
+ c-down-conditional-with-else c-up-conditional-with-else
+ c-beginning-of-statement c-end-of-statement))
(put cmd 'CUA 'move))
;; State prior to enabling cua-mode
:global t
:group 'cua
:set-after '(cua-enable-modeline-indications
+ cua-remap-control-v cua-remap-control-z
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
+ (unless cua--keymaps-initialized
(cua--init-keymaps)
- (setq cua--keymaps-initalized t))
+ (setq cua--keymaps-initialized t))
(if cua-mode
(progn
(list
transient-mark-mode
(and (boundp 'delete-selection-mode) delete-selection-mode)
- (and (boundp 'pc-selection-mode) pc-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 (and (boundp 'pc-selection-mode) pc-selection-mode)
(pc-selection-mode -1))
(cua--deactivate)
+ (setq shift-select-mode nil)
(setq transient-mark-mode (and cua-mode
(if cua-highlight-region-shift-only
(not cua--explicit-region-start)
(delete-selection-mode 1))
(if (nth 2 cua--saved-state)
(pc-selection-mode 1))
- (if (interactive-p)
+ (setq shift-select-mode (nth 3 cua--saved-state))
+ (if (called-interactively-p 'interactive)
(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" "")
(interactive)
(setq cua--debug (not cua--debug)))
-(provide 'cua)
-;;; arch-tag: 21fb6289-ba25-4fee-bfdc-f9fb351acf05
+(provide 'cua-base)
+
+;; arch-tag: 21fb6289-ba25-4fee-bfdc-f9fb351acf05
;;; cua-base.el ends here