;;; cua-base.el --- emulate CUA key bindings
-;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
;; Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
"*Font used by CUA for highlighting the non-selected rectangle lines."
:group 'cua)
-(defcustom cua-undo-max 64
- "*Max no of undoable CUA rectangle changes (including undo)."
- :type 'integer
- :group 'cua)
-
;;; Global Mark Customization
(+ arg ?0)))
(if cua--register nil arg))
-;;; Enhanced undo - restore rectangle selections
-
-(defun cua-undo (&optional arg)
- "Undo some previous changes.
-Knows about CUA rectangle highlighting in addition to standard undo."
- (interactive "*P")
- (if (fboundp 'cua--rectangle-undo)
- (cua--rectangle-undo arg)
- (undo arg)))
;;; Region specific commands
(if cua-enable-region-auto-help
(cua-help-for-region t)))))
-(defvar cua--standard-movement-commands
- '(forward-char backward-char
- next-line previous-line
- forward-word backward-word
- end-of-line beginning-of-line
- end-of-buffer beginning-of-buffer
- scroll-up scroll-down cua-scroll-up cua-scroll-down
- forward-sentence backward-sentence
- forward-paragraph backward-paragraph)
- "List of standard movement commands.
-Extra commands should be added to `cua-movement-commands'")
-
-(defvar cua-movement-commands nil
- "User may add additional movement commands to this list.")
-
;;; Scrolling commands which does not signal errors at top/bottom
;;; of buffer at first key-press (instead moves to top/bottom
;;; of buffer).
(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.
(scroll-down arg)
(beginning-of-buffer (goto-char (point-min)))))))
+(put 'cua-scroll-up 'CUA 'move)
+
;;; Cursor indications
(defun cua--update-indications ()
(defun cua--pre-command-handler ()
(condition-case nil
- (let ((movement (or (memq this-command cua--standard-movement-commands)
- (memq this-command cua-movement-commands))))
+ (let ((movement (eq (get this-command 'CUA) 'move)))
;; Cancel prefix key timeout if user enters another key.
(when cua--prefix-override-timer
(define-key cua-global-keymap [remap yank-pop] 'cua-paste-pop)
;; set mark
(define-key cua-global-keymap [remap set-mark-command] 'cua-set-mark)
- ;; undo
- (define-key cua-global-keymap [remap undo] 'cua-undo)
- (define-key cua-global-keymap [remap advertised-undo] 'cua-undo)
;; scrolling
(define-key cua-global-keymap [remap scroll-up] 'cua-scroll-up)
(define-key cua--region-keymap [remap keyboard-quit] 'cua-cancel)
)
+
+;; Setup standard movement commands to be recognized by CUA.
+
+(dolist (cmd
+ '(forward-char backward-char
+ next-line previous-line
+ forward-word backward-word
+ end-of-line beginning-of-line
+ end-of-buffer beginning-of-buffer
+ scroll-up scroll-down
+ forward-sentence backward-sentence
+ forward-paragraph backward-paragraph))
+ (put cmd 'CUA 'move))
+
;; State prior to enabling cua-mode
;; Value is a list with the following elements:
;; transient-mark-mode
(add-to-list 'emulation-mode-map-alists 'cua--keymap-alist)
(cua--select-keymaps))
- (if (fboundp 'cua--rectangle-on-off)
- (cua--rectangle-on-off cua-mode))
-
(cond
(cua-mode
(setq cua--saved-state