diff options
author | Karoly Lorentey <lorentey@elte.hu> | 2006-10-14 17:36:28 +0000 |
---|---|---|
committer | Karoly Lorentey <lorentey@elte.hu> | 2006-10-14 17:36:28 +0000 |
commit | 12b6af5c7ed2cfdb9783312bf890cf1e6c80c67a (patch) | |
tree | 1775f9fd1c92defd8b61304a08ec00da95bc4539 /lisp/emulation/cua-base.el | |
parent | 3f87f67ee215ffeecbd2f53bd7f342cdf03f47df (diff) | |
parent | f763da8d0808af7c80d72bc586bf4fcf50b37ddd (diff) | |
download | emacs-12b6af5c7ed2cfdb9783312bf890cf1e6c80c67a.tar.gz emacs-12b6af5c7ed2cfdb9783312bf890cf1e6c80c67a.tar.bz2 emacs-12b6af5c7ed2cfdb9783312bf890cf1e6c80c67a.zip |
Merged from emacs@sv.gnu.org
Patches applied:
* emacs@sv.gnu.org/emacs--devo--0--patch-413
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-414
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-415
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-416
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-417
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-418
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-419
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-420
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-421
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-422
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-423
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-424
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-425
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-426
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-427
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-428
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-429
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-430
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-431
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-432
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-433
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-434
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-435
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-436
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-437
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-438
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-439
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-440
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-441
lisp/url/url-methods.el: Fix format error when http_proxy is empty string
* emacs@sv.gnu.org/emacs--devo--0--patch-442
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-443
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-444
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-445
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-446
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-447
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-448
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-449
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-450
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-451
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-452
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-453
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-454
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-455
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-456
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-457
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-458
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-459
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-460
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-461
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-462
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-463
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-464
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-465
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-466
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-467
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-468
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-469
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-470
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-471
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-472
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-473
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-128
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-129
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-130
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-131
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-132
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-133
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-134
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-135
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-136
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-137
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-138
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-139
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-140
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-141
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-142
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-143
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-144
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-145
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-146
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-147
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-148
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-149
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-582
Diffstat (limited to 'lisp/emulation/cua-base.el')
-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 b16ae17eda0..236e3e2c9ad 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 'local-function-key-map) - local-function-key-map - (let ((ev (lookup-key local-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 'local-function-key-map) + local-function-key-map + (let ((ev (lookup-key local-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 |