
# Spreadsheet stuff.
#
# Copyright (c) 1999 Pacific Marketing and Consulting
# Author:  Wayne A. Christopher, wayne@icemcfd.com
#          Pacific Marketing and Consulting, Berkeley, California

# tree is of the form
# [list of { title name container_token { items } }]
# items is a list of :
# type [ title name [ choices ] ]
# types are :
# entry
# bool
# choice is a set of { title value } pairs
# the get_rows func returns a list of tokens that apply to the var func
# the reset func should reset all the values in the var
# the apply func should accept them

proc spreadsheet {w title tree get_rows var apply_func reset_func delete_func} {
    global spreadsheet 
    
    set buttons [list [list "Apply" "$apply_func $var"] \
		      [list "Done" "$apply_func $var; form_done $w; set form_done_flag($w) 1"] \
		      [list "Reset" "$reset_func $var; spreadsheet_update_canvas $w $var"] \
		      [list "Cancel" "form_cancel $w"] \
		     help \
		      nl \
		      [list "Expand all" "spreadsheet_expand_all $w 1"] \
		      [list "Collapse all" "spreadsheet_expand_all $w 0"] \
		      [list "Import" "spreadsheet_import $w {$tree} $get_rows $var"] \
		      [list "Export" "spreadsheet_export {$tree} $get_rows $var"]]
    form_kill $w
    set d [form_init $w $title "" $buttons "" 1 1 1]
    
    scrollbar $d.xscroll -command "$d.c xview" -relief sunken \
	    -borderwidth 2 -orient h
    scrollbar $d.yscroll -command "$d.c yview" -relief sunken \
	    -borderwidth 2 -orient v
    canvas $d.c -width 500 -height 500 -bg white \
	-xscrollcommand "$d.xscroll set" \
	-yscrollcommand "$d.yscroll set"
    grid $d.yscroll -row 0 -column 1 -sticky news
    grid $d.xscroll -row 1 -column 0 -sticky news
    grid $d.c -row 0 -column 0 -sticky news
    grid columnconfigure $d 0 -weight 1
    grid rowconfigure $d 0 -weight 1
    grid columnconfigure $d 1 -weight 0
    grid rowconfigure $d 1 -weight 0
    
    eval $reset_func $var
    spreadsheet_put_tree $d.c $tree $get_rows $var
    
    form_finish +10+10
    if [form_wait $w] {
	eval $apply_func $var
    }
}

