(defvar s-region-overlay (make-overlay 1 1))
(overlay-put s-region-overlay 'face 'region)
(overlay-put s-region-overlay 'priority 1000000)
(defun s-region-unshift (key)
"Remove shift modifier from last keypress KEY and return that as a key."
(if (vectorp key)
(let ((last (aref key (1- (length key)))))
(if (symbolp last)
(let* ((keyname (symbol-name last))
(pos (string-match "S-" keyname)))
(if pos
(vector (intern (concat (substring keyname 0 pos)
(substring keyname (+ 2 pos)))))
(error "Non-shifted key: %S" key)))
(error "Key does not end in a symbol: %S" key)))
(error "Non-vector key: %S" key)))
(defun s-region-move-p1 (&rest arg)
"This is an overlay function to point-moving keys that are interactive \"p\"."
(interactive "p")
(apply (function s-region-move) arg))
(defun s-region-move-p2 (&rest arg)
"This is an overlay function to point-moving keys that are interactive \"P\"."
(interactive "P")
(apply (function s-region-move) arg))
(defun s-region-move (&rest arg)
(if (if mark-active (not (equal last-command 's-region-move)) t)
(set-mark-command nil)
(message "")) (setq this-command 's-region-move)
(apply (key-binding (s-region-unshift (this-command-keys))) arg)
(move-overlay s-region-overlay (mark) (point) (current-buffer))
(sit-for 1)
(delete-overlay s-region-overlay))
(defun s-region-bind (keylist &optional map)
"Bind shifted keys in KEYLIST to `s-region-move-p1' or `s-region-move-p2'.
Each key in KEYLIST is shifted and bound to one of the `s-region-move'
functions provided it is already bound to some command or other.
Optional second argument MAP specifies keymap to add binding to, defaulting
to global keymap."
(let ((p2 (list 'scroll-up 'scroll-down
'beginning-of-buffer 'end-of-buffer)))
(or map (setq map global-map))
(while keylist
(let* ((key (car keylist))
(binding (key-binding key)))
(if (commandp binding)
(define-key
map
(vector (intern (concat "S-" (symbol-name (aref key 0)))))
(cond ((memq binding p2)
's-region-move-p2)
(t 's-region-move-p1)))))
(setq keylist (cdr keylist)))))
(s-region-bind
(list [right] [left] [up] [down]
[C-left] [C-right] [C-up] [C-down]
[M-left] [M-right] [M-up] [M-down]
[next] [previous] [home] [end]
[C-next] [C-previous] [C-home] [C-end]
[M-next] [M-previous] [M-home] [M-end]))
(or (global-key-binding [C-insert])
(global-set-key [C-insert] 'copy-region-as-kill))
(or (global-key-binding [S-delete])
(global-set-key [S-delete] 'kill-region))
(or (global-key-binding [S-insert])
(global-set-key [S-insert] 'yank))
(provide 's-region)