gui/implementation/RadioBox.tcl


@implementation RadioBox {
  - init {} {
      $super init
      $self hideBorder
      set imageOff [@imageCopy radioOff]
      set imageOn [@imageCopy radioOn]
      set callbacks(Selection) {}
    }
  - list {} {
      return $itemsList
    }
  - list: aList {
      foreach item $aList { $self add: $item }
    }
  - add: anItem {
      if [$self contains: $anItem] { return $self }
      lappend itemsList $anItem
      grid [label "$frame.l$anItem" -text $anItem -anchor e] \
        [label "$frame.i$anItem" -image $imageOff] -sticky ew
      bind "$frame.l$anItem" <ButtonPress-1> "$self selection: \"$anItem\""
      bind "$frame.i$anItem" <ButtonPress-1> "$self selection: \"$anItem\""
    }
  - remove: anItem {
      if {![$self contains: $anItem]} { return $self }
      itemsList remove: $anItem
      catch {destroy "$frame.i$anItem" "$frame.l$anItem"}
      if {"$selection" == "$anItem"} {
        set selection {}
        $self selection: [lindex $itemsList end]
      }
    }
  - contains: anItem {
      return [itemsList contains: $anItem]
    }

  - selection {} {
      return $selection
    }
  - selection: anItem {
      if {![$self contains: $anItem]} { return $self }
      if [string length $selection] {
        "$frame.i$selection" configure -image $imageOff
      }
      set selection $anItem
      "$frame.i$selection" configure -image $imageOn
      $self selectionChange
    }

  - indexOfSelection {} {
      return [lsearch $itemsList $selection]
    }
  - indexOfSelection: anIndex {
      $self selection: [lindex $itemsList $anIndex]
    }

  - onSelection: aCallback {
      set callbacks(Selection) $aCallback
    }
  - onSelection {} {
      return $callbacks(Selection)
    }
  - selectionChange {} {
      catch {eval $callbacks(Selection)}
    }

  - clear {} {
      foreach item [$self list] {
        $self remove: $item
      }
      set selection {}
    }
  - sort {} {
      foreach item $itemsList {
        grid forget $frame.l$item $frame.i$item
      }  
      itemsList sort
      foreach item $itemsList {
        grid $frame.l$item $frame.i$item -sticky ew
      }
    }

  - loadFromFile: aFile {
      if [catch {set f [open $aFile r]} err] {
        return -code error "$self loadFromFile: $aFile ($err)"
      }
      while {[eof $f] == 0} {
        gets $f line
        if [string length $line] { $self add: $line }
      }
      close $f
    }

  - dealloc {} {
      foreach item $itemsList {
        bind "$frame.l$item" <ButtonPress-1> ""
        bind "$frame.i$item" <ButtonPress-1> ""
        catch {destroy "$frame.l$item" "$frame.i$item" }
      }
      return [$super dealloc]
    }
}