proc spreadsheet_put_tree {canv tree get_rows var} {
    global spreadsheet summary_stypes
        
    upvar \#0 $var lvar
    
    set xmar 10
    set xind 10
    set xsep 4
    set ysep 4
    
    catch { unset spreadsheet }
    set spreadsheet($canv,branches) ""
    foreach branch $tree {
	set rows [$get_rows [lindex $branch 1] [lindex $branch 2]]
	set bn [lindex $branch 1]
	set spreadsheet($canv,$bn,active) 1
	set spreadsheet($canv,$bn,active_last) 1
	set spreadsheet($canv,$bn,line) 1
	lappend spreadsheet($canv,branches) $bn

	checkbutton $canv.but_$bn -text [lindex $branch 0] \
	    -variable spreadsheet($canv,$bn,active) \
	    -command "spreadsheet_do_layout $canv" \
	    -background white -activebackground white \
	    -highlightthickness 1.0 -highlightbackground black
	set scanv $canv.win_$bn 
 	canvas $scanv -bg white -width 10 -height 24	
	if { $bn == "domain" } { 
 	    set spreadsheet($canv,$bn,layout) 10
 	} else {
 	    set spreadsheet($canv,$bn,layout) 50
 	}
 	set items [lindex $branch 3]
 	set canva [ spreadsheet_build_canvas_tree $items $rows $branch $canv $var $bn ]
	set nlen [llength $canva]

	for { set z 0 } { $z < $nlen } { incr z } {
	    set xlines ""
	    set ylines ""
 	    set xlines_f ""
	    set ylines_f ""
	    set xpos $xsep
	    set ypos $ysep
	    set first 1
	    set ni [llength $items]; set ic 0
	    set scanv [lindex [lindex $canva $z] 0]
	    if [info exists spreadsheet($bn,$scanv,ignore)] {
	        continue
	    }
	    foreach item $items {
	    	set itype [lindex $item 0]
	    	set stype [lindex $item 2]
	    	if {$itype == "sep"} {
		    if ![info exists spreadsheet($canv,$scanv,$stype,ignore)] {
		        set xlines_f [lrange $xlines_f 0 [expr [llength $xlines_f] - 2]]
		        lappend xlines $xpos
		        incr xpos $xsep
		    }
	    	} else {
	    	    if ![info exists spreadsheet($canv,$scanv,$stype,ignore)] {
		        if {[string match shape__* $stype] && $bn != "material" } {
		            if [info exists spreadsheet($scanv,shape_type)] {
		                if ![info exists shape_num($scanv)] {
		                    set shape_num($scanv) 0
		                    set shape_type $spreadsheet($scanv,shape_type)
		                    set obj_type $spreadsheet($scanv,obj_type)
		                    set export_labels [list Name Active {Shape type}]
		                }
		      	        set text [lindex [lindex $summary_stypes($bn,$shape_type) \
		      	                    $shape_num($scanv)] 1]
		      	        set s $shape_num($scanv)
		      	        incr s
		      	        set shape_num($scanv) $s
		      	    }
		      	} else {
		      	  set text [lindex $item 1]
		      	}
		      	if { $text == "" } {
		      	  continue
		      	}
		      	set it [$scanv create text $xpos $ypos -text $text \
					-anchor nw]
		      set bb [$scanv bbox $it]
		      set wid [expr [lindex $bb 2] - [lindex $bb 0]]
		      set hgt [expr [lindex $bb 3] - [lindex $bb 1]]
		
		      set extra [lindex $item 3]
		      set yp [expr $ypos + $hgt + $ysep]
		
		      if $first {
		    	  lappend ylines [expr $yp - $ysep / 2]
		      }
		      set nr [llength $rows]; set rc 0
		    }
		    foreach r $rows {
			if [info exists spreadsheet($canv,$scanv,$stype,ignore)] {
      		    	    break
      			}
      			if ![info exists is_in_row($bn,$z,$r)] {
		    	    set is_in_row($bn,$z,$r) [ spreadsheet_is_in_row $canv $bn $z $r ]
		    	}
      			if !$is_in_row($bn,$z,$r) {
      			    continue
      			}
		        if [string match shape__* $stype] {
		            set sv shape__$text
		            set key [lindex $branch 1],[lindex $branch 2],$r,$sv
		        } else {
		           set key [lindex $branch 1],[lindex $branch 2],$r,$stype
		        }
		        if ![info exists lvar($key)] {
		            continue
		        }
		    	set val $lvar($key)
		    	set spreadsheet($key,type) $itype
			#puts $key
		    	switch $itype {
			    bool {
			    	if [catch {set val [lindex {NO YES} $val]}] {
				    set val NO
				}
			    }
			    choice {
			    	foreach e $extra {
				    if {$val == [lindex $e 1]} {
				    	set val [lindex $e 0]
				    	break
				    }
			    	}
			    	lappend spreadsheet($key,type) $extra
			    }
		    	}
		    	set it [$scanv create text $xpos $yp \
					-text $val -anchor nw -tags $key]
		    	$scanv bind $it <Button-1> \
					[list spreadsheet_edit $scanv $itype \
			     		$it $key $var $extra]
		    	set bb [$scanv bbox $it]
		    	set hgt [expr [lindex $bb 3] - [lindex $bb 1]]
		    	set wid2 [expr [lindex $bb 2] - [lindex $bb 0]]
		    	if {$wid2 > $wid} { set wid $wid2 }
		            incr yp [expr $hgt + $ysep]
		    	if {$first && ($rc < $nr - 1)} {
			    lappend ylines_f [expr $yp - $ysep / 2]
		    	}
		    	incr rc
		    }
		    if ![info exists spreadsheet($canv,$scanv,$stype,ignore)] {
		      incr xpos [expr $wid + $xsep]
		      if {$ic < $ni - 1} {
		    	lappend xlines_f [expr $xpos - $xsep / 2]
		      }
		    }
	        }
	        incr ic
	        set first 0
	        if { $bn != "material" } {
	          if [info exists shape_num($scanv)] {
	            if ![info exists spreadsheet($canv,$scanv,$stype,ignore)] {
		      if { $stype != "" } {
		        lappend export_labels $text
		      }
		    }
		  }
	        } else {
	           if { $stype != "" } {
	             lappend export_labels $text
	           }
	        }	        
	    }
	    set one $spreadsheet($scanv,shape_type)
	    set two $spreadsheet($scanv,obj_type)
	    set spreadsheet($bn,$one,$two,export_labels) $export_labels
	    unset export_labels
	    set ypos [expr $yp + $ysep]
	    set bb [$scanv bbox all]
	    foreach i {0 1 2 3} {
	    	set [lindex {xmin ymin xmax ymax} $i] [lindex $bb $i]
	    }
	    foreach x $xlines {
	        $scanv create line $x $ymin $x $ymax -fill black -tags lines
	    }
	    foreach y $ylines {
	        $scanv create line $xmin $y $xmax $y -fill black -tags lines
	    }
	    foreach x $xlines_f {
	       $scanv create line $x $ymin $x $ymax -fill gray -tags lines_f
	    }
	    foreach y $ylines_f {
	       $scanv create line $xmin $y $xmax $y -fill gray -tags lines_f
	    }
	    set sbb [$scanv bbox all]
	    $scanv configure -width [expr [lindex $sbb 2] - 4] -height [expr [lindex $sbb 3] - 4]
	    
	}
    }
    spreadsheet_do_layout $canv
}

