# HG changeset patch
# User Kim F. Storm <storm@cua.dk>
# Date 1089974546 0
# Node ID a7600d0e7fdc4dbe7b9091e1557c7fc05cc65d5d
# Parent  af62749c94973435d7a006084c242e150232946c
(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.

diff -r af62749c9497 -r a7600d0e7fdc lisp/emulation/cua-base.el
--- a/lisp/emulation/cua-base.el	Fri Jul 16 10:42:00 2004 +0000
+++ b/lisp/emulation/cua-base.el	Fri Jul 16 10:42:26 2004 +0000
@@ -974,6 +974,13 @@
 (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 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 @@
 (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)