diff options
| author | Miles Bader | 2006-09-06 07:30:39 +0000 |
|---|---|---|
| committer | Miles Bader | 2006-09-06 07:30:39 +0000 |
| commit | fae22cbf7f66b7adc732e46a27b821114c812fdd (patch) | |
| tree | a1c7545e4579d1da9d7d00d98287b1bff4dd0c26 /lisp/emulation | |
| parent | af6ea8ad8d62810d901561ae4a56d89f22ebacf0 (diff) | |
| parent | 04e28558df772845d83d5e870300b755b2528b57 (diff) | |
| download | emacs-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.el | 140 |
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 |