proc spreadsheet_build_canvas_tree {items rows branch canv var bn} {
    global spreadsheet object_type_params_ignore
    
    upvar \#0 $var lvar
    
    set spreadsheet($canv,$bn,wins) ""
    foreach item $items {
        set stype [lindex $item 2]
      	foreach r $rows {
      	    switch $stype { 
                name - current_stype - block_type - type - mat_type {
                    set k [lindex $branch 1],[lindex $branch 2],$r,$stype
                    set v $lvar($k)
                    if ![ info exists spp($bn,$stype,$v) ] {
                        set spp($bn,$stype,$v) 1
                        lappend sp($bn,$stype) $v
                    }
                    if ![ info exists spp($bn,$stype,$v,$r) ] {
                        set spp($bn,$stype,$v,$r) 1
                        lappend sp($bn,$stype,$v,row) $r
                    }
                }
            }
      	}
    }
    
    if { $bn != "material" } {
        foreach a [ array names sp $bn,current_stype ] {
            foreach type $sp($a) {
                foreach b [ array names sp $bn,current_stype,$type,row ] {
                    foreach type2 $sp($b) {
                        foreach stype { block_type type } {
                            foreach c [ array names sp $bn,$stype ] {
                                foreach type3 $sp($c) {
                                    foreach d [ array names sp $bn,$stype,$type3,row ] {
                                        foreach type4 $sp($d) {
                                            if { $type2 == $type4 } {
                                                lappend sp($bn,$type,$type3,group) $type4
                                            }
                                        }
                                    }
                                }
                            }
                        }
                    }
                }
            }
        }
        if ![info exists sp($bn,current_stype)] { return "" }
    }
     
    if { $bn == "material" } {
        set use_type mat_type
    } else {
        set use_type current_stype
    }
    foreach a [ array names sp $bn,name ] {
      foreach type $sp($a) {
        foreach b [ array names sp $bn,name,$type,row ] {
          foreach type2 $sp($b) {
            if { $bn == "block" } {
              foreach stype { block_type type } {
                foreach c [ array names sp $bn,$stype ] {
                  foreach type3 $sp($c) {
                    foreach d [ array names sp $bn,$stype,$type3,row ] {
                      foreach type4 $sp($d) {
                        if { $type2 == $type4 } {
                          foreach e [ array names sp $bn,$use_type ] {
                            foreach type5 $sp($e) {
                              foreach f [ array names sp $bn,$use_type,$type5,row ] {
                                foreach type6 $sp($f) {
                                  if { $type6 == $type4 } {
                                    lappend spreadsheet($bn,$type5,$type3,export_name) $type
                                    lappend spreadsheet($bn,$type5,$type3,export_row) $type4
                                  }
                                } 
                              }
                            }
                          }
                        }
                      }
                    }
                  }
                }
              }
            } else {
              foreach h [ array names sp $bn,$use_type ] {
                foreach type5 $sp($h) {
                  foreach i [ array names sp $bn,$use_type,$type5,row ] {
                    foreach type6 $sp($i) {
                      if { $type6 == $type2 } {
                        lappend spreadsheet($bn,$type5,,export_name) $type
                        lappend spreadsheet($bn,$type5,,export_row) $type2
                      }
                    }   
                  }
                }
              }
            }                 
          }
        }
      }
    }
    
    if ![info exists sp($bn,$use_type)] { return "" }
    
    set num 0
    set arr ""
    foreach v $sp($bn,$use_type) {
        if ![ info exists sp($canv,$bn,$v) ] {
	    set sp($canv,$bn,$v) 1
	    incr num
	    checkbutton $canv.but_${bn}_$num -text "$v" \
	       -variable spreadsheet($canv,${bn}_$num,active) \
	       -command "spreadsheet_do_layout $canv $canv.but_${bn}_$num" \
	       -bg white -activebackground white \
	       -highlightthickness 1.0 -highlightbackground black
	    set spreadsheet($canv,${bn}_$num,active) 1
	    set spreadsheet($canv,${bn}_$num,active_last) 1
	    set spreadsheet($canv,${bn}_$num,layout) 100
	    set spreadsheet($canv,${bn}_$num,line) 0
	    lappend spreadsheet($canv,branches) ${bn}_$num
	    set spreadsheet($canv,${bn}_$num,row) $sp($bn,$use_type,$v,row)
	    lappend spreadsheet($canv,$bn,wins) ${bn}_$num
	    set scanv $canv.win_${bn}_$num
	    set spreadsheet($scanv,shape_type) $v
	    set spreadsheet($scanv,obj_type) ""
	    canvas $scanv -bg white -relief ridge -borderwidth 2
	    lappend arr [ list $scanv ]
	    if { $bn == "block" } {
	        set spreadsheet($bn,$scanv,ignore) 1
	    }
	    if { $bn == "block"  } {
	        set last_num $num
	        foreach a [ array names sp $bn,$v,*,group ] {
	            incr num
	            set vv [ lindex [ split $a , ] 2 ]
	            checkbutton $canv.but_${bn}_$num -text "$vv" \
	                -variable spreadsheet($canv,${bn}_$num,active) \
	                -command "spreadsheet_do_layout $canv $canv.but_${bn}_$num sub" \
	                -bg white -activebackground white \
	                -highlightthickness 1.0 -highlightbackground black
	            set spreadsheet($canv,${bn}_$num,active) 1
	            set spreadsheet($canv,${bn}_$num,active_last) 1
	            set spreadsheet($canv,${bn}_$num,layout) 150
                    set spreadsheet($canv,${bn}_$num,line) 0
	            set spreadsheet($canv,${bn}_$num,row) $sp($a)
	            set sub ${canv}.but_${bn}_${num}
	            set spreadsheet($canv,${bn}_$num,subtype) $sub
	            set spreadsheet($canv,${bn}_${last_num},remove) 1
	            lappend spreadsheet($canv,branches) ${bn}_$num
	            lappend spreadsheet($canv,$bn,wins) ${bn}_$num
	            lappend spreadsheet($canv,${bn}_${last_num},subtypes) ${bn}_$num
	            set scanv $canv.win_${bn}_$num
	            canvas $scanv -bg white -relief ridge -borderwidth 2
	            set spreadsheet($scanv,shape_type) $v
	            set spreadsheet($scanv,obj_type) $vv
	            lappend arr [ list $scanv ]
	            foreach t [ array names spreadsheet $canv,$scanv,*,ignore ] {
	                unset spreadsheet($t)
    	            }
		    if [info exists object_type_params_ignore(${bn},$vv)] {
			foreach t $object_type_params_ignore(${bn},$vv) {
			    set spreadsheet($canv,$scanv,$t,ignore) 1
			}
		    }
	        }
	    }
        }
    }
    return $arr
}

