;;;;
;;;; Buttons, Check button and radio buttons bindings and procs
;;;;
;;;; Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; 
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
;;;; that both the above copyright notice and this permission notice appear in
;;;; all copies and derived works.  Fees for distribution or use of this
;;;; software or derived works may only be charged with express written
;;;; permission of the copyright holder.  
;;;; This software is provided ``as is'' without express or implied warranty.
;;;;
;;;; This software is a derivative work of other copyrighted softwares; the
;;;; copyright notices of these softwares are placed in the file COPYRIGHTS
;;;;
;;;;
;;;;           Author: Erick Gallesio [eg@unice.fr]
;;;;    Creation date: 17-May-1993 12:35
;;;; Last file update: 22-Nov-1993 16:00
;;;;


;; Class bindings for various flavors of button widgets. tk::window
;; keeps track of the button containing the mouse, and tk::relief
;; saves the original relief of the button so it can be restored when
;; the mouse button is released.


(let ((Button-bindings '(("<Any-Enter>"		. (tk-butEnter |%W|))
			 ("<Any-Leave>"		. (tk-butLeave |%W|))
			 ("<1>"			. (tk-butDown |%W|))
			 ("<ButtonRelease-1>" 	. (tk-butUp |%W|)))))

  (do-bindings "Button"      Button-bindings)
  (do-bindings "Checkbutton" Button-bindings)
  (do-bindings "Radiobutton" Button-bindings))

;; The procedure below is invoked when the mouse pointer enters a
;; button widget.  It records the button we're in and changes the
;; state of the button to active unless the button is disabled.

(define (tk-butEnter w)
  (unless (equal? (tk-get w :state) "disabled")
     (unless tk-strictMotif (tk-set! w :state "active"))
     (set! tk::window w)))


;; The procedure below is invoked when the mouse pointer leaves a
;; button widget. It changes the state of the button back to
;; inactive.

(define (tk-butLeave w)
  (unless (equal? (tk-get w :state) "disabled")
     (unless tk-strictMotif (tk-set! w :state "normal"))
     (set! tk::window "")))

;; The procedure below is invoked when the mouse button is pressed in
;; a button/radiobutton/checkbutton widget.  It records information
;; (a) to indicate that the mouse is in the button, and
;; (b) to save the button's relief so it can be restored later.

(define (tk-butDown w)
  (set! tk::buttonWindow w)
  (set! tk::relief 	 (tk-get w :relief))
  (unless (equal? (tk-get w :state) "disabled")
     (tk-set! w :relief "sunken")))

;; The procedure below is invoked when the mouse button is released
;; for a button/radiobutton/checkbutton widget.  It restores the
;; button's relief and invokes the command as long as the mouse
;; hasn't left the button.

(define (tk-butUp w)
  (when (equal? w tk::buttonWindow)
     (tk-set! w :relief tk::relief)
     (when (and (equal? w tk::window)
		(not (equal? (tk-get w :state) "disabled")))
       (w 'invoke))
     (set! tk::buttonWindow '())))