;;;
;;;; B u t t o n . s t k 	  --  Label, Button, Check button and Radio button
;;;;				      class definitions
;;;;
;;;; 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.
;;;;
;;;;           Author: Erick Gallesio [eg@kaolin.unice.fr]
;;;;    Creation date: 30-Mar-1993 15:39
;;;; Last file update: 27-Mar-1995 15:17


(require "Basics")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; <Label> class
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-class <Label>(<Tk-simple-widget> <Tk-simple-text> <Tk-sizeable> <Tk-bitmap>)
  ())

(define-method tk-constructor ((self <Label>))
  Tk:label)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; <Button> class
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(define-class <Button> (<Label> <Tk-reactive>)
  ())

(define-method tk-constructor ((self <Button>))
  Tk:button)


;;;
;;; Buttons methods
;;;

(define-method flash ((self <Button>))
  ((slot-ref self 'Id) 'flash))

(define-method invoke ((self <Button>))
  ((slot-ref self 'Id) 'invoke))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; <Tk-complex-button>
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-class <Tk-complex-button> (<Button>)
     ((selector :accessor     selector 
		:init-keyword :selector 
		:allocation   :tk-virtual)
      (variable :accessor     variable 
		:init-keyword :variable 
		:allocation   :tk-virtual)))

;;;
;;; <Tk-complex-button> methods
;;; 

(define-method select ((self <Tk-complex-button>))
  ((slot-ref self 'Id) 'select))

(define-method deselect ((self <Tk-complex-button>))
  ((slot-ref self 'Id) 'deselect))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; <Check-button> class definition
;;;;
;;;; Define a fictive slot ``value''. This slots permits to initialize
;;;; the check button at creation time -- i.e you can do
;;;; 	(define c (make <Check-button> :text "Test" :value #t))
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(define-class <Check-button> (<Tk-complex-button>)
  ((on-value  :accessor     on-value 
	      :init-keyword :on-value 
	      :allocation   :tk-virtual
	      :tk-name	    onvalue)
   (off-value :accessor     off-value
	      :init-keyword :off-value
	      :allocation   :tk-virtual
	      :tk-name	    offvalue)
   ;; fictive slot 
   (value     :accessor	    value
	      :init-keyword :value
	      :allocation   :virtual
	      :slot-ref     (lambda (o)  
			      (eval-string (slot-ref o 'variable)))
	      :slot-set!    (lambda (o v) 
			      (eval `(set! ,(string->symbol 
					     (slot-ref o 'variable)) ,v))))))

(define-method tk-constructor ((self <Check-button>))
  Tk:checkbutton)

;;;
;;; <Check-button> methods
;;;

(define-method initialize ((self <Check-button>) args)
  (next-method)
  (let ((val (get-keyword :value  args #f)))
    ;; If a value is specified at init-time init, set it.
    (when val (slot-set! self 'value val))))

(define-method toggle ((self <Check-button>))
  ((slot-ref self 'Id) 'toggle))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; <Radio-button> class definition
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-class <Radio-button> (<Tk-complex-button>)
  ((value   :accessor value :init-keyword :value :allocation :tk-virtual)))


(define-method tk-constructor ((self <Radio-button>))
  Tk:radiobutton)

;;;
;;; <Radio-button> methods
;;;

(define-method initialize ((self <Radio-button>) args)
  (next-method)
  ;; A trick I like. If no value is specified set it to the text of the button
  (let ((opt (get-keyword :tk-options args '())))
    (unless (get-keyword :value opt #f)
	    (slot-set! self 'value (slot-ref self 'text)))))

(provide "Button")