proc spreadsheet_is_in_row {canv bn num r} {
    global spreadsheet
	
    incr num
    foreach item [ array names spreadsheet $canv,${bn}_$num,row ] {
	foreach i $spreadsheet($item) {
   	    if { $i == $r } {
   		return 1
   	    }
   	}
    }
    return 0
}

proc spreadsheet_export_is_in_row {bn type1 r type2} {
    global spreadsheet

    foreach item [ array names spreadsheet $bn,$type1,$type2,export_row ] {
	foreach i $spreadsheet($item) {
   	    if { $i == $r } {
   		return 1
   	    }
   	}
    }
    return 0
}

proc spreadsheet_do_layout {canv {which "" } {sub ""}} {
    global spreadsheet
        
    set xcol_1 50
    set xcol_2 100
    set xcol_3 150
    set xdif 10
    set ydif 14
    set diff 18
    set xsep 4
    set ysep 4
    
    if [ info exists spreadsheet(pressed) ] {
      return
    }    
    set spreadsheet(pressed) 1
    $canv delete all
    set ypos 30
    foreach bn $spreadsheet($canv,branches) {
      set but $canv.but_$bn
      set win $canv.win_$bn
      set xpos $spreadsheet($canv,$bn,layout)
      $canv create window $xpos $ypos -window $but -anchor nw -tags $but
      	if { $xpos == 10 } {
            if !$spreadsheet($canv,$bn,active) {
                if ![ info exists spreadsheet(expand_all) ] {
                    unset spreadsheet(pressed)
                    return
                } else {
                    unset spreadsheet(expand_all)
                }
            } else {
                if [ info exists spreadsheet(expand_all) ] {
                    unset spreadsheet(expand_all)
                }
            }
        }
        
      if $spreadsheet($canv,$bn,active) {        
        if $spreadsheet($canv,$bn,line) {
	   $canv create line $xdif [ expr $ypos + $xdif ] $xpos \
	   	[ expr $ypos + $xdif ] -fill black -width 1.0
	   set last_pos [ expr $ypos + $xdif ]
        } 
        if { $xpos == $xcol_2 } {
          set last_y $ypos
          $canv create line $xcol_1 $last_pos $xcol_1 [ expr $ypos + $xdif ] \
          		-fill black -width 1.0
	  $canv create line $xcol_1 [ expr $ypos + $xdif ] $xpos \
	  		[ expr $ypos + $xdif ] -fill black -width 1.0
	  if { [ winfo exists $win ] && \
	      ![ info exists spreadsheet($canv,${bn},remove) ] } {
	    set last_y $ypos
	    set x [ expr [ winfo reqwidth $but ] + $ysep + $xpos ]
	    $canv create window $x $ypos -window $win -anchor nw
	    incr ypos [ expr [ winfo reqheight $win ] + $ysep ]
	  } else {
	    set last_y $ypos
	    incr ypos [ expr [ winfo reqheight $but ] + $ysep ]
	  }
	  if [ info exists spreadsheet($canv,$bn,subtypes) ] {
            foreach item $spreadsheet($canv,$bn,subtypes) {
              if { ($which != "") && ($sub == "") } {
                set spreadsheet($canv,$item,active) 1
              }
            }
          }
        } elseif { $xpos == $xcol_3 } {
          $canv create line $xcol_2 $last_y $xcol_2 [ expr $ypos + $xdif ] \
          		-fill black -width 1.0
          $canv create line $xcol_2 [ expr $ypos + $xdif ] $xpos \
          		[ expr $ypos + $xdif ] -fill black -width 1.0
          if [ winfo exists $win ] {
	    set last_y $ypos
	    set x [ expr [ winfo reqwidth $but ] + $ysep + $xpos ]
	    $canv create window $x $ypos -window $win -anchor nw
	    incr ypos [ expr [ winfo reqheight $win ] + $ysep ]
	  }
        } else {
          set last_y $ypos
          incr ypos [ expr [ winfo reqheight $but ] + $ysep ]
        }
      } else {
        if ![ info exists spreadsheet($canv,$bn,wins) ] {
          if { $xpos == $xcol_2 || $xpos == $xcol_3 } {
            if { $which == "" } {
              $canv delete $spreadsheet($bn,child)
              set spreadsheet($canv,$bn,active) 1
              set spreadsheet($canv,$bn,active_last) 0
            } else {
              if { $xpos == $xcol_2 } {
                $canv create line $xcol_1 $last_pos $xcol_1 [ expr $ypos + $xdif ] \
                		-fill black -width 1.0
	        $canv create line $xcol_1 [ expr $ypos + $xdif ] $xpos \
	        		[ expr $ypos + $xdif ] -fill black -width 1.0
              } elseif { $xpos == $xcol_3 } {
                $canv create line $xcol_2 $last_y $xcol_2 [ expr $ypos + $xdif ] \
                		-fill black -width 1.0
                $canv create line $xcol_2 [ expr $ypos + $xdif ] $xpos \
                		[ expr $ypos + $xdif ] -fill black -width 1.0
              }
              set last_y $ypos
              incr ypos [ expr [ winfo reqheight $which ] + $ysep ]
              if [ info exists spreadsheet($canv,$bn,subtypes) ] {
                foreach item $spreadsheet($canv,$bn,subtypes) {
                  set spreadsheet($canv,$item,active) 0
                }
              }
            }
          }
        } else {
          if { $xpos == $xcol_2 } {
	    incr ypos [ expr [ winfo reqheight $but ] + $ysep ]
	    $canv create line $xcol_1 $last_y $xcol_1 [ expr $ypos - $diff ] \
	    		-fill black -width 1.0
	    $canv create line $xcol_1 [ expr $ypos - $diff ] $xpos \
	    		[ expr $ypos - $diff ] -fill black -width 1.0
	  } elseif { $xpos == $xcol_3 } {
            incr ypos [ expr [ winfo reqheight $but ] + $ysep ]
            $canv create line $xcol_2 $last_y $xcol_2 [ expr $ypos - $diff ] \
            		-fill black -width 1.0
            $canv create line $xcol_2 [ expr $ypos - $diff ] $xpos \
            		[ expr $ypos - $diff ] -fill black -width 1.0
          } else {
            if $spreadsheet($canv,$bn,line) {
	      $canv create line $xdif [ expr $ypos + $xdif ] $xpos \
	      		[ expr $ypos + $xdif ] -fill black -width 1.0
	      set last_pos [ expr $ypos + $xdif ]
            }
            set last_y $ypos
            incr ypos [ expr [ winfo reqheight $but ] + $ysep ]
          }
        }
      }
      set spreadsheet($bn,child) $but
      if [ info exists spreadsheet($canv,$bn,wins) ] {
        spreadsheet_do_layout_tree $canv $bn $spreadsheet($canv,$bn,active)
      } 
    }
    $canv create window 0 0 -anchor nw 
    $canv create line $xdif 30 $xdif $last_pos -fill black -width 1.0
    $canv configure -scrollregion [ $canv bbox all ]
    unset spreadsheet(pressed)
}

