(cua--pre-command-handler-1): Rewrite.

1 files changed, 73 insertions, 67 deletions

diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index e1e88ee4399..2fbd09600bd 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -1097,73 +1097,79 @@ If ARG is the atom `-', scroll upward by nearly full screen."
 ;;; Pre-command hook
 
 (defun cua--pre-command-handler-1 ()
-  (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))
-      (setq cua--prefix-override-timer nil))
-
-    ;; 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 movement
-	(cond
-	 ((if window-system
-	      (memq 'shift (event-modifiers
-			    (aref (this-single-command-raw-keys) 0)))
-	    (or
-	     (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)))))))
-	  (unless mark-active
-	    (push-mark-command nil t))
-	  (setq cua--last-region-shifted t)
-	  (setq cua--explicit-region-start nil))
-	 ((or cua--explicit-region-start cua--rectangle)
-	  (unless mark-active
-	    (push-mark-command nil nil)))
-	 (t
-	  ;; If we set mark-active to nil here, the region highlight will not be
-	  ;; removed by the direct_output_ commands.
-	  (setq deactivate-mark t)))
-
-      ;; Handle delete-selection property on other commands
-      (if (and mark-active (not deactivate-mark))
-	  (let* ((ds (or (get this-command 'delete-selection)
-			 (get this-command 'pending-delete)))
-		 (nc (cond
-		      ((not ds) nil)
-		      ((eq ds 'yank)
-		       'cua-paste)
-		      ((eq ds 'kill)
-		       (if cua--rectangle
-			   'cua-copy-rectangle
-			 'cua-copy-region))
-		      ((eq ds 'supersede)
-		       (if cua--rectangle
-			   'cua-delete-rectangle
-			 'cua-delete-region))
-		      (t
-		       (if cua--rectangle
-			   'cua-delete-rectangle ;; replace?
-			 'cua-replace-region)))))
-	    (if nc
-		(setq this-original-command this-command
-		      this-command nc)))))
-
-    ;; Detect extension of rectangles by mouse or other movement
-    (setq cua--buffer-and-point-before-command
-	  (if cua--rectangle (cons (current-buffer) (point))))))
+  ;; 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))
+    (setq cua--prefix-override-timer nil))
+
+  (cond
+   ;; Only symbol commands can have necessary properties
+   ((not (symbolp this-command))
+    nil)
+
+   ;; Handle delete-selection property on non-movement commands
+   ((not (eq (get this-command 'CUA) 'move))
+    (when (and mark-active (not deactivate-mark))
+      (let* ((ds (or (get this-command 'delete-selection)
+		     (get this-command 'pending-delete)))
+	     (nc (cond
+		  ((not ds) nil)
+		  ((eq ds 'yank)
+		   'cua-paste)
+		  ((eq ds 'kill)
+		   (if cua--rectangle
+		       'cua-copy-rectangle
+		     'cua-copy-region))
+		  ((eq ds 'supersede)
+		   (if cua--rectangle
+		       'cua-delete-rectangle
+		     'cua-delete-region))
+		  (t
+		   (if cua--rectangle
+		       'cua-delete-rectangle ;; replace?
+		     'cua-replace-region)))))
+	(if nc
+	    (setq this-original-command this-command
+		  this-command nc)))))
+
+   ;; 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 window-system
+	(memq 'shift (event-modifiers
+		      (aref (this-single-command-raw-keys) 0)))
+      (or
+       (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)))))))
+    (unless mark-active
+      (push-mark-command nil t))
+    (setq cua--last-region-shifted t)
+    (setq cua--explicit-region-start nil))
+
+   ;; Set mark if user explicitly said to do so
+   ((or cua--explicit-region-start cua--rectangle)
+    (unless mark-active
+      (push-mark-command nil nil)))
+
+   ;; Else clear mark after this command.
+   (t
+    ;; If we set mark-active to nil here, the region highlight will not be
+    ;; removed by the direct_output_ commands.
+    (setq deactivate-mark t)))
+
+  ;; Detect extension of rectangles by mouse or other movement
+  (setq cua--buffer-and-point-before-command
+	(if cua--rectangle (cons (current-buffer) (point)))))
 
 (defun cua--pre-command-handler ()
   (when cua-mode