
# Stuff to make flexible lists
#
# Copyright (c) 1993, 1994 Pacific Marketing and Consulting
# Author:  Wayne A. Christopher, wayne@pmac.com
#          Pacific Marketing and Consulting, Berkeley, California

# cols are name title type default datatype

# proc get_the_values {} { return "a b c d e" }
# flexlist .foo "Test" {{one One entry 3.0} {two Two checkbutton 0} {three Three choice "" {X Y Z}} {four Four choice_func "" get_the_values}} {{17 1 X a}  {14 0 Y b}} "" "" 0


proc flexlist {w title cols data {apply_func ""} {focus_func ""} {use_active 1} {newline_func ""} {modify_func ""} {delete_func ""} {extra_widgets_func ""}} {
    global flexlist
    
    foreach v [array names flexlist] {
	if [string match $w* $v] {
	    unset flexlist($v) ;# kill the traces
	}
    }
    
    if $use_active {
	lappend cols "active Active checkbutton 1"
    }
    lappend cols [list delete Delete button [list flexlist_delete $delete_func]]
    
    set flexlist($w,cols) $cols
    
    set newcmd "flexlist_newline $w \{\} \{$focus_func\} \{$newline_func\} \{$modify_func\}"
    if {$apply_func != ""} {
	set buttons [list [list New $newcmd] \
			 [list Apply [list flexlist_apply $w $apply_func]] \
			 [list Clear [list flexlist_clear $delete_func $w]] \
			 done help]
    } else {
	set buttons [list [list New $newcmd] \
			 accept \
			 [list Clear [list flexlist_clear $delete_func $w]] \
			 cancel help]
    }
    
    form_kill $w
    set d [form_init $w $title "" $buttons "" 1 1 1]
    #set dd [form_init $w $title "" $buttons]
    set scr [form_scroller $d.scr 300 {0 0}]
    set cn 0
    foreach c $cols {
	set name [lindex $c 0]
	set title [lindex $c 1]
	form_label $scr.${name}l $title "0 $cn -cols 2"
	form_underline $scr.${name}u "1 $cn -cols 2"
	incr cn 3
    }
    
    if {$extra_widgets_func != ""} {
	form_frame $d.extras ridge 2 {1 0}
	eval $extra_widgets_func $d.extras
    }
    
    set flexlist($w,frame) $scr
    set flexlist($w,count) 0
    
    top_withdraw $w
    foreach d $data {
	# Don't pass the newline func here
	flexlist_newline $w $d $focus_func "" $modify_func
    }
    form_finish bot
    
    if {$apply_func != ""} return
    
    if ![form_wait $w] { return "*cancel*" }
    
    return [flexlist_apply $w ""]
}

proc form_flexlist {w cols data height geo {focus_func ""} {use_active 1} {wfixed 0} {newline_func ""} {modify_func ""} {delete_func ""}} {
    global flexlist
    
    if $use_active {
	lappend cols "active Active checkbutton 1"
    }
    lappend cols [list delete Delete button [list flexlist_delete $delete_func]]
    
    set flexlist($w,cols) $cols
    
    set d [form_scroller $w $height $geo $height $wfixed]
    set cn 0
    foreach c $cols {
	set name [lindex $c 0]
	set title [lindex $c 1]
	if [string match __variable__* $title] {
	    form_label_variable $d.${name}l [lindex $title 1] "0 $cn -cols 2"
	} else {
	    form_label $d.${name}l $title "0 $cn -cols 2"
	}
	form_underline $d.${name}u "1 $cn -cols 2"
	incr cn 3
    }
    
    form_button $d.new New "flexlist_newline $w \{\} \{$focus_func\} \{$newline_func\} \{$modify_func\}" \
	{1000 0 -fill none}
    
    set flexlist($w,frame) $d
    set flexlist($w,count) 0
    
    foreach d $data {
	flexlist_newline $w $d $focus_func "" $modify_func
    }
}