proc spreadsheet_do_layout_tree {canv bn on} {
    global spreadsheet
    
    foreach item $spreadsheet($canv,$bn,wins) {
    	set but $canv.but_$item
    	if $on {
    	    $but configure -state normal
    	    if $spreadsheet($canv,$item,active) {
      		set spreadsheet($canv,$item,active_last) 1
	    } else {
      		if $spreadsheet($canv,$item,active_last) {
      		  set spreadsheet($canv,$item,active) 0
      		  set spreadsheet($canv,$item,active_last) 1
      		} else {
      		  set spreadsheet($canv,$item,active) 1
      		  set spreadsheet($canv,$item,active_last) 0
      		}
      	    }
      	} else {
      	   set spreadsheet($canv,$item,active) 0
      	   $but configure -state disabled
      	}
    }
}

proc spreadsheet_edit {canv type it key var extra} {
    global spreadsheet
    
    if [info exists spreadsheet(editw_done)] {
	set spreadsheet(editw_done) 1
	# we need to do this to avoid Tk event loop stuff
	after idle [list spreadsheet_edit $canv $type $it $key $var $extra]
	return
    }
    
    upvar \#0 $var lvar
    set spreadsheet(editw_val) $lvar($key)
    
    set bb [$canv bbox $it]
    
    switch $type {
	label { }
	entry {
	    set bb [$canv bbox $it]
	    entry $canv.editw -textvariable spreadsheet(editw_val) -width 20 \
		-relief ridge -borderwidth 2
	    bind $canv.editw <Key-Return> "set spreadsheet(editw_done) 1"
	    set itw [$canv create window [lindex $bb 0] \
			 [expr [lindex $bb 1] - 4] \
			-window $canv.editw -anchor nw]
	    set spreadsheet(editw_done) 0
	    tkwait variable spreadsheet(editw_done)
	    $canv delete $itw
	    destroy $canv.editw
	    if $spreadsheet(editw_done) {
		set lvar($key) $spreadsheet(editw_val)
		$canv itemconfigure $it -text $spreadsheet(editw_val)
	    }
	    unset spreadsheet(editw_done)
	}
	bool {
	    set lvar($key) [expr !$lvar($key)]
	    $canv itemconfigure $it -text [lindex {NO YES} $lvar($key)]
	}
	choice {
	    menu $canv.editw -tearoff 0 -background white -relief ridge \
		-borderwidth 2
	    foreach e $extra {
		$canv.editw add command -label [lindex $e 0] -command \
		    [list spreadsheet_pick_choice [lindex $e 0] [lindex $e 1]]
	    }
	    top_geometry $canv.editw +[winfo pointerx .]+[winfo pointery .]
	    raise $canv.editw
	    set spreadsheet(editw_done) 0
	    tkwait variable spreadsheet(editw_done)
	    destroy $canv.editw
	    if $spreadsheet(editw_done) {
		set lvar($key) $spreadsheet(editw_val)
		$canv itemconfigure $it -text $spreadsheet(editw_label)
	    }
	    unset spreadsheet(editw_done)
	}
    }
}

