#!/usr/local/bin/wish8.3

set elistbox_debug 0

#image create photo ichip -file ichip.gif

##############################################################################
#
# Parse an argument list
#
proc parseargs {argv nameset} {
  while { [llength $argv] > 0 } {

    set sw [lindex $argv 0]

    if { [lsearch -exact $nameset $sw] < 0 } {
      error "bad option \"$sw\" must be one of: $nameset"
      return
    }

    set vname [string range $sw 1 end]
    set val [lindex $argv 1]
    set argv [lrange $argv 2 end]

    upvar $vname local_$vname
    set  local_$vname $val
  }
}


namespace eval Elistbox {
  variable p_width
  variable p_height
  variable p_columns
  variable p_headers
  variable p_bd
  variable p_bg
  variable p_relief
  variable p_xscrollcommand
  variable p_yscrollcommand
  variable p_selectcolor
  variable p_entrycolor
  variable p_headercolor
  variable p_contents
  variable p_position
  variable p_selection

  proc init {w} {
    variable p_columns
    variable p_headers
    variable p_entrycolor
    variable p_selectcolor
    variable p_headercolor
    variable p_position
    variable p_contents
    variable p_selection

    configure $w -bd 2
    configure $w -width 10
    configure $w -height 10
    set p_columns($w) {}
    set p_headers($w) {}
    set p_headercolor($w) "\#fff0f0"
    set p_entrycolor($w) "\#f0f0ff"
    set p_selectcolor($w) "\#d0ffd0"
    set p_contents($w) {}
    set p_position($w) 0
    set p_selection($w) ""
  }

  #
  # Does this elistbox have column headers?
  #
  proc hasheaders {w} {
    variable p_headers
    if { [llength $p_headers($w)] == 0 } {
      return 0
    } else {
      return 1
    }
  }

  #
  # Set selection on row r of elistbox
  #
  proc selectrow {w r} {
    variable p_columns
    variable p_height
    variable p_width
    variable p_entrycolor
    variable p_selectcolor
    variable p_headercolor
    variable p_position
    variable p_contents
    variable p_position
    variable p_selection

    set clist $p_columns($w)
    set p_selection($w) [expr $r + $p_position($w) - [hasheaders $w]]

    if { [llength $clist] == 0 } {
      set clist [list $p_width($w)]
    }

    for {set l 1 } {$l < $p_height($w) } {incr l } {
      set c 0
      foreach cw $clist {
	if {$r == $l} {
	  $w.f.w${l}_$c configure -bg $p_selectcolor($w)
	} else {
	  $w.f.w${l}_$c configure -bg $p_entrycolor($w)
	}
	incr c
      }
    }
  }

  proc recolumn {w} {
    variable p_columns
    variable p_headers
    variable p_height
    variable p_width
    variable p_selectcolor
    variable p_entrycolor
    variable p_headercolor
    variable p_bd

    catch { destroy $w.f }
    frame $w.f
    $w create window [expr $p_bd($w)+1] [expr $p_bd($w)+1] -window $w.f -anchor nw

    set clist $p_columns($w)

    if { [llength $clist] == 0 } {
      set clist [list $p_width($w)]
    }

    for {set l 0 } {$l < $p_height($w) } {incr l } {
      set c 0
      foreach cw $clist {
	if { $l == 0 && [hasheaders $w]} {
	  label $w.f.w${l}_$c -bd 1 -relief raised -width $cw -bg $p_headercolor($w) -text [lindex $p_headers($w) $c]
	} else {
	  label $w.f.w${l}_$c -bd 1 -relief raised -width $cw -bg $p_entrycolor($w) -anchor w
	  bind $w.f.w${l}_$c <1> "Elistbox::selectrow $w $l"
	}
	grid $w.f.w${l}_$c -row $l -column $c
	incr c
      }
    }
    update
    set W [winfo reqwidth $w.f]
    set H [winfo reqheight $w.f]
    $w configure -width $W -height $H
  }
  proc repaint {w} {
    variable p_columns
    variable p_headers
    variable p_height
    variable p_width
    variable p_entrycolor
    variable p_selectcolor
    variable p_headercolor
    variable p_position
    variable p_contents

    set clist $p_columns($w)

    if { [llength $clist] == 0 } {
      set clist [list $p_width($w)]
    }

    set L $p_contents($w)
    for {set l 0 } {$l < $p_height($w) } {incr l } {
      set i $l
      if { [hasheaders $w] } { 
	if {$l == 0 } continue
	incr i -1
      }

      if {[catch { set item [lindex $L [expr $i + $p_position($w)]]}]} {
	set item {}
      }
      set c 0
      foreach cw $clist {
	$w.f.w${l}_$c configure -text [lindex $item $c]
	incr c
      }
    }
  }
  proc stdconfig {w citem} {
    variable p_$citem
    catch {
      upvar $citem x
      set p_${citem}($w) $x
      $w configure -$citem $x
    }
  }