proc flexlist_apply {w apply_func} {
    global flexlist flexlist_units
    
    set ret ""
    for {set i 0} {$i < $flexlist($w,count)} {incr i} {
	if [info exists flexlist($w,$i,active)] {
	    set r ""
	    foreach c $flexlist($w,cols) {
		set name [lindex $c 0]
		if [info exists flexlist_units($w,$i,$name)] {
		    lappend r [list $flexlist($w,$i,$name) \
				   $flexlist_units($w,$i,$name)]
		} else {
		    lappend r $flexlist($w,$i,$name)
		}
	    }
	    lappend ret $r
	}
    }
    if {$apply_func != ""} {
	eval $apply_func \{$ret\}
    } else {
	return $ret
    }
}

proc flexlist_newline {w data focus_func newline_func modify_func} {
    global flexlist flexlist_units subtitle_font
    
    set num $flexlist($w,count)
    incr flexlist($w,count)
    set nr [expr $num + 10]
    set d $flexlist($w,frame)
    set cols $flexlist($w,cols)
    
    set flexlist($w,$num,active) 1
    
    set nn $num
    while {[winfo exists $d.active$nn]} {
	foreach c $cols {
	    destroy $d.[lindex $c 0]$nn
	}
	incr nn
    }
    
    if {$data == ""} {
	flexlist_reset $w $num
    } else {
	lappend data 1  ;# just in case
	foreach c $cols it $data {
	    set name [lindex $c 0]
	    set type [lindex $c 2]
	    if {$type == "unitentry"} {
		set flexlist($w,$num,$name) [lindex $it 0]
		set flexlist_units($w,$num,$name) [lindex $it 1]
	    } else {
		set flexlist($w,$num,$name) $it
		catch {unset flexlist_units($w,$num,$name)}
	    }
	}
    }
    
    set cn 0
    set vals ""
    foreach c $cols {
	set name [lindex $c 0]
	set title [lindex $c 1]
	set type [lindex $c 2]
	set def [lindex $c 3]
	set width [lindex $c 6]
	
	set dd $d.$name$num
	switch $type {
	    checkbutton {
		set act flexlist($w,$num,active)
		if {$name == "active"} { set act "" }
		form_checkbutton $dd "" flexlist($w,$num,$name) "$nr $cn" \
		    $act
	    }
	    entry {
		form_entry $dd flexlist($w,$num,$name) [lindex $c 4] \
		    "$nr $cn" flexlist($w,$num,active)
		if {$focus_func != ""} {
		    bind $dd <FocusIn> "$focus_func $w $num 1"
		    #bind $dd <FocusOut> "$focus_func $w $num 0"
		    bind $dd <Return> "$focus_func $w $num 1"
		}
		if {$width != ""} { $dd configure -width $width }
	    }
	    entry_func {
		form_frame $dd flat 0 "$nr $cn"
		form_entry $dd.e flexlist($w,$num,$name) string \
			{0 0} flexlist($w,$num,active)
		form_menubutton $dd.b "    " "" "0 1 -fill none" flexlist($w,$num,active)
		futil_drop_down_button $dd.b #ffffc0 #ffffa0
		bind $dd.b <ButtonPress-1> [list flexlist_entry_func_get [lindex $c 1] \
			[lindex $c 4] flexlist($w,$num,$name)]
		
		if {$focus_func != ""} {
		    bind $dd <Enter> "$focus_func $w $num 1"
		    #bind $dd <Leave> "$focus_func $w $num 0"
		    bind $dd <Return> "$focus_func $w $num 1"
		}
		if {$width != ""} { $dd configure -width $width }
	    }
	    unitentry {
		set e [model_unitentry $dd flexlist($w,$num,$name) \
			   [lindex $c 4] "$nr $cn" flexlist($w,$num,active) \
			   8 "" 1]
		if {$focus_func != ""} {
		    bind $e <Enter> "$focus_func $w $num 1"
		    #bind $e <Leave> "$focus_func $w $num 0"
		    bind $e <Return> "$focus_func $w $num 1"
		}
		if {$width != ""} {
		    $e configure -width $width
		    $dd.m_units configure -width 2
		}
	    }
	    button {
		set act flexlist($w,$num,active)
		if {$name == "delete"} { set act "" }
		form_button $dd $title [concat $def $w $num] "$nr $cn" $act
	    }
	    choice {
		set opts ""
		foreach o [lindex $c 4] { lappend opts [list $o] }
		form_optionmenu $dd flexlist($w,$num,$name) $opts \
		    "$nr $cn" flexlist($w,$num,active) \
		    "flexlist_option_change $w $num $name"
		set flexlist($w,$num,$name,valscmd) [lindex $c 5]
	    }
	    choice_func {
		set func [lindex $c 4]
		form_optionmenu_dynamic $dd flexlist($w,$num,$name) $func \
		    "$nr $cn" flexlist($w,$num,active)
		set flexlist($w,$num,$name,valscmd) [lindex $c 5]
	    }
	    default { error "unknown column type $c" }
	}
	incr cn 3
	
	lappend vals $name $flexlist($w,$num,$name)
	
	if {$modify_func != ""} {
	    trace variable flexlist($w,$num,$name) w [list path_edit_modify $w $num $name]
	}
    }
    top_set_requested_geo $w
    
    if {$newline_func != ""} {
	eval $newline_func $w $num [list $vals]
    }
}