proc spreadsheet_pick_choice {title value} {
    global spreadsheet
    set spreadsheet(editw_val) $value
    set spreadsheet(editw_label) $title
    set spreadsheet(editw_done) 1
}

proc spreadsheet_update_canvas {w var} {
    global spreadsheet
    
    set canv $w.main.c
    
    upvar \#0 $var lvar
    
    foreach key [array names lvar] {
        set val $lvar($key)
        if ![info exists spreadsheet($key,type)] {
            continue
        } else {
            set type [lindex $spreadsheet($key,type) 0]
        }
        switch $type {
            entry { }
            bool {
		if [catch {set val [lindex {NO YES} $val]}] {
		    set val NO
		}
            }
            choice {
                foreach e [lindex $spreadsheet($key,type) 1] {
                    if {$val == [lindex $e 1]} {
                        set val [lindex $e 0]
                        break
                    }
                }
            }
        }
        foreach bn $spreadsheet($canv,branches) {
            foreach it [$canv.win_$bn find withtag $key] {
                $canv.win_$bn itemconfigure $it -text $val
            }
        }
    }
}

proc spreadsheet_expand_all {w val} {
    global spreadsheet
    
    set canv $w.main.c
    foreach bn $spreadsheet($canv,branches) {
	if {$bn != "domain"} {
	    set spreadsheet($canv,$bn,active) $val
	}
    }
    set spreadsheet(expand_all) $val
    spreadsheet_do_layout $canv
}

proc unused__spreadsheet_import {w tree get_rows var} {
    global spreadsheet

    set file [file_select "Select a file to load the data from." \
		  [directory]/summary_data "Load summary" 0 0]
    if {$file == ""} return
    
    set fp [open $file r]
    mess "Loading summary data from \"$file\"\n"
    
    upvar \#0 $var lvar
    
    busy 1
    mess "Updating spreadsheet...\n"
    #puts here1
    while {![eof $fp]} {
	set line [string trimright [gets $fp]]
	set linelist [split $line \t]
	if {[lindex $linelist 0] == "Name"} {
	    set spreadsheet(what,import) $line
	} else {
	    set spreadsheet(labels,import) [lrange [split $vline \t] 1 end]
	    set name [lindex $spreadsheet(labels,import) 0]
	    spreadsheet_import_set $tree $get_rows $line $var $name
	}
	#puts "did line $line"
    }
    #puts done
    close $fp
    spreadsheet_update_canvas $w $var
    mess "Done updating.\n"
    busy 0
}

