;;; s-region.el --- set region using shift key.

;;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.

;; Author: Morten Welinder (terra@diku.dk)
;; XEmacs rewrite: Tomasz Cholewo <tjchol01@mecca.spd.louisville.edu>
;;		   Hrvoje Niksic <hniksic@srce.hr>
;; Version: 0.94
;; Last modified: Mon Nov  3 04:15:09 1997

;; Keywords: terminals

;;; Synched up with: not synched with FSF
;;; Requires: XEmacs 20.3

;;; Commentary:

;; This code allows to set the region by holding down the shift key
;; and moving the cursor to the other end of the region.  The
;; functionality is similar to that provided by Motif and Windows, as
;; well as many DOS editors.  This ensures that the standard Emacs
;; method of selecting regions are also still available.

;; Currently, only movement commands that are interactive "p" or "P"
;; functions and are bound to single keystrokes may be adapted.

;; To use s-region, put the following to `~/.emacs':
;;
;;   (s-region-mode 1)


;;; User variables:

(defcustom s-region-key-list
 '(right left up down
	 (control left) (control right) (control up) (control down)
	 (meta left) (meta right) (meta up) (meta down)
	 next prior home end
	 (control next) (control prior) (control home) (control end))
 "*A list of movement keystrokes to be used for region marking with a
shift key.  Only single keystrokes (with modifiers) bound to interactive
\"p\" or \"P\" functions are allowed."
 :type '(repeat (sexp :tag "Key")))

(defcustom s-region-modeline-string " S-Region"
  "*String to display in the modeline when Pending Delete mode is active."
  :type 'string)


;;; Code:

(defvar s-region-mode nil
  "When non-nil, Shift Region mode is on.
Use the `s-region-mode' function to change this!")
(defvar s-region-old-bindings nil)
(defvar s-region-shift-in-effect nil)
(make-variable-buffer-local 's-region-shift-in-effect)

(defun s-region-add-shift (key)
  (cons 'shift (delq 'shift (aref (key-sequence-list-description key) 0))))

(defun s-region-mark ()
  "Start or continue marking a region."
  (unless s-region-shift-in-effect
    (push-mark nil t t))
  (setq s-region-shift-in-effect t))

(defun s-region-unmark-maybe ()
  "Start or continue marking a region."
  (and s-region-shift-in-effect
       (rassq this-command s-region-old-bindings)
       (zmacs-deactivate-region)))

(defvar s-region-zmacs-buffer nil)
(defun s-region-store-buffer ()
  (setq s-region-zmacs-buffer (current-buffer)))

(defun s-region-deactivate ()
  ;; Ha!  When zmacs-deactivate-region-hook is called, the buffer can
  ;; be changed.  And `zmacs-region-buffer' happily returns nil. :-(
  (or s-region-zmacs-buffer
      (setq s-region-zmacs-buffer (current-buffer)))
  (with-current-buffer s-region-zmacs-buffer
    (setq s-region-shift-in-effect nil)))

(defun s-region-bind (&optional keylist map)
  (or keylist
      (setq keylist s-region-key-list))
  (or map
      (setq map (current-global-map)))
  (setq s-region-shift-in-effect nil)
  (add-hook 'zmacs-activate-region-hook 's-region-store-buffer)
  (add-hook 'zmacs-deactivate-region-hook 's-region-deactivate)
  (add-hook 'pre-command-hook 's-region-unmark-maybe)
  ;; #### This is kludgy and needs more work -- use advice?
  (let ((p2 '(scroll-up scroll-down beginning-of-buffer end-of-buffer)))
    (mapc #'(lambda (key)
	      (let ((binding (key-binding key)))
		(when (and (symbolp binding)
			   (commandp binding))
		  (let ((fun (make-symbol (format "s-region-%s" binding))))
		    (push (cons key binding) s-region-old-bindings)
		    (fset fun
			  `(lambda (arg)
			     ,(format "%s\n\
ADDITIONALLY: This command has been modified by Shift Region mode,
so it marks the region."
				      (documentation binding))
			     (interactive ,(if (memq binding p2) "_P" "_p"))
			     (s-region-mark)
			     (,binding arg)
			     ;; next-line uses last-command to track eol
			     (setq this-command ',binding)))
		    (define-key map (s-region-add-shift key) fun)))))
	  keylist)))

(defun s-region-restore (&optional map)
  (or map
      (setq map (current-global-map)))
  (dolist (el s-region-old-bindings)
    ;; Silently assume that Sh-foo was unbound.
    (define-key map (s-region-add-shift (car el)) nil))
  (setq s-region-old-bindings nil)
  (remove-hook 'zmacs-deactivate-region-hook 's-region-deactivate)
  (remove-hook 'pre-command-hook 's-region-unmark-maybe))

;;;###autoload
(add-minor-mode 's-region-mode 's-region-modeline-string)

;;;###autoload
(defun s-region-mode (arg)
  "Toggle Shift Region minor mode.
With arg, turn Shift Region mode on iff arg is positive.
When Shift Region mode is enabled, pressing the shift modifier with
 the usual movement keys produces the effect similar to Motif, or
 Windows.
The affected keys are stored in `s-region-key-list'."
  (interactive "P")
  (setq s-region-mode
	(if (null arg) (not s-region-mode)
	  (> (prefix-numeric-value arg) 0)))
  (if s-region-mode
      (s-region-bind)
    (s-region-restore)))

(provide 's-region)

;;; s-region.el ends here.