
##------------------------------------------------------------------------
## PROCEDURE
##	radiobutton
##
## DESCRIPTION
##	Implements a radiobutton mega-widget
##
## ARGUMENTS
##	radiobutton <window pathname> <options>
##

image create bitmap RadiobuttonRamsanImageS -data {
#define kk_width 14
#define kk_height 14
static unsigned char kk_bits[] = {
   0x01, 0x20, 0x02, 0x10, 0x04, 0x08, 0x08, 0x04, 0x10, 0x02, 0x20, 0x01,
   0xc0, 0x00, 0xc0, 0x00, 0x20, 0x01, 0x10, 0x02, 0x08, 0x04, 0x04, 0x08,
   0x02, 0x10, 0x01, 0x20};}

image create bitmap RadiobuttonRamsanImage -data {
#define kk2_width 14
#define kk2_height 14
static unsigned char kk2_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00};
}

# bind ComboEntry <Double-1> { %W popup }
# bind ComboEntry <Escape>   { %W popup }
# bind ComboEntry <Tab>      { %W expand [%W get]; break }
# bind ComboEntry <Return>   { %W add [%W get] }

# bind ComboList <Escape>   { wm withdraw [winfo toplevel %W] }
# bind ComboList <1> { tkComboGet %W [%W get [%W nearest %y]] }
# bind ComboList <Return>   { tkComboGet %W [%W get active] }

# bind ComboTopLevel <1> { wm withdraw [winfo toplevel %W]}


# bind ComboBox <Destroy> { tkComboDestroy %W }

proc radiobuttonRamsan {w args} {
    frame $w -class Radiobutton
    
    upvar \#0 $w data
    
    array set data [list \
	    radiobuttoncmd	.$w.r \
	    radiobutton	         $w.r \
	    label                  $w.l
    ]
    
    set radiobutton [radiobutton $data(radiobutton) -image RadiobuttonRamsanImage \
	    -selectimage RadiobuttonRamsanImageS -indicatoron 0]
    
    rename $w .$w
    rename $radiobutton $data(radiobuttoncmd)
    label $w.l
    
    if {[string comp {} $args] && \
	    [catch {eval tkradiobuttonRamsan_configure $w $args} err]} {
	destroy $w
	unset data
	return -code error $err
    }
    
    
    pack $data(radiobutton) -side left
    pack $w.l -side right -fill x -expand 1
    
    ## Gotta watch what you put in this list
    bindtags $radiobutton [list $w $radiobutton RadiobuttonRamsan Radiobutton \
	    [winfo toplevel $w] all]
    
    proc $w args "eval tkRadiobuttonRamsanEval [list $w] \$args"
    proc $radiobutton args "eval tkRadiobuttonRamsanEval [list $w] \$args"
    
    return $w
}


proc tkRadiobuttonRamsanEval { w args } {
  upvar \#0 $w data

  switch -glob -- [lindex $args 0] {
    {} {
      return -code error "wrong \# args: should be \"$w option ?arg ...?\""
    }
    conf*	{ eval tkradiobuttonRamsan_configure $w [lrange $args 1 end] }
    default	{ eval $data(radiobuttoncmd) $args }
  }
}

proc tkRadiobuttonRamsanDestroy w {
    upvar \#0 $w data
    catch { rename $w {}; unset data }
}

proc tkradiobuttonRamsan_configure { w args } {
  upvar \#0 $w data

  set num [llength $args]
  if {$num==1} {
      if [catch {$data(radiobuttoncmd) config $args} err] {
	  return -code error $err
      }
  } elseif $num {
      set cargR ""
      set cargL ""
      for {set i 0} {$i<$num} {incr i} {
	  set arg [string tolower [lindex $args $i]]
	  set val [lindex $args [incr i]]
	  switch -glob -- $arg {
	      -text { lappend cargL $arg $val }
	      -width { lappend cargL $arg $val }
	      -height { lappend cargL $arg $val }
	      default	{ lappend cargR $arg $val }
	  }
      }
      if {[string comp {} $cargR] && \
	      [catch {eval $data(radiobuttoncmd) config $cargR} err]} {
	  return -code error $err
      }
      if {[string comp {} $cargL] && \
	      [catch {eval $data(label) config $cargL} err]} {
	  return -code error $err
      }
      return
  } else { return [$data(radiobuttoncmd) config] }
}
