Commit 53c11b7e authored by Kim F. Storm's avatar Kim F. Storm
Browse files

(cua--pre-command-handler-1): Rewrite.

parent 865e69c8
......@@ -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 '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)))))
;; 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 '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))
;; 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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment