;;; Copyright (C) 1991 Christopher J. Love
;;;
;;; This file is for use with Epoch, a modified version of GNU Emacs.
;;; Requires Epoch 4.0 or later.
;;;
;;; This code is distributed in the hope that it will be useful,
;;; bute WITHOUT ANY WARRANTY. No author or distributor accepts
;;; responsibility to anyone for the consequences of using this code
;;; or for whether it serves any particular purpose or works at all,
;;; unless explicitly stated in a written agreement.
;;;
;;; Everyone is granted permission to copy, modify and redistribute
;;; this code, but only under the conditions described in the
;;; GNU Emacs General Public License, except the original author nor his
;;; agents are bound by the License in their use of this code.
;;; (These special rights for the author in no way restrict the rights of
;;;  others given in the License or this prologue)
;;; A copy of this license is supposed to have been given to you along
;;; with Epoch so you can know your rights and responsibilities. 
;;; It should be in a file named COPYING.  Among other things, the
;;; copyright notice and this notice must be preserved on all copies. 
;;;
;;; $Revision: 1.3 $
;;; $Source: /import/kaplan/stable/distrib/epoch-4.2/epoch-lisp/RCS/selection.el,v $
;;; $Date: 92/01/28 14:37:30 $
;;; $Author: love $
;;;
;;; selection.el - provide support for X11 selections through Epoch.
;;;
;;; Written by Christopher Love
;;; User-defined target support by Michael Sennet (sennet@vistatech.com)
;;;
(require 'event)
(require 'epoch-util)
(require 'mini-cl)
(provide 'selection)
(provide 'convert-selection)

;;
;; epoch::selection-alist - this alist store values for all selections owned
;; 			by epoch.  Selection data is deleted when epoch
;;			loses selection; application user in epoch is
;;			responsible for putting value in alist once
;;			ownership is claimed.
;;
(defvar epoch::selection-alist nil
  "*Alist of selection atoms and data for selections owned by epoch.")

;;
;; epoch::convert-selection-alist - alist storing list of user-defined
;;			targets and corresponding conversion functions
;;
(defvar epoch::convert-selection-alist nil
  "*An alist in which each pair consists of target atom and function
used to convert the selection.  The functions have no arguments and should
return a string or nil")

;;
;; Code for user-definable convertion targets
;;--------------------------------------------------------------------------
(defun add-selection-target (target function)
  "Add a TARGET atom and an associated conversion FUNCTION to the
epoch::convert-selection-alist"
  (setq epoch::convert-selection-alist
    (alist-delete target epoch::convert-selection-alist)
  )
  (setq epoch::convert-selection-alist
    (cons (list target function) epoch::convert-selection-alist)
  )
)

;;
;;--------------------------------------------------------------------------
(defun convert-to-target (target)
  "Calls a conversion function based on TARGET."
  (condition-case err
    (let (
	(func (cadr (assoc target epoch::convert-selection-alist)))
      )
      (if (functionp func)
	(unwind-protect
	  (funcall func)
	)
	nil
      )
    )
    ;; on errors, just return nil
    (error nil)
  )
)
;;
;;--------------------------------------------------------------------------
;; set up standard hook for dispatching conversions
(setq epoch::convert-selection-hook 'convert-to-target)

;;
;; Event handlers for selection events
;;--------------------------------------------------------------------------
;;
;; Selection notify - there is no formal event handler for this class of
;;		    event.  Typically, the wait-for-event primitive is used
;;		    and installs a special event-handler which calls a user-
;;		    specified function to handle the selection-notify.

;;
;; Selection clear - a selection owned by epoch has been claimed by another
;;		     X11 client.  Action is to remove atom and data from
;;		     Epoch's selection alist, and to delete drag-zone (if
;;		     currently being displayed.
;;
;;--------------------------------------------------------------------------
(defvar selection::functions nil
  "List of selection/selection-clear handler"
)

;;;
(defun install-selection (selection)
  (atomize selection)
  (if (null (assoc selection selection::functions))
    (push (cons selection nil) selection::functions)
  )
)
;;;
(defun remove-selection (selection)
  (atomize selection)
  (setq selection::functions (alist-delete selection selection::functions))
)
;;; --------------------------------------------------------------------------
;;; Unlike the event handlers, these will create the selection event if it
;;; doesn't exist, since unlike events there are not a limited number of
;;; them.
;;;
(defun push-selection (selection handler)
  (atomize selection)
  (let
    (
      (elist (assoc selection selection::functions))
    )
    (if (consp elist)
      (setcdr elist (cons handler (cdr elist)))
      (push (list selection handler) selection::functions)
    )
  )
)
;;;
(defun pop-selection (selection)
  (atomize selection)
  (let
    (
      (elist (assoc selection selection::functions))
    )
    (when (consp elist)
      (prog1
	(cadr elist)
	(setcdr elist (cddr elist))
      )
    )
  )
)
;;;
(defun ignore-selection (selection)
  (atomize selection)
  (push-selection selection t)	;install a non-function
)
;;;
(defun resume-selection (selection)
  (atomize selection)
  (let
    (
      (h (pop-selection selection))
    )
    (when (and h (functionp h))		;not an ignore! put it back
      (push-selection selection h)
    )
  )
)
;;; --------------------------------------------------------------------------
(defun selection::handler (type value scr)
  (let*
    (
      (selection::atom value)		              ;save it
      (selection::event-handler epoch::event-handler) ;save this too
      (callback (cadr (assoc selection::atom selection::functions)))
    )
    (if (functionp callback)
      ;; User handler exists; their responsibility to delete from alist
      (unwind-protect
	;; BODY
	(funcall callback type value scr)
	;; CLEAN-UP
	(when (null epoch::event-handler) ;something got hosed
	  (ignore-selection selection::atom)	;inhibit the handler
	  (setq epoch::event-handler selection::event-handler)
	)
      )
      ;; No handler, so delete it from alist
      (setq epoch::selection-alist (alist-delete value epoch::selection-alist))
    )
  )
)

;;
;; mouse-clear - remove
;;
(defun mouse-clear (type value screen)
  (setq epoch::selection-alist (alist-delete value epoch::selection-alist))
  (if (zonep drag-zone)
    (progn
      (delete-zone drag-zone)
      (redisplay-screen)
)))


;; Install event handler for selection clear event
;;--------------------------------------------------------------------------
(install-event 'selection-clear)
(push-event 'selection-clear 'selection::handler)