aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/emulation
diff options
context:
space:
mode:
authorMiles Bader2006-09-06 07:30:39 +0000
committerMiles Bader2006-09-06 07:30:39 +0000
commitfae22cbf7f66b7adc732e46a27b821114c812fdd (patch)
treea1c7545e4579d1da9d7d00d98287b1bff4dd0c26 /lisp/emulation
parentaf6ea8ad8d62810d901561ae4a56d89f22ebacf0 (diff)
parent04e28558df772845d83d5e870300b755b2528b57 (diff)
downloademacs-fae22cbf7f66b7adc732e46a27b821114c812fdd.tar.gz
emacs-fae22cbf7f66b7adc732e46a27b821114c812fdd.zip
Merge from emacs--devo--0
Patches applied: * emacs--devo--0 (patch 423-426) - Update from CVS - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 131-133) - Update from CVS Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-109
Diffstat (limited to 'lisp/emulation')
-rw-r--r--lisp/emulation/cua-base.el140
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."
1097;;; Pre-command hook 1097;;; Pre-command hook
1098 1098
1099(defun cua--pre-command-handler-1 () 1099(defun cua--pre-command-handler-1 ()
1100 (let ((movement (eq (get this-command 'CUA) 'move))) 1100 ;; Cancel prefix key timeout if user enters another key.
1101 1101 (when cua--prefix-override-timer
1102 ;; Cancel prefix key timeout if user enters another key. 1102 (if (timerp cua--prefix-override-timer)
1103 (when cua--prefix-override-timer 1103 (cancel-timer cua--prefix-override-timer))
1104 (if (timerp cua--prefix-override-timer) 1104 (setq cua--prefix-override-timer nil))
1105 (cancel-timer cua--prefix-override-timer)) 1105
1106 (setq cua--prefix-override-timer nil)) 1106 (cond
1107 1107 ;; Only symbol commands can have necessary properties
1108 ;; Handle shifted cursor keys and other movement commands. 1108 ((not (symbolp this-command))
1109 ;; If region is not active, region is activated if key is shifted. 1109 nil)
1110 ;; If region is active, region is cancelled if key is unshifted (and region not started with C-SPC). 1110
1111 ;; If rectangle is active, expand rectangle in specified direction and ignore the movement. 1111 ;; Handle delete-selection property on non-movement commands
1112 (if movement 1112 ((not (eq (get this-command 'CUA) 'move))
1113 (cond 1113 (when (and mark-active (not deactivate-mark))
1114 ((if window-system 1114 (let* ((ds (or (get this-command 'delete-selection)
1115 (memq 'shift (event-modifiers 1115 (get this-command 'pending-delete)))
1116 (aref (this-single-command-raw-keys) 0))) 1116 (nc (cond
1117 (or 1117 ((not ds) nil)
1118 (memq 'shift (event-modifiers 1118 ((eq ds 'yank)
1119 (aref (this-single-command-keys) 0))) 1119 'cua-paste)
1120 ;; See if raw escape sequence maps to a shifted event, e.g. S-up or C-S-home. 1120 ((eq ds 'kill)
1121 (and (boundp 'function-key-map) 1121 (if cua--rectangle
1122 function-key-map 1122 'cua-copy-rectangle
1123 (let ((ev (lookup-key function-key-map 1123 'cua-copy-region))
1124 (this-single-command-raw-keys)))) 1124 ((eq ds 'supersede)
1125 (and (vector ev) 1125 (if cua--rectangle
1126 (symbolp (setq ev (aref ev 0))) 1126 'cua-delete-rectangle
1127 (string-match "S-" (symbol-name ev))))))) 1127 'cua-delete-region))
1128 (unless mark-active 1128 (t
1129 (push-mark-command nil t)) 1129 (if cua--rectangle
1130 (setq cua--last-region-shifted t) 1130 'cua-delete-rectangle ;; replace?
1131 (setq cua--explicit-region-start nil)) 1131 'cua-replace-region)))))
1132 ((or cua--explicit-region-start cua--rectangle) 1132 (if nc
1133 (unless mark-active 1133 (setq this-original-command this-command
1134 (push-mark-command nil nil))) 1134 this-command nc)))))
1135 (t 1135
1136 ;; If we set mark-active to nil here, the region highlight will not be 1136 ;; Handle shifted cursor keys and other movement commands.
1137 ;; removed by the direct_output_ commands. 1137 ;; If region is not active, region is activated if key is shifted.
1138 (setq deactivate-mark t))) 1138 ;; If region is active, region is cancelled if key is unshifted (and region not started with C-SPC).
1139 1139 ;; If rectangle is active, expand rectangle in specified direction and ignore the movement.
1140 ;; Handle delete-selection property on other commands 1140 ((if window-system
1141 (if (and mark-active (not deactivate-mark)) 1141 (memq 'shift (event-modifiers
1142 (let* ((ds (or (get this-command 'delete-selection) 1142 (aref (this-single-command-raw-keys) 0)))
1143 (get this-command 'pending-delete))) 1143 (or
1144 (nc (cond 1144 (memq 'shift (event-modifiers
1145 ((not ds) nil) 1145 (aref (this-single-command-keys) 0)))
1146 ((eq ds 'yank) 1146 ;; See if raw escape sequence maps to a shifted event, e.g. S-up or C-S-home.
1147 'cua-paste) 1147 (and (boundp 'function-key-map)
1148 ((eq ds 'kill) 1148 function-key-map
1149 (if cua--rectangle 1149 (let ((ev (lookup-key function-key-map
1150 'cua-copy-rectangle 1150 (this-single-command-raw-keys))))
1151 'cua-copy-region)) 1151 (and (vector ev)
1152 ((eq ds 'supersede) 1152 (symbolp (setq ev (aref ev 0)))
1153 (if cua--rectangle 1153 (string-match "S-" (symbol-name ev)))))))
1154 'cua-delete-rectangle 1154 (unless mark-active
1155 'cua-delete-region)) 1155 (push-mark-command nil t))
1156 (t 1156 (setq cua--last-region-shifted t)
1157 (if cua--rectangle 1157 (setq cua--explicit-region-start nil))
1158 'cua-delete-rectangle ;; replace? 1158
1159 'cua-replace-region))))) 1159 ;; Set mark if user explicitly said to do so
1160 (if nc 1160 ((or cua--explicit-region-start cua--rectangle)
1161 (setq this-original-command this-command 1161 (unless mark-active
1162 this-command nc))))) 1162 (push-mark-command nil nil)))
1163 1163
1164 ;; Detect extension of rectangles by mouse or other movement 1164 ;; Else clear mark after this command.
1165 (setq cua--buffer-and-point-before-command 1165 (t
1166 (if cua--rectangle (cons (current-buffer) (point)))))) 1166 ;; If we set mark-active to nil here, the region highlight will not be
1167 ;; removed by the direct_output_ commands.
1168 (setq deactivate-mark t)))
1169
1170 ;; Detect extension of rectangles by mouse or other movement
1171 (setq cua--buffer-and-point-before-command
1172 (if cua--rectangle (cons (current-buffer) (point)))))
1167 1173
1168(defun cua--pre-command-handler () 1174(defun cua--pre-command-handler ()
1169 (when cua-mode 1175 (when cua-mode