# HG changeset patch # User Kim F. Storm # Date 1121329650 0 # Node ID d1bb70278f2a862aa2d4e5aaca9a9a59c0abc119 # Parent 5ac4e912d629bead150d140f0ff8709342e20a83 (cua--pre-command-handler-1, cua--pre-command-handler) (cua--post-command-handler-1, cua--post-command-handler): Split in two. Check (buffer local) value of cua-mode. (cua-selection-mode): New command. diff -r 5ac4e912d629 -r d1bb70278f2a lisp/emulation/cua-base.el --- a/lisp/emulation/cua-base.el Thu Jul 14 08:25:30 2005 +0000 +++ b/lisp/emulation/cua-base.el Thu Jul 14 08:27:30 2005 +0000 @@ -1060,111 +1060,115 @@ ;;; Pre-command hook -(defun cua--pre-command-handler () - (condition-case nil - (let ((movement (eq (get this-command 'CUA) 'move))) +(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)) + ;; 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 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))))) + ;; 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)))) - ) - (error nil))) + ;; 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 + (condition-case nil + (cua--pre-command-handler-1) + (error nil)))) ;;; Post-command hook -(defun cua--post-command-handler () - (condition-case nil - (progn - (when cua--global-mark-active - (cua--global-mark-post-command)) - (when (fboundp 'cua--rectangle-post-command) - (cua--rectangle-post-command)) - (setq cua--buffer-and-point-before-command nil) - (if (or (not mark-active) deactivate-mark) - (setq cua--explicit-region-start nil)) +(defun cua--post-command-handler-1 () + (when cua--global-mark-active + (cua--global-mark-post-command)) + (when (fboundp 'cua--rectangle-post-command) + (cua--rectangle-post-command)) + (setq cua--buffer-and-point-before-command nil) + (if (or (not mark-active) deactivate-mark) + (setq cua--explicit-region-start nil)) + + ;; Debugging + (if cua--debug + (cond + (cua--rectangle (cua--rectangle-assert)) + (mark-active (message "Mark=%d Point=%d Expl=%s" + (mark t) (point) cua--explicit-region-start)))) - ;; Debugging - (if cua--debug - (cond - (cua--rectangle (cua--rectangle-assert)) - (mark-active (message "Mark=%d Point=%d Expl=%s" - (mark t) (point) cua--explicit-region-start)))) + ;; Disable transient-mark-mode if rectangle active in current buffer. + (if (not (window-minibuffer-p (selected-window))) + (setq transient-mark-mode (and (not cua--rectangle) + (if cua-highlight-region-shift-only + (not cua--explicit-region-start) + t)))) + (if cua-enable-cursor-indications + (cua--update-indications)) - ;; Disable transient-mark-mode if rectangle active in current buffer. - (if (not (window-minibuffer-p (selected-window))) - (setq transient-mark-mode (and (not cua--rectangle) - (if cua-highlight-region-shift-only - (not cua--explicit-region-start) - t)))) - (if cua-enable-cursor-indications - (cua--update-indications)) + (cua--select-keymaps)) - (cua--select-keymaps) - ) - - (error nil))) +(defun cua--post-command-handler () + (when cua-mode + (condition-case nil + (cua--post-command-handler-1) + (error nil)))) ;;; Keymaps @@ -1393,6 +1397,15 @@ (if (or (nth 1 cua--saved-state) (nth 2 cua--saved-state)) " enabled" ""))) (setq cua--saved-state nil)))) + +;;;###autoload +(defun cua-selection-mode (arg) + "Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings." + (interactive "P") + (setq-default cua-enable-cua-keys nil) + (cua-mode arg)) + + (defun cua-debug () "Toggle CUA debugging." (interactive)