;;; -*- Mode:COMMON-LISP; Package:X11; Base:10.; Fonts:(cptfont hl12B hl12bi) -*-

;;;                           RESTRICTED RIGHTS LEGEND

;;;Use, duplication, or disclosure by the Government is subject to
;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
;;;Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;                     TEXAS INSTRUMENTS INCORPORATED.
;;;                              P.O. BOX 2909
;;;                           AUSTIN, TEXAS 78769
;;;                                 MS 2151
;;;
;;; Copyright (C) 1987, Texas Instruments Incorporated. All rights reserved.

;;; Change history:
;;;
;;;  Date       Author	Description
;;; -------------------------------------------------------------------------------------
;;; 03/08/89	WJB	Patch 1.33: Prevent error in Get-Selection-Owner - check for NIL window.
1;;; 12/23/88*	1LGO*	1Implement set-selection-owner, get-selection-owner, and Convert-Selection 
;;; 12/21/88*	1LGO*	1Make get-selection-owner return a bad-implementation error, until selections are implemented.
;;;  4/08/88*	1KDB*	1Added SELECTION-CLEAR SELECTION-NOTIFY  and SELECTION-REQUEST events.
;;; 12/15/87*	1TWE*	1Moved requests from the REQUESTS file.*

(defreq Set-Selection-Owner ((window (ONEOF WINDOW))
			     (selection-atom ATOM)
			     (time TIMESTAMP))
  (let ((timestamp (CLIENT-TIME-TO-SERVER-TIME time)))
    (when (eql window universal-none) (setq window nil))
    (if (MINUSP (COMPARE-TIME-STAMPS current-time timestamp))
	;1;; If the client's time stamp is in the future relative to the server's*
	;1;; time stamp, do not set the selection, just return success.*
	true
      ;1;; FIrst see if the selection is already set*
      (let ((selection (find selection-atom *current-selections* :key #'selection.atom)))
	(if selection
	    ;1; If the timestamp in client's request is in the past relative to the time stamp*
	    ;1; indicating the last time the owner of the selection was set, do not set the*
	    ;1; selection, just return success.*
	    (cond ((minusp (compare-time-stamps timestamp (selection.last-time-changed selection)))
		   true)
		  ((and (selection.window selection)
			(not (eq (selection.client selection) state)))
		   (let ((event (make-event-selection-clear
				  :type selection-clear-event
				  :time (time-stamp.milliseconds timestamp)
				  :window (selection.window selection)
				  :atom selection-atom)))
		     (try-client-events (selection.client selection) event
					1 no-event-mask no-event-mask ;1 can't be filtered*
					nil))))
	  ;1; Else selection doesn't exist, so add it*
	  (push (setq selection (make-selection :atom selection-atom)) *current-selections*))
	;1; Setup the new selection*
	(setf (selection.last-time-changed selection) timestamp
	      (selection.window selection) window
	      (selection.client selection) state)))))

(defreq Get-Selection-Owner ((selection-atom ATOM))
  (let* ((selection (find selection-atom *current-selections* :key #'selection.atom))
	 (window (and selection (selection.window selection)))
	 (owner (and window (window.id window))))
    (format-reply (state)
      :long (or owner universal-none))))

(defreq Convert-Selection ((window WINDOW)
			   (selection-atom ATOM)
			   (target ATOM)
			   (property (ONEOF ATOM))
			   (time CARD32))
  (let ((selection (find selection-atom *current-selections* :key #'selection.atom)))
    (if (and selection (selection.window selection))
	;1; Selection has an owner, send a selection-request event to the selection's client*
	(let ((event (make-event-selection-request
		       :type selection-request-event
		       :time time
		       :owner (selection.window selection)
		       :requestor window
		       :selection selection-atom
		       :target target
		       :property property)))
	  (try-client-events (selection.client selection) event
			     1 no-event-mask no-event-mask	;1 can't be filtered*
			     nil))
      ;1; Selection doesn't have an owner, send a selection-notify event with property none*
      (let ((event (make-event-selection-notify
		     :type selection-notify-event
		     :time time
		     :requestor window
		     :selection selection-atom
		     :target target
		     :property universal-none)))
	(try-client-events state event
			   1 no-event-mask no-event-mask	;1 can't be filtered*
			   nil)))))