;;; radio-selector.stk - Widget containing set of radio buttons.
;;;                      Version 1
;;;
;;; Copyright (c) 1995 Harvey J. Stein (hjstein@math.huji.ac.il)
;;; This code is freely usable and distributable as long as this
;;; heading remains.
;;;
;;; Usage (example):
;;;   (make <radio-selector>
;;;	 :title "Font Type"
;;;	 :values '(small med large)
;;;	 :names '("Small" "Medium" "Large")
;;;	 :variable 'font-type-var
;;;	 :command (lambda () (restructure-fonts-to font-type-var))
;;;	 :vertical #t)
;;;

(require "Tk-classes")

(define-class <radio-selector> (<frame>)
  ((title :init-keyword :title
	  :accessor title-of)
   (values :init-keyword :values
	   :accessor values-of)
   (names  :init-keyword :names
	   :accessor names-of)
   (variable :init-keyword :variable
	     :accessor variable-of)
   (command :init-keyword :command
	    :accessor command-of
	    :initform '())
   (label-widget :accessor label-widget-of)
   (radio-buttons :accessor radio-buttons-of :initform ())
   (vertical :init-keyword :vertical :initform #f)))

(define-method initialize ((self <radio-selector>) initargs)
  (next-method)
  (set! (label-widget-of self)
	(make <label> :parent self
		:text (title-of self)))
  (let loop ((values (values-of self))
	    (names (names-of self)))
      (unless (or (null? values) (null? names))
	(set! (radio-buttons-of self)
	      (cons (make <radio-button>
			  :parent self
			  :value (car values)
			  :text (car names)
			  :command (command-of self)
			  :variable (variable-of self))
		    (radio-buttons-of self)))
	(loop (cdr values) (cdr names))))
  (set! (radio-buttons-of self)
	(reverse (radio-buttons-of self)))
  (internal-pack self))

(define-method internal-pack ((self <radio-selector>))
  (for-each (lambda (w) (catch (unpack w)))
	    (cons (label-widget-of self)
		  (radio-buttons-of self)))
  (let ((side (if (slot-ref self 'vertical) "top" "left")))
    (pack (label-widget-of self)
	  :side side
	  :fill "x"
	  :expand #t)
    (for-each (lambda (w)
		(pack w :side side :pady 3))
	      (radio-buttons-of self))))