proc spreadsheet_import {w tree get_rows var} {
    global spreadsheet

    set file [file_select "Select a file to load the data from." \
		  [directory]/summary_data "Load summary" 0 0]
    if {$file == ""} return
    
    set fp [open $file r]
    mess "Loading summary data from \"$file\"\n"
    
    upvar \#0 $var lvar
    
    busy 1
    mess "Updating spreadsheet...\n"
    #puts here1
    while {![eof $fp]} {
	set line [string trimright [gets $fp]]
	set first [string index $line 0]
	set scnd [lindex $line 0]
	if {($first != "\t") || ($scnd == "Name")} {
	    set spreadsheet(labels,import) ""
	    if {($scnd == "Name")} {
	        set vline $line
	    } else {
	       set spreadsheet(what,import) $line
	       set vline [gets $fp]
	    }
	    set len [string length $vline]
	    set val ""
	    for { set i 0 } { $i < $len } { incr i } {
		set a [string index $vline $i]
		if { $a != "\t" } {
		    append val "$a"
		} else {
		    if { $val != "" } {
			lappend spreadsheet(labels,import) $val
		    } 
		    set val ""
		}
            }
	} else {	    
	    set name [lindex $line 0]
	    spreadsheet_import_set $tree $get_rows $line $var $name
	}
	#puts "did line $line"
    }
    #puts done
    close $fp
    spreadsheet_update_canvas $w $var
    mess "Done updating.\n"
    busy 0
}

proc spreadsheet_import_set {tree get_rows line var name} {
    global spreadsheet

    upvar \#0 $var lvar

    set vline $line
    set len [string length $vline]
    set idx 0
    set found 0

    for { set i 0 } { $i < $len } { incr i } {
	set a [string index $vline $i]
	if { $a != "\t" } {
	    append val "$a"
	} elseif [info exists val] {	;# the (new) value
	    if $found continue
	    foreach branch $tree {
		if { "[lindex $branch 0]" == $spreadsheet(what,import) } {
		    set rows [$get_rows [lindex $branch 1] [lindex $branch 2]]
		    set items [lindex $branch 3]
		    foreach r $rows {
	    		foreach item $items {
			    set stype [lindex $item 2]
			    switch $stype {
	  			name {
				    set k [lindex $branch 1],[lindex $branch 2],$r,[lindex $item 2]
				    if [info exists lvar($k)] {									
					set rname $lvar($k)
				    }
				}
			    }
			    if { $name != $rname } {	;# not the same block, pcb etc.
				continue
			    }
			    if { [lindex $spreadsheet(labels,import) $idx] == [lindex $item 1] } {
				set k [lindex $branch 1],[lindex $branch 2],$r,[lindex $item 2]
				if [info exists lvar($k)] {
				    set newline [ regexp , $val ]
				    if $newline {
                                        regsub -all ", " $val "\n" val
                                        regsub -all " ," $val "\n" val
                                        regsub -all "," $val "\n" val
                                        mess "Replacing all , in $name with label\"[lindex $item 1]\".\n" red
                                    }
                                    if { $val == " " } {
                                        set val ""
                                    }
				    set lvar($k) $val
				    puts "set lvar($k) $val"
				    set found 1
				    break
				}								
			    }
			}
		    }
		    continue
		}
	    }
	    incr idx
	    unset val
	    set found 0
	}
    }
}

proc new_spreadsheet_file_selected {file} {
    global is_win
    
    if ![file exists $file] { return 1 }
}

proc spreadsheet_export {tree get_rows var} {
    global spreadsheet 
    
    set file [file_selection -message "Select a file to save the data to." \
		  -default  [directory]/summary_data  -title "Save summary" \
		  -warn_overwrite 0 -is_save_dialog 1\
		  -new_ok 2 -ok_func new_spreadsheet_file_selected ]
    if {$file == ""} return
    
    spreadsheet_export_get_values $tree $get_rows
    
    set fp [open $file w]
    upvar \#0 $var lvar
    busy 1
    foreach branch $tree {
        puts $fp "[lindex $branch 0]"
        set rows [$get_rows [lindex $branch 1] [lindex $branch 2]]
        set items [lindex $branch 3]
	set bn [lindex $branch 1]
	if { $bn != "material" } {
	    set use_shape {circ container cyl hexa incline pipe polygon quad}
	} else {
	    set use_shape {solid fluid surface}
	}
	foreach shape $use_shape {
            foreach item_shape [array names spreadsheet $bn,$shape*,export_labels] {
	        if { ($bn == "block") && [lindex [split $item_shape ,] 2] == "" } {
                    continue
                }
                puts -nonewline $fp "\t"
                foreach label $spreadsheet($item_shape) {
                    if {$label != ""} {
                       puts -nonewline $fp "$label\t"
                    }
                }  
                set shape1 [lindex [split [set shape $item_shape] ,] 1]
                set shape2 [lindex [split [set shape $item_shape] ,] 2]
                foreach item_name [array names spreadsheet $bn,$shape1,$shape2,export_name] {
                    foreach name $spreadsheet($item_name) {
                        puts $fp ""
                        puts -nonewline $fp "\t"
                        foreach item_values [array names spreadsheet $bn,$shape1,$shape2,export_values] {
                            if { ($bn == "block") && [lindex [split $item_values ,] 2] == "" } {
                                continue
                            }
                            foreach value $spreadsheet($item_values) {
                                foreach item_row [array names spreadsheet $bn,$shape1,$shape2,export_row] {
		                    foreach r $spreadsheet($item_row) {
		                        if ![info exists found($r)] {
		                            set found($r) 0
		                        }
		                        set k [lindex $branch 1],[lindex $branch 2],$r,$value
		                        switch $value {
	  			             name {
				                if [info exists lvar($k)] {
					            if !$found($r) {
					                set rname $lvar($k)
					                set found($r) 1
					                set row $r
					            }
					        }
					    }
                                        }
                                        if {$rname != $name} {
		                            continue
		                        }
		                        set k [lindex $branch 1],[lindex $branch 2],$row,$value
		                        if [info exists lvar($k)] {
		                            if [info exists export($k,$lvar($k))] {
		                                 continue
		                            }
		                            set export($k,$lvar($k)) 1
		                            set v $lvar($k)
		                            set newline [ regexp \n $v ]
                                            if $newline {
                                               # what to do ?
                                               regsub -all \n $v " , " v
                                               mess "Replacing all newlines in $name $value.\n" red
                                            }
		                            regsub -all {[ \t]} $v " " v
                                            if { $v != "" } {
                                                puts -nonewline $fp "[string trim $v]\t"
                                            } else {
                                               puts -nonewline $fp " \t"
                                            }
                                            break
		                        }
		                    }
                                }
                            }
                        }
                    }
                    puts $fp ""
                }           
            }
        }
    }
    busy 0
    close $fp    
    mess "Written summary data to \"$file\"\n"
}

