# HG changeset patch # User Kim F. Storm # Date 1157489656 0 # Node ID 153255cb260ab2e4143cacc650be792bb6fb4a14 # Parent 9b91f2dde092614d72964c2052c95d7598a893ae (cua--pre-command-handler-1): Rewrite. diff -r 9b91f2dde092 -r 153255cb260a lisp/emulation/cua-base.el --- a/lisp/emulation/cua-base.el Tue Sep 05 20:54:05 2006 +0000 +++ b/lisp/emulation/cua-base.el Tue Sep 05 20:54:16 2006 +0000 @@ -1097,73 +1097,79 @@ ;;; 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)) + + (cond + ;; Only symbol commands can have necessary properties + ((not (symbolp this-command)) + nil) - ;; 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 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 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 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)) - ;; 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))))) + ;; Set mark if user explicitly said to do so + ((or cua--explicit-region-start cua--rectangle) + (unless mark-active + (push-mark-command nil nil))) - ;; Detect extension of rectangles by mouse or other movement - (setq cua--buffer-and-point-before-command - (if cua--rectangle (cons (current-buffer) (point)))))) + ;; 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