proc flexlist_entry_func_get {title func var} {
    set val [eval $func \"$title\"]
    if {$val != ""} {
	upvar $var lvar
	set lvar $val
    }
}

proc flexlist_option_change {w num name} {
    global flexlist
    
    set cmd $flexlist($w,$num,$name,valscmd)
    if {$cmd == ""} return
    
    set nval $flexlist($w,$num,$name)
    set res [eval $cmd $w $num $name \"$nval\"]
    foreach {n v} $res {
	set flexlist($w,$num,$n) $v
    }
}

proc flexlist_reset {w num} {
    global flexlist flexlist_units
    
    foreach c $flexlist($w,cols) {
	set name [lindex $c 0]
	set type [lindex $c 2]
	if {$type == "unitentry"} {
	    set flexlist($w,$num,$name) [lindex [lindex $c 3] 0]
	    set flexlist_units($w,$num,$name) [lindex [lindex $c 3] 1]
	} else {
	    if [string match "call_function *" [lindex $c 3]] {
		set already_there ""
		for {set i 0} {$i < $flexlist($w,count) - 1} {incr i} {
		    if [info exists flexlist($w,$i,$name)] {
			lappend already_there $flexlist($w,$i,$name)
		    }
		}
		set func [lrange [lindex $c 3] 1 end]
		if {$func == "__this__"} {
		    flexlist_entry_func_get [lindex $c 1] [lindex $c 4] flexlist($w,$num,$name)
		} else {
		    set flexlist($w,$num,$name) [eval $func \{$already_there\}]
		}
	    } else {
		set flexlist($w,$num,$name) [lindex $c 3]
	    }
	}
    }
}

proc flexlist_delete {func w num} {
    global flexlist
    
    if ![info exists flexlist($w,$num,active)] return
    foreach c $flexlist($w,cols) {
	form_delete $flexlist($w,frame).[lindex $c 0]$num
	form_delete $flexlist($w,frame).[lindex $c 0]${num}_menu
    }
    foreach ff [array names flexlist] {
	if [string match $w,$num,* $ff] {
	    unset flexlist($ff)
	}
    }
    if {$func != ""} {
	eval $func $w $num
    }
}

proc flexlist_clear {func w} {
    global flexlist
    
    for {set i 0} {$i < $flexlist($w,count)} {incr i} {
	flexlist_delete $func $w $i
    }
    set flexlist($w,count) 0
}

proc flexlist_set {w num col val} {
    global flexlist
    set flexlist($w,$num,$col) $val
}