proc spreadsheet_export_get_values {tree get_rows} {
    global spreadsheet

    foreach branch $tree {
        set rows [$get_rows [lindex $branch 1] [lindex $branch 2]]
        set items [lindex $branch 3]
	set bn [lindex $branch 1]
	if { $bn != "material" } {
	    set use_shape {circ container cyl hexa incline pipe polygon quad}
	} else {
	    set use_shape {solid fluid surface}
	}
	foreach shape $use_shape {
            foreach item_shape [array names spreadsheet $bn,$shape,*,export_labels] {
	        if { ($bn == "block" ) && [lindex [split $item_shape ,] 2] == "" } {
                    continue
                }
                set shape1 [lindex [split [set shape $item_shape] ,] 1]
                set shape2 [lindex [split [set shape $item_shape] ,] 2]
                if ![info exists sp($bn,$shape1,$shape2)] {
                    set sp($bn,$shape1,$shape2) 1
                    if { $bn != "material" } {
                        set spreadsheet($bn,$shape1,$shape2,export_values) [list name]
                    }
                }
                foreach label $spreadsheet($item_shape) {
                    foreach item $items {
                       if {[lindex $item 1] == $label} {
                          if ![info exists sp($bn,$shape1,$shape2,$label)] {
                             set sp($bn,$shape1,$shape2,$label) 1
                             lappend spreadsheet($bn,$shape1,$shape2,export_values) [lindex $item 2]
                          }
                       }
                    }
                }
            }
        }
    }
}

proc spreadsheet_delete_inactive {w var func} {
    upvar \#0 $var lvar
    
    foreach key [array names lvar] {
	set skey [split $key ,]
	set obj [lindex $skey 2]
	set found($obj) 1
    }
    set nd 0
    foreach obj [array names found] {
	if ![$obj si_value active 1] {
	    if [eval $func $obj] { incr nd }
	}
    }
    mess "$nd inactive objects deleted\n"
    
    summary_sheet ;# this is bad -- the summary sheet should know how to
    		  ;# to regenerate itself
}

# ---------------------------------------------------------------------

proc tt {} {
    global tt_var
    
    uplevel \#0 set is_win 0
    uplevel \#0 set small_screen_hack 0
    uplevel \#0 source forms.tcl
    uplevel \#0 source settings.tcl
    uplevel \#0 proc busy args \{\}
    
    set tree {
	{ Blocks block foo {
	    { label Name name }
	    { bool Active active }
	    sep
	    { entry Heat heat }
	    { choice Type type { { Good good } { Bad bad }} }
	} }
    }
    spreadsheet .spr "Test spreadsheet"  $tree tt_get_rows tt_var \
	tt_apply_func tt_reset_func
}

proc tt_get_rows {name handle} {
    switch $name {
	block { return "b1 b2" }
	default error
    }
}

proc tt_apply_func {var} {
    global tt_var
    parray tt_var
}

proc tt_reset_func {var} {
    global tt_var
    
    array set tt_var {
	block,foo,b1,name "Block 1"
	block,foo,b1,active 1
	block,foo,b1,heat 13
	block,foo,b1,type good
	block,foo,b2,name "Block 2"
	block,foo,b2,active 0
	block,foo,b2,heat 7
	block,foo,b2,type bad
    }
}

#tt