  proc configure {w args} {
    configurel $w $args
  }
  proc configurel {w argv} {
    variable p_columns
    variable p_headers
    variable p_width
    variable p_height
    variable p_yscrollcommand

    parseargs $argv {-width -height -columns -bd -relief -yscrollcommand -bg -headers}
    stdconfig $w bd
    stdconfig $w relief
    stdconfig $w bg
    catch { set p_columns($w) $columns }
    catch { set p_headers($w) $headers }
    catch { set p_width($w) $width }
    catch { set p_height($w) $height }
    catch { set p_yscrollcommand($w) $yscrollcommand }
    catch { eval "$p_yscrollcommand($w) 0 1" }
  }
  proc get {w i} {
    variable p_contents
    return [lindex $p_contents($w) $i]
  }
  proc selection {w} {
    variable p_selection
    return $p_selection($w)
  }
  proc itemadd {w p v} {
    variable p_contents

    set p_contents($w) [linsert $p_contents($w) $p $v]
    repaint $w
  }
  proc itemdel {w p1 args} {
    variable p_contents

    if { $args != {} } {
      set p2 [lindex $args 0]
    } else {
      set p2 $p1
    }
    set p_contents($w) [lreplace $p_contents($w) $p1 $p2]
    repaint $w
  }
  proc setposition {w p} {
    variable p_position
    variable p_selection

    set p_position($w) $p
    repaint $w

    if { $p_selection($w) } {
      set r [expr $p_selection($w)-$p_position($w)+[hasheaders $w]]
      selectrow $w $r
    }
  }
  proc yview {w args} {
    variable p_yscrollcommand
    variable p_headers
    variable p_height
    variable p_position
    variable p_contents
 
    set N [llength $p_contents($w)]
    if { $N == 0} {
      catch { eval "$p_yscrollcommand($w) 0 1" }
      return
    }

    set M $p_height($w)
    if { [hasheaders $w] } { incr M -1 }

    set j $p_position($w)
    if {[scan $args "moveto %lf" v] == 1} {
      if {$v < 0 } { set v 0 }
      if {$v > 1 } { set v 1 }
      set j [expr int($v*$N)]
    } elseif {[scan $args "scroll %d units" v] == 1} {
      incr j $v
    } else {
    }

    if {$j < 0} {set j 0}
    if {$j > [expr $N -1 ]} { set j [expr $N-1]}
    if {$j != $p_position($w)} {
      setposition $w $j
    }

    set t [expr ($p_position($w)+0.0)/($N + 0.0)]
    set b [expr ($p_position($w)+$M + 0.0)/($N + 0.0)]
    if  {$b > 1 } {set b 1}

    catch { eval "$p_yscrollcommand($w) $t $b" }

  }
  proc new {w args} {
    variable p_bd

    canvas $w
    init $w
    configurel $w $args
    recolumn $w
    bind $w <Visibility> "Elistbox::yview $w"

  }
}

if { $elistbox_debug } {
  Elistbox::new .lb -width 30 -height 10 -bd 2 -relief sunken -yscrollcommand ".vb set" -bg white -columns {14 14 14} -headers {"Col 1" "Col 2" "Col 3"}
  scrollbar .vb -orient vertical -command "Elistbox::yview .lb"
 #  scrollbar .hb -orient horizontal -command ".lb xview"
  grid .lb -row 0 -column 0 -padx 20 -pady 20
  grid .vb -row 0 -column 1 -sticky ns
#  grid .hb -row 1 -column 0 -sticky ew


  Elistbox::itemadd .lb end {5 6 7}
  Elistbox::itemadd .lb end {12 18 99}
  Elistbox::itemadd .lb end {8 77 120}
  Elistbox::itemadd .lb end {12 18 35}
  Elistbox::itemadd .lb end {87 423 72}
  Elistbox::itemadd .lb end {786 72 281}
  Elistbox::itemadd .lb end {876 7823 76}
  Elistbox::itemadd .lb end {76 1289 89}
  Elistbox::itemadd .lb end {5 2013 1283}
  Elistbox::itemadd .lb end {12 12 123123}
  Elistbox::itemadd .lb end {123 87 28}
  Elistbox::itemadd .lb end {12783 765 123}
}
