comparison lisp/emulation/cua-base.el @ 90103:3ebd9bdb4fe5

Revision: [e-mail]--gnu-2005/emacs--unicode--0--patch-13 Merge from emacs--cvs-trunk--0 Patches applied: * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-83 - [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-89 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-90 Update from CVS: man/calc.texi: Add macro for LaTeX for info output. * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-91 - [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-94 Update from CVS

90102:9b4f359c4117

;;; cua-base.el --- emulate CUA key bindings

;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;;        Free Software Foundation, Inc.

;; Author: Kim F. Storm <[e-mail]>
;; Keywords: keyboard emulation convenience cua

  "Emulate CUA key bindings including C-x and C-c."
  :prefix "cua"
  :group 'editing-basics
  :group 'convenience
  :group 'emulations
  :version "21.4"
  :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.

  "*Font used by CUA for highlighting the rectangle."
  :group 'cua)

(defface cua-rectangle-noselect-face 'nil
  "*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

		 ctrl-u-prefix)
		(t t)))
	     (+ 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

(defvar cua--last-deleted-region-pos nil)
(defvar cua--last-deleted-region-text nil)

    (setq cua--explicit-region-start t)
    (setq cua--last-region-shifted nil)
    (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).

(defun cua-scroll-up (&optional arg)

   (t
    (condition-case nil
	(scroll-up arg)
      (end-of-buffer (goto-char (point-max)))))))

(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.

    (scroll-down arg))  ; signal error
   (t
    (condition-case nil
	(scroll-down arg)
      (beginning-of-buffer (goto-char (point-min)))))))

;;; Cursor indications

(defun cua--update-indications ()
  (let* ((cursor

;;; Pre-command hook

(defun cua--pre-command-handler ()
  (condition-case nil
      (let ((movement (or (memq this-command cua--standard-movement-commands)
			  (memq this-command cua-movement-commands))))

	;; 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))

  (define-key cua-global-keymap [remap 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
  (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-global-keymap [remap scroll-down]	'cua-scroll-down)

  ;; 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)
  )

;; State prior to enabling cua-mode
;; Value is a list with the following elements:
;;   transient-mark-mode
;;   delete-selection-mode
;;   pc-selection-mode

  (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)
    (cua--select-keymaps))

  (if (fboundp 'cua--rectangle-on-off)
      (cua--rectangle-on-off cua-mode))

  (cond
   (cua-mode
    (setq cua--saved-state
	  (list

  "Toggle cua debugging."
  (interactive)
  (setq cua--debug (not cua--debug)))

;; Install run-time check for older versions of CUA-mode which does not
;; work with GNU Emacs version 21.4 and newer.
;;
;; Except for version 1.2, all of the 1.x and 2.x version of cua-mode
;; provided the `CUA-mode' feature.  Since this is no longer true,
;; we can warn the user if the `CUA-mode' feature is ever provided.

90103:3ebd9bdb4fe5

;;; cua-base.el --- emulate CUA key bindings

;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
;;        Free Software Foundation, Inc.

;; Author: Kim F. Storm <[e-mail]>
;; Keywords: keyboard emulation convenience cua

  "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.

  "*Font used by CUA for highlighting the rectangle."
  :group 'cua)

(defface cua-rectangle-noselect-face 'nil
  "*Font used by CUA for highlighting the non-selected rectangle lines."
  :group 'cua)


;;; Global Mark Customization

		 ctrl-u-prefix)
		(t t)))
	     (+ arg ?0)))
  (if cua--register nil arg))


;;; Region specific commands

(defvar cua--last-deleted-region-pos nil)
(defvar cua--last-deleted-region-text nil)

    (setq cua--explicit-region-start t)
    (setq cua--last-region-shifted nil)
    (if cua-enable-region-auto-help
	(cua-help-for-region t)))))

;;; Scrolling commands which does not signal errors at top/bottom
;;; of buffer at first key-press (instead moves to top/bottom
;;; of buffer).

(defun cua-scroll-up (&optional 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.

    (scroll-down arg))  ; signal error
   (t
    (condition-case nil
	(scroll-down arg)
      (beginning-of-buffer (goto-char (point-min)))))))

(put 'cua-scroll-up 'CUA 'move)

;;; Cursor indications

(defun cua--update-indications ()
  (let* ((cursor

;;; Pre-command hook

(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))

  (define-key cua-global-keymap [remap 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
  (define-key cua-global-keymap [remap set-mark-command]	'cua-set-mark)

  ;; scrolling
  (define-key cua-global-keymap [remap scroll-up]	'cua-scroll-up)
  (define-key cua-global-keymap [remap scroll-down]	'cua-scroll-down)

  ;; 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)
  )


;; 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
;;   delete-selection-mode
;;   pc-selection-mode

  (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)
    (cua--select-keymaps))

  (cond
   (cua-mode
    (setq cua--saved-state
	  (list

  "Toggle cua debugging."
  (interactive)
  (setq cua--debug (not cua--debug)))

;; Install run-time check for older versions of CUA-mode which does not
;; work with GNU Emacs version 22.1 and newer.
;;
;; Except for version 1.2, all of the 1.x and 2.x version of cua-mode
;; provided the `CUA-mode' feature.  Since this is no longer true,
;; we can warn the user if the `CUA-mode' feature is ever provided.