summaryrefslogtreecommitdiff
path: root/lisp/emulation/cua-base.el
diff options
context:
space:
mode:
authorKaroly Lorentey <lorentey@elte.hu>2006-10-14 17:36:28 +0000
committerKaroly Lorentey <lorentey@elte.hu>2006-10-14 17:36:28 +0000
commit12b6af5c7ed2cfdb9783312bf890cf1e6c80c67a (patch)
tree1775f9fd1c92defd8b61304a08ec00da95bc4539 /lisp/emulation/cua-base.el
parent3f87f67ee215ffeecbd2f53bd7f342cdf03f47df (diff)
parentf763da8d0808af7c80d72bc586bf4fcf50b37ddd (diff)
downloademacs-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.el140
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