diff options
| author | Kim F. Storm <storm@cua.dk> | 2004-07-16 10:42:26 +0000 |
|---|---|---|
| committer | Kim F. Storm <storm@cua.dk> | 2004-07-16 10:42:26 +0000 |
| commit | ff99642792644ad61f3d1749a1b81f80d9a660b1 (patch) | |
| tree | 95d18f1be5603a389f0b41a29ede440e3a6a367d /lisp/emulation | |
| parent | a416e7ef563a0a40050b61615dcdb8ae43be641c (diff) | |
| download | emacs-ff99642792644ad61f3d1749a1b81f80d9a660b1.tar.gz | |
(cua--preserve-mark-commands): New defvar.
Init to beginning-of-buffer and end-of-buffer.
(cua--undo-push-mark): New defvar.
(cua--pre-command-handler): Set inhibit-mark-movement if mark is
already active and command is in cua--preserve-mark-commands.
Also fix check for shift modifier on non-window systems.
(cua--post-command-handler): Clear inhibit-mark-movement if set.
Diffstat (limited to 'lisp/emulation')
| -rw-r--r-- | lisp/emulation/cua-base.el | 21 |
1 files changed, 19 insertions, 2 deletions
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index 51b47b104d0..b39945c7712 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -974,6 +974,13 @@ Extra commands should be added to `cua-movement-commands'") (defvar cua-movement-commands nil "User may add additional movement commands to this list.") +(defvar cua--preserve-mark-commands + '(end-of-buffer beginning-of-buffer) + "List of movement commands that move the mark. +CUA will preserve the previous mark position if a mark is already +active before one of these commands is executed.") + +(defvar cua--undo-push-mark nil) ;;; Scrolling commands which does not signal errors at top/bottom ;;; of buffer at first key-press (instead moves to top/bottom @@ -1062,8 +1069,15 @@ If ARG is the atom `-', scroll upward by nearly full screen." ;; If rectangle is active, expand rectangle in specified direction and ignore the movement. (if movement (cond - ((memq 'shift (event-modifiers (aref (this-single-command-raw-keys) 0))) - (unless mark-active + ((memq 'shift (event-modifiers + (aref (if window-system + (this-single-command-raw-keys) + (this-single-command-keys)) 0))) + (if mark-active + (if (and (memq this-command cua--preserve-mark-commands) + (not inhibit-mark-movement)) + (setq cua--undo-push-mark t + inhibit-mark-movement t)) (push-mark-command nil t)) (setq cua--last-region-shifted t) (setq cua--explicit-region-start nil)) @@ -1110,6 +1124,9 @@ If ARG is the atom `-', scroll upward by nearly full screen." (defun cua--post-command-handler () (condition-case nil (progn + (when cua--undo-push-mark + (setq cua--undo-push-mark nil + inhibit-mark-movement nil)) (when cua--global-mark-active (cua--global-mark-post-command)) (when (fboundp 'cua--rectangle-post-command) |