;;; extraregional.el
;;; =====================================================
;;; Unlinks the selection of text with the mouse from the
;;; manipulation of the point, mark and region.
;;; =====================================================
;;;
;;; Copyright (C) 1995,1996 John Maraist  maraist@ira.uka.de
;;; Version 0.2, 23 May 1996, for Xemacs v.19.3.


;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 1, or (at your option)
;;; any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; A copy of the GNU General Public License can be obtained from the
;;; author of this program at the email address above; from the Free
;;; Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA;
;;; or from most emacs implementations from the main "Help" or "Info"
;;; screens.


;;; Installation:
;;; 
;;; It is probably best to load this package at startup:
;;;
;;;   (require 'extraregional)
;;;
;;; It is also possible to use autoloads:  for every function
;;; mentioned below that you wish to link to keys (none of this
;;; package is well-suited to M-x style use), add an autoload.  For
;;; example,
;;;
;;;   (autoload 'extraregional-mouse-select "extraregional" nil t)
;;;
;;; but this strategy is not recommended.


;;; Behavior:
;;;
;;; When extraregional-mode is active, pressing the meta button while
;;; clicking button1 will copy the selected text into the temporary
;;; selection area without moving the point; meta with button2 will
;;; insert the last text selection at the point, without first moving
;;; the point.  These bindings are changeable via the
;;; extraregional-mode-map.  A hook variable, extraregional-mode-hook,
;;; is available.
;;;
;;; This release is smaller than version 0.1.1; we found (1) that the
;;; broader selection of features was not really useful, and (2) that
;;; the larger setup was rather fragile.  Comments are welcome.


;;; Usage:
;;;
;;; This package can be run either as a global minor mode or as a
;;; set of global declarations; for the time being we recommend the
;;; former approach.  One can also make the mode buffer-local, but
;;; this seems silly, and so we will not make it so easy as to tell
;;; you how to do this.  All of the sample integration code will be
;;; geared towards the minor mode approach; for a global setup, use
;;; 
;;;   (global-set-key ...)
;;;
;;; rather than
;;;
;;;   (define-key extraregional-mode-map ...)
;;;
;;; Sample functions for customization are included at the end of this
;;; file.


;; LCD Archive Entry:
;; To be completed for version 1.0.
(provide 'extraregional)
(defconst buffer-mouse-selection-extent nil
  "Internal variable, extraregional package.")
(defconst extraregional-old-mouse-yank-at-point-value nil
  "Internal variable, extraregional package.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Definition of user options. ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar extraregional-selection-bkgnd-color
  "Yellow"
  "*The background color used to highlight extraregional selections.

The default is yellow.")

;;;;;;;;;;;;;;;;;;;;;;
;;; The minor mode ;;;
;;;;;;;;;;;;;;;;;;;;;;

(defvar extraregional-mode nil
  "Implies extraregional minor mode.")
(or (assq 'extraregional-mode minor-mode-alist)
    (setq minor-mode-alist
	  (cons '(extraregional-mode "")
		minor-mode-alist)))
(defun extraregional-mode (&optional arg)
  "Activates extraregional minor mode."
  (interactive)
  (setq extraregional-mode
	(if (null arg)
	    (not extraregional-mode)
	  (> (prefix-numeric-value arg) 0)))
  (if extraregional-mode
      (progn
	(if (boundp 'extraregional-mode-hook)
	    (run-hooks 'extraregional-mode-hook))
	(message "Extraregional mode activated."))
    (message "Extraregional mode deactivated.")))
(defconst extraregional-mode-map
  (let ((m (make-sparse-keymap)))
    (define-key m '(meta button1) 'extraregional-mouse-select)
    (define-key m '(meta button2) 'extraregional-mouse-yank-this-at-point)
    m)
  "Keymap for extraregional minor mode")
(or (assq 'extraregional-mode minor-mode-map-alist)
    (setq minor-mode-map-alist
	  (cons (cons 'extraregional-mode
		      extraregional-mode-map)
		minor-mode-map-alist)))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Text selection and mouse tracking. ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun extraregional-mouse-select (click)
  (interactive "e")
  (if (null click)
      (error "Where's the mouse?!?"))
  (let* ((old-frame  (selected-frame))
	 (old-window (selected-window))
	 (old-buffer (current-buffer))
	 (old-point  (point))
	 (click-window (event-window click))
	 (click-beginning)
	 (click-end))
    (if (null click-window)
	(mouse-track click)
      (progn (select-window click-window)
	     (set-mark nil)
	     (mouse-track click)
	     (if (mark)
		 (progn
		   (setq buffer-mouse-selection-extent
			 (make-extent click-beginning click-end))
		   (set-extent-property buffer-mouse-selection-extent 
					'face 'buffer-mouse-selection-face)
		   (add-hook 'zmacs-deactivate-region-hook
			     'extraregional-cancel-selection-hilite)
		   (add-hook 'zmacs-update-region-hook
			     'extraregional-cancel-selection-hilite)))
	     (select-frame  old-frame)
	     (select-window old-window)
	     (set-window-buffer old-window old-buffer)
	     (goto-char old-point)
	     (set-mark nil)))))
(defun extraregional-mouse-yank-this-at-point (click)
  (interactive "e")
  (setq extraregional-old-mouse-yank-at-point-value 
	mouse-yank-at-point)
  (setq mouse-yank-at-point t)
  (mouse-yank click)
  (setq mouse-yank-at-point
	extraregional-old-mouse-yank-at-point-value))
(defun extraregional-cancel-selection-hilite ()
  (interactive)
  (remove-hook 'zmacs-deactivate-region-hook
	       'extraregional-cancel-selection-hilite)
  (remove-hook 'zmacs-update-region-hook
	       'extraregional-cancel-selection-hilite)
  (if (extentp buffer-mouse-selection-extent)
      (delete-extent buffer-mouse-selection-extent)))
	     
;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Internal stuff ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;
(if (not (facep 'buffer-mouse-selection-face))
    (progn
      (make-face 'buffer-mouse-selection-face)
      (set-face-background 'buffer-mouse-selection-face
			   extraregional-selection-bkgnd-color)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Compatibility with earlier versions ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (not (fboundp 'select-frame))
    (fset 'select-frame (symbol-function 'select-screen)))
(if (not (fboundp 'selected-frame))
    (fset 'selected-frame (symbol-function 'selected-screen)))
(if (not (boundp 'mouse-yank-at-point))
    (set 'mouse-yank-at-point nil))
(if (not (fboundp 'mouse-yank))
    (fset 'mouse-yank (symbol-function 'x-insert-selection)))