- "Bind keys in KEYLIST to `s-region-move'.
-Each key in KEYLIST is bound to `s-region-move'
-provided it is already bound to some command or other.
-Optional second argument MAP specifies keymap to
-add binding to, defaulting to global keymap."
- (or map (setq map global-map))
- (while keylist
- (if (commandp (key-binding (car keylist)))
- (define-key
- map
- (vector (intern (concat "S-" (symbol-name (aref (car keylist) 0)))))
- 's-region-move))
- (setq keylist (cdr keylist))))
-
+ "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)))))
+
+;; Single keys (plus modifiers) only!