
# This code is shared by all the ICEM CFD GUI's.
#
# Copyright (c) 1993 - 1995 Pacific Marketing and Consulting, Inc,
#       and ICEM Systems, GmbH.  All rights reserved.
# Author:  Wayne A. Christopher, wayne@icemcfd.com

## <h2>Form creation functions</h2>
## Using these functions it's possible to define forms at a higher level
## than basic Tk widgets.  One creates a <b>form</b>, which is a toplevel
## widget, using <b>form_init</b> and then fills it in using other
## <b>form_</b> functions.<p>
## Most of the functions take the following arguments which will be
## described here and not with the individual function definition.
## <ul>
## <li> <b>w</b> : the widget name for the widget being created.  This
## must be a descendant of the frame that is returned by <b>form_init</b>
## <li> <b>tabdata</b> : this is the row/column specification that is used
## with the grid manager.  The tabdata string is of the form
## <b><i>row column [ options ... ]</i></b> where row and column are
## non-negative integers and the options can be:
## <ul>
## <li> <b>-cols <i>numcols</i></b> : span this many columns
## <li> <b>-rows <i>numrows</i></b> : span this many rows
## <li> <b>-sticky <i>nwes</i></b> : some subset of north, west, east, south,
## to determine the widget alignment
## </ul>
## <li> <b>activedata</b> : this is a list of <i>varname value ...</i> lists
## that determine when the widget is active or disabled.  A trace is put on
## each varname, and whenever the value changes it's checked to see if
## it matches one value in the list.  If all the varnames are okay then the
## widget is enabled, otherwise it is disabled and grayed out.<p>
## The values can be either a regular value, or !value which matches anything
## but the given value.  If no values are given then a non-zero value
## is matched.
## <li> <b>borderwidth</b> : the width of the widget border in pixels.
## <li> <b>relief</b> : the relief of the widget - should be one of
## <b>flat, raised, sunken, ridge, groove</b>
## </ul>

if ![info exists has_blt] { set has_blt 1 }

if ![info exists form_entry_justify_right] {
    set form_entry_justify_right 0
}

if ![info exists auto_raise_forms] {
    set auto_raise_forms 1
}

proc form_fonts {} {
    global default_text_font default_title_font subtitle_font input_font
    global title_font title_color input_background form_gridval
    global input_inactiveb input_inactivef error_background form_background
    global small_screen_hack form_pad form_bw
    
    if [info exists title_font] return
    
    if $small_screen_hack {
	set form_pad 0; set form_bw 1
    } else {
	set form_pad 2; set form_bw 2
    }
    
    if [info exists default_text_font] {
	set subtitle_font $default_text_font
	set input_font $default_text_font
    } else {
	set subtitle_font variable
	set input_font variable
    }
    
    if [info exists default_title_font] {
	set title_font $default_title_font
    } else {
	set title_font variable
    }
    
    set title_color SteelBlue
    set input_background white
    set input_inactiveb white
    set input_inactivef #b0b0b0
    set error_background #ffdddd
    
    # Compute a value for form_gridval, for use by forms that want to set up a
    # regular grid in the X direction.  This should be approximately the width
    # of an M in the subtitle font.
    label .test_label -font $subtitle_font -borderwidth 0 -text MMMMMMMMMM
    set lw [winfo reqwidth .test_label]
    destroy .test_label
    set form_gridval [expr {$lw / 16}]
}

## Create a new toplevel form, or map the window if it's already been
## created.  The arguments are:
## <ul>
## <li> <b>w</b> : this is the name of the toplevel form to create
## <li> <b>title</b> : the window manager title for the window
## <li> <b>class</b> : if non-blank, unmap all windows with this same class
## name
## <li> <b>buttons</b> : a list of button specifications for the row of
## gray buttons at the bottom.  Each spec may be a list with a title and a
## command, or one of the following standard names:
## <ul>
## <li> <b>accept</b> : close the form and return 1 from <b>form_wait</b>
## <li> <b>reset</b> : reset all variables back to their original values
## <li> <b>cancel</b> : close the form, reset the variables, and return 0
## from <b>form_wait</b>
## <li> <b>done</b> : same as accept except for the button label 
## <li> <b>dismiss</b> : same as accept except for the button label 
## <li> <b>close</b> : same as accept except for the button label 
## <li> <b>nl</b> : go to a new row of buttons
## </ul>
## <li> <b>retcmd</b> : the command to run when the user hits return in some
## field where it's not otherwise bound.  The default is to activate the first
## button at the bottom
## <li> <b>map</b> : if 1 map the window, otherwise not.  If 2 then map it and
## don't let it be a transient window
## <li> <b>orien</b> : if 1 then the window will be oriented vertically,
## if 0 horizontally
## </ul>
## The return value of form_init is a frame widget where all further form_
## widgets for this form should be placed.  If it is an empty string this means
## that the form had already been created and you shouldn't add any more
## widgets.

proc form_init {w title {class ""} {buttons ""} {retcmd ""} {map 1} {orien 1} \
		    {resize ""} {dismiss_cmd ""}} {
    global form_done title_font title_color subtitle_font is_win
    global form_inprogress form_finish_commands error_background
    global form_saved_variables form_tablist form_retcmd form_tabdata_hack
    global form_window_class form_generation form_window_generation
    global form_also_withdraw has_blt form_background form_inprogress_start
    global small_screen_hack auto_raise_forms form_pad form_bw
    global form_default_resize form_label_text form_cancel_cmd
    global form_all_transient toplevel env form_dismiss_cmd
    
    if {$resize == ""} {
	if [info exists form_default_resize] {
	    set resize $form_default_resize
	} else {
	    set resize 1
	}
    }
    if ![info exists is_win] {
	proc busy args {}
	set is_win 1
	set small_screen_hack 0
	set has_blt 0
	source bltemu.tcl
    }
    
    set form_dismiss_cmd($w) $dismiss_cmd
    
    if [info exists form_inprogress] {
	if {[info commands clock] != ""} {
	    set ds [expr {[clock seconds] - $form_inprogress_start}]
	    if {$ds > 10} {
		form_kill $form_inprogress
		unset form_inprogress
		mess "Warning: cleared form creation error\n" red
	    } else {
		bell; return ""
	    }
	} else {
	    bell; return ""
	}
    }
    
    if [info exists form_label_text($w)] { set title $form_label_text($w) }
    if [info exists form_label_text($title)] { set title $form_label_text($title) }
    
    if [winfo exists $w] {
	if ![winfo ismapped $w] {
	    set form_also_withdraw($w) ""
	    if {$class != ""} { form_cancel_class $class }
	}
	top_title $w $title
	form_update_saved $w
	form_variables_to_widgets $w
	if $map {
	    top_deiconify $w
	    top_raise $w
	    if $is_win { focus -force $w }
	}
	form_reenable_traces $w
	return ""
    }
    
    set form_inprogress $w
    if {[info commands clock] != ""} {
	set form_inprogress_start [clock seconds]
    }
    
    if ![info exists title_font] form_fonts
    
    if {($buttons == "nobuttons") || ($buttons == "")} {
       top_window $w 0 $title withdraw
    } else {
       top_window $w 0 $title "form_cancel $w" "" 1 1 FakeToplevel "" $resize
    }

    if {[info commands save_under_hack] != ""} { save_under_hack $w }
    
    if {$class != ""} { form_cancel_class $class }
    set form_window_class($w) $class
    set form_also_withdraw($w) ""
    
    if ![info exists form_generation] { set form_generation 1 }
    if {[info exists form_window_generation($w)] &&
	($form_window_generation($w) != $form_generation)} {
	    form_kill $w
	}
    
    busy 1
    
    set form_finish_commands($w) {}
    set form_saved_variables($w) {}
    set form_tablist($w) {}
    set form_tabdata_hack($w) {1 1}
    set form_window_generation($w) $form_generation
    
    #label $w.top -text $title -font $title_font -foreground $title_color
    
    if {$buttons == ""} {
	set buttons "accept reset cancel help"
    } elseif {$buttons == "nobuttons"} {
	set buttons ""
    }

    set button_specs [form_init_buttons $w $buttons]

    if {$retcmd == ""} {
        set form_retcmd($w) [lindex [lindex $button_specs 0] 1]
    } else {
        set form_retcmd($w) $retcmd
    }

    frame $w.main
    set form_background [$w.main cget -background]

    form_init_bottom $w $w.bottom $button_specs

    bind $w <Destroy> "if \{\"%W\" == \"$w\"\} \{form_kill $w\}"

    if $orien {
        pack $w.main -pady $form_pad -side top -fill both -expand 1
        if {$buttons != ""} {
            pack $w.bottom -side top -fill both
        }
    } else {
        pack $w.main -pady $form_pad -side left -fill both -expand 1
        if {$buttons != ""} {
            pack $w.bottom -side right -fill both
        }
    }

    if {[info exists form_all_transient] && $form_all_transient &&
	[info exists toplevel(single)] && !$toplevel(single) &&
	([winfo toplevel $w] == $w) && ($map != 2)} {
        wm transient $w .
    }
    return $w.main
}


proc form_init_buttons {w buttons} {
    global env

    set button_specs ""
    foreach b $buttons {
	if {[llength $b] > 1} {
	    lappend button_specs $b
	} else {
	    switch $b {
		ok {
		    lappend button_specs "Ok \{form_accept_hack $w\}"
		}
		accept {
		    lappend button_specs "Accept \{form_accept_hack $w\}"
		}
		reset {
		    lappend button_specs "Reset  \{form_reset $w\}"
		}
		cancel {
		    lappend button_specs "Cancel \{form_cancel $w\}"
		}
		done {
		    lappend button_specs \
			    "Done \{form_done $w; set form_done_flag($w) 1\}"
		}
		dismiss {
		    lappend button_specs \
			    "Dismiss \{form_done $w; set form_done_flag($w) 1\}"
		}
		close {
		    lappend button_specs \
			    "Close \{form_done $w; set form_done_flag($w) 1\}"
		}
		help {
		    if {([info exists env(ICEM_AI_ENVIRONMENT)]) && 
				($env(ICEM_AI_ENVIRONMENT) == "1")} {
		        set help_proc "Help \{med_context_help $w\}"
		    } else {
		        set help_proc "Help \{help_window_path $w\}"
		    }
		    lappend button_specs \
			    "$help_proc"
		}
		nl { lappend button_specs nl }
		"" {}
		default {
		    error "bad button name $b"
		}
	    }
	}
    }

    return $button_specs
}
    

proc form_init_bottom {w wb button_specs} {
   global small_screen_hack error_background subtitle_font
   global form_cancel_cmd form_bw form_pad

   if $small_screen_hack { set bw 0 } else { set bw 4 }

   frame $wb -relief flat -borderwidth $bw
   label $wb.message -font $subtitle_font \
	-borderwidth $form_bw -relief raised -background $error_background
    
   set nb 0
   set maxw 0
   set colno 0
   set rowno 0
   set buts ""
   foreach but $button_specs {
	if {$but == "nl"} { incr rowno; set colno 0; continue }
	set cols 1
	if {[lindex $but 0] == "__cols__"} {
	    set cols [lindex $but 1]
	    set but [lrange $but 2 end]
	}
	set command [lindex $but 1]
	button $wb.$nb -command $command \
	    -background gray80 -activebackground gray70 \
	    -disabledforeground gray95
	set text [lindex $but 0]
	if [string match "text_variable *" $text] {
	    $wb.$nb configure -textvariable [lindex $text 1]
	} else {
	    $wb.$nb configure -text $text
	}
	lappend buts $nb
	grid $wb.$nb -row $rowno -column $colno -columnspan $cols \
	    -sticky ew -padx $form_pad -pady $form_pad
	set act [lindex $but 2]
	if {$act != ""} {
	    form_doactive $wb.$nb button $act
	}
	set bw [winfo reqwidth $wb.$nb]
	if {$bw > $maxw} { set maxw $bw }
	set b_colno($nb) $colno
	set b_rowno($nb) $rowno
	incr nb; incr colno $cols
	set but_with_lab([lindex $but 0]) $command
	
	if {($text == "Cancel") && ![string match form_cancel* $command]} {
	    set form_cancel_cmd($w) $command
	}
    }
    
    grid_uniform_cols $wb $buts
    
    return $wb
}

proc form_init_sub {w {top ""}} {
    global form_done title_font title_color subtitle_font
    global form_inprogress form_finish_commands error_background
    global form_saved_variables form_tablist form_retcmd form_tabdata_hack
    global form_window_class form_generation form_window_generation
    global form_also_withdraw
    
    if [info exists form_inprogress] { bell; return "" }
    
    if ![info exists title_font] form_fonts
    
    if [winfo exists $w] {
	return ""
    }
    
    set form_inprogress $w
    frame $w
    
    busy 1
    
    set form_finish_commands($w) {}
    set form_saved_variables($w) {}
    set form_tablist($w) {}
    set form_tabdata_hack($w) {1 1}
    
    if {$top != ""} {
	set form_retcmd($w) $form_retcmd($top)
    } else {
	set form_retcmd($w) ""
    }
    
    return $w
}

proc form_invalidate_cache {} {
    global form_generation
    incr form_generation
}

## Create an area on the side of the main form that contains a figure which
## updates as needed depending on the variable.  If no options are given, just
## put a file name instead of the variable.

proc form_side_figure {w var {pref ""} {opts ""}} {
    set w .[lindex [split $w .] 1]
    set fr $w.side_fig
    if {$opts == ""} {
	set im [image create photo -file $var]
	label $fr -image $im
	pack $fr -side right -before $w.main -fill both
	
    } else {
	frame $fr -relief ridge -borderwidth 2
	pack $fr -side right -before $w.main
	set fw 0; set fh 0
	foreach opt $opts {
	    set lab $fr.$opt
	    label $lab
	    set ff $pref$opt.gif
	    if [file exists $ff] {
		set im [image create photo -file $ff]
		$lab configure -image $im
	    }
	    set lw [winfo reqwidth $lab]
	    set lh [winfo reqheight $lab]
	    if {$lw > $fw} { set fw $lw }
	    if {$lh > $fh} { set fh $lh }
	}
	$fr configure -width $fw -height $fh
	pack propagate $fr 0
	
	upvar \#0 $var lvar
	trace variable lvar w "form_side_figure_update $fr $var 0; list"
	form_side_figure_update $fr $var 1
    }
}

proc form_side_figure_update {w var force} {
    upvar \#0 $var lvar
    
    if ![winfo exists $w] return
    if {!$force && ![winfo ismapped $w]} return
    set sub $w.$lvar
    if ![winfo exists $w] return
    foreach s [pack slaves $w] { pack forget $s }
    pack $sub -fill both
}

## Dismiss all forms with the given class except for the one named
## <b>except</b>, if not blank.

proc form_cancel_class {class {except ""}} {
    global form_window_class form_also_withdraw form_done_flag
    global form_dont_cancel_class form_when_cancel_cmd
    
    # All currently mapped windows that have this string as a prefix for their
    # class will get cancelled.
    set nc [llength $class]
    if ![info exists form_window_class] return
    foreach w [array names form_window_class] {
	if {[lsearch $except $w] >= 0} continue
	set wcl $form_window_class($w)
	if {![winfo exists $w] || ![winfo ismapped $w]} continue
	if {($wcl == "") || (($class == "") && \
	    [info exists form_dont_cancel_class([lindex $wcl 0])])} continue
	set okay 1
	for {set i 0} {$i < $nc} {incr i} {
	    if {[lindex $class $i] != [lindex $wcl $i]} {
		set okay 0
		break
	    }
	}
	if $okay {
	    if [info exists form_when_cancel_cmd($w)] {
		uplevel \#0 $form_when_cancel_cmd($w)
	    } else {
		top_withdraw $w
	    }
	    if [info exists form_also_withdraw($w)] {
		foreach ww $form_also_withdraw($w) {
		    top_withdraw $ww
		}
	    }
	    # set form_done_flag($w) 1 ??
	    set form_done_flag($w) 0
	}
    }
}

## Dismiss all forms.

proc form_cancel_all {except} {
    global form_window_class form_also_withdraw form_done_flag
    global form_dont_cancel_class
    
    if ![info exists form_window_class] return
    foreach w [array names form_window_class] {
	if {![winfo exists $w] || ![winfo ismapped $w]} continue
	set save 0
	foreach ex $except {
	    if [string match $ex $w] { set save 1; break }
	}
	if $save continue
	
	top_withdraw $w
	foreach ww $form_also_withdraw($w) { top_withdraw $ww }
	# set form_done_flag($w) 1 ??
	set form_done_flag($w) 0
    }
}

## What forms in this class are visible?

proc form_check_visible_class {class} {
    global form_window_class form_also_withdraw form_done_flag
    global form_dont_cancel_class
    
    set vis ""
    
    set nc [llength $class]
    foreach w [array names form_window_class] {
	set wcl $form_window_class($w)
	if {![winfo exists $w] || ![winfo ismapped $w]} continue
	if {$wcl == ""} continue
	set okay 1
	for {set i 0} {$i < $nc} {incr i} {
	    if {[lindex $class $i] != [lindex $wcl $i]} {
		set okay 0
		break
	    }
	}
	if $okay {
	    lappend vis $w
	}
    }
    return $vis
}

proc form_subgeo {form but} {
    set x [expr {[winfo rootx $form] + [winfo width $form]}]
    set y [winfo rooty $but]
    return +$x+$y
}

proc form_accept_hack {w} {
    global form_done_flag

    if [form_check_values $w] {
	form_widgets_to_variables $w
	form_done $w
	set form_done_flag($w) 1
    }
}

proc form_update_saved {w} {
    global form_saved form_saved_variables
    
    if ![info exists form_saved_variables($w)] {
	error "form_saved_variables($w) doesn't exist - array get is [array get form_saved_variables], winfo exists = [winfo exists $w]"
    }
    foreach var $form_saved_variables($w) {
	global [lindex [split $var "("] 0]
	if [ info exists $var ] {
		set form_saved($w,$var) [set $var]
	}
    }
}

proc form_reset {w} {
    global form_saved form_saved_variables form_saved_set

    if ![info exist form_saved_variables($w)] return

    foreach var $form_saved_variables($w) {
	global [lindex [split $var "("] 0]
	set oval $form_saved($w,$var)
	set $var $oval
	foreach cmd $form_saved_set($w,$var) {
	    catch "$cmd \{$oval\}"
	}
    }
}

proc form_cancel {w} {
    global form_done_flag form_cancel_cmd
    
    if ![winfo exists $w] { return 0 }
    
    if [info exists form_cancel_cmd($w)] {
	eval $form_cancel_cmd($w)
    } else {
	form_reset $w
	form_done $w
	set form_done_flag($w) 0
    }
    return 0 ;# that means don't delete the window to the toplevel.tcl code
}

## After the form creation has been completed using <b>form_finish</b>,
## this function can be called which will do a tkwait and return only when
## the form has been dismissed.  It returns 1 if the accept button has been
## pressed and 0 if cancel has been pressed.  If use_grab specified as 1,
## then proc will prevent interaction with any other widget until
## interaction with this form is complete

proc form_wait {w {use_grab 0}} {
    global form_done_flag
    
    set oldgrab [grab current $w]
    if {$oldgrab != ""} {
	# This might be the interrupt button
	grab release $oldgrab
    }
    
    if {$use_grab == 1} {
	set oldfocus [focus]
	focus $w
	grab $w
    } else {
	set oldfocus ""
    }
    
    set ob [busy reset]
    tkwait variable form_done_flag($w)
    if {$ob == "1"} { busy $ob }
    
    if {$oldfocus != ""} {
	grab release $w
	focus $oldfocus
    }
    if {$oldgrab != ""} {
	grab $oldgrab
    }
    
    return $form_done_flag($w)
}

# These two routines copy values from the variables into the widgets, and back.
# Note that the widgets to variables operation is only necessary for entry and
# text widgets.  Here is a work-a-round -- we "know" that the second word of each get
# command is a widget name.  Check to see if each is mapped before doing
# the stuff.

proc form_winmapped {w} {
    if {![winfo exists $w] || ![winfo ismapped $w]} { return 0 }
    set w [winfo parent $w]
    if {$w == "."} {
	return 1
    } else {
	return [form_winmapped $w]
    }
}

proc form_widgets_to_variables {w} {
    global form_saved form_saved_variables form_saved_get
    
    foreach var $form_saved_variables($w) {
	global [lindex [split $var "("] 0]
	foreach cmd $form_saved_get($w,$var) {
	    set wid [lindex $cmd 1]
	    if ![form_winmapped $wid] continue
	    set val [eval $cmd]
	    set $var $val
	}
    }
}

proc form_variables_to_widgets {w} {
    global form_saved_variables form_saved_set
    
    foreach var $form_saved_variables($w) {
	global [lindex [split $var "("] 0]
	if ![catch {set $var} nval] {
	    foreach cmd $form_saved_set($w,$var) {
		catch "$cmd \{$nval\}"
	    }
	}
    }
}

## Make the form go away (withdraw it).

proc form_done {w {flag 1}} {
    global form_window_class form_done_flag form_also_withdraw
    global select_action form_dismiss_cmd

    if {[info exist form_window_class($w)] && \
             ($form_window_class($w) != "")} {
	form_cancel_class $form_window_class($w)
    } else {
	top_withdraw $w
	foreach ww $form_also_withdraw($w) {
	    if [winfo exists $ww] { top_withdraw $ww }
	}
	set form_done_flag($w) $flag
    }
    set select_action cancel
    
    if {[info exists form_dismiss_cmd($w)] && ($form_dismiss_cmd($w) != "")} {
	eval $form_dismiss_cmd($w) $w
    }
    
    update idle
}

## Destroy the form if it has been created.  The next time form_init is 
## called then it will return a subwindow name so the form can be recreated
## from scratch.

proc form_kill {w} {
    global form_finish_commands form_saved_variables
    global form_saved form_saved_get form_saved_set
    global form_window_class form_last_position form_inprogress
    global batch_mode
    
    if $batch_mode return
    
    # If this window is being created don't destroy it.  This can happen
    # when people double-click too fast on certain items
    if [info exists form_inprogress] { bell; return }
    
    if [winfo exists $w] {
	set form_last_position($w) [list [winfo x $w] [winfo y $w]]
    }
    
    if [info exists form_finish_commands($w)] {
	foreach com $form_finish_commands($w) { eval $com }
	unset form_finish_commands($w)
    }
    if [info exists form_saved_variables($w)] {
	foreach var $form_saved_variables($w) {
	    unset form_saved($w,$var)
	    unset form_saved_get($w,$var)
	    unset form_saved_set($w,$var)
	}
	unset form_saved_variables($w)
    }
    if [catch {top_destroy $w 1} res] {
	# I don't know how this can happen 
	global errorInfo
	puts "ERROR: form_kill: $res\n$errorInfo"
	puts "\nplease tell wayne about this"
	catch {destroy $w}
    }
}

# Usually we don't want autoraise

## This function should be called when the subwindows have all been created,
## and the form is ready to map.  The arguments are:
## <ul>
## <li> <b>geo</b> : the geometry in <b>wm geometry</b> format.  Also
## <b>bot</b> means the lower-left hand corner and <b>top</b> is the
## upper right-hand corner.
## <li> <b>map</b> : if 1 then map the window.  If 0 then keep it unmapped.
## <li> <b>autoraise</b> : if 1 then any time this window goes behind another
## it will try to jump to the front.  Precautions are taken to prevent 
## fighting between two autoraise forms.
## </ul>

proc form_finish {{geo "-0-0"} {map 1} {autoraise 0}} {
    global form_inprogress
    
    # Maybe this was called in error
    if ![info exists form_inprogress] return
    
    if {[winfo parent $form_inprogress] == "."} {
	# This handles all mouse clicks on buttons that would
	# create another form.
	form_setgeometry $form_inprogress $geo $map $autoraise
    }
    busy 0
    
    # It's possible the user might have double-clicked on something and so
    # two forms got created at once.  If that happened it would have gone
    # through during the update in form_setgeometry.  Just be paranoid here.
    catch { unset form_inprogress }
}

proc form_ensure_big_enough {w} {
    # In case this form has expanded let's do something about that
    set cw [winfo width $w]
    set ch [winfo height $w]
    set rw [winfo reqwidth $w]
    set rh [winfo reqheight $w]
    set mod 0
    if {$rw > $cw} { set cw $rw; set mod 1 }
    if {$rh > $ch} { set ch $rh; set mod 1 }
    if $mod { top_geometry $w ${cw}x${ch}; top_make_on_screen $w }
}

proc form_setgeometry {w geo {map 1} {autoraise 1}} {
    global is_win tcl_version botform_geo topform_geo toplevel
    global form_last_position
    
    switch -- $geo {
	bot { set geo $botform_geo }
	top { set geo $topform_geo }
	middle {
	    update idletasks
	    set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
		       - [winfo vrootx [winfo parent $w]]]
	    set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
		       - [winfo vrooty [winfo parent $w]]]
	    set geo +$x+$y
	}
    }
    
    if [info exists form_last_position($w)] {
	set g $form_last_position($w)
	set geo "+[lindex $g 0]+[lindex $g 1]"
	unset form_last_position($w)
    }
    
    if {($is_win && ($tcl_version >= 8.0)) || $toplevel(single)} {
	top_geometry $w $geo
	if $map { top_deiconify $w }
	update
	top_geometry $w $geo
    } else {
	update
	top_geometry $w $geo
	if $map { top_deiconify $w }
    }
    top_make_on_screen $w
    if $autoraise {
	form_auto_raise $w
    }
}

proc form_settitle {w title} {
    top_title $w $title
}

proc form_check_values {form {multiple 0}} {
    global form_tablist
    
    set okay 1
    foreach ent $form_tablist($form) {
	if ![form_winmapped $ent] continue
	if {[lindex [$ent configure -state] 4] != "normal"} continue
	if {!$multiple || [$ent get] != "" } { 
	    if ![form_entry_check $ent] { set okay 0 }
	}
    }
    if $okay {
	return 1
    } else {
	form_warning $form "Please correct the indicated fields." 2000
	return 0
    }
}

proc form_warning {form text {delay 0} {ifclick ""}} {
    global error_background
    
    $form.bottom.message configure -text $text
    raise $form.bottom.message 
    place $form.bottom.message -rely 0 -rely 0 -anchor nw \
	    -relwidth 1 -relheight 1
    
    bind $form.bottom.message <Button-1> $ifclick
    
    if $delay {
	after $delay "form_warning_dismiss $form"
    }
}

proc form_warning_dismiss {form} {
    catch {place forget $form.bottom.message}
}

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

proc form_add_save {var {get ""} {set ""} {w ""}} {
    global form_inprogress form_saved form_saved_variables
    global form_saved_get form_saved_set
    global [lindex [split $var "("] 0]
    
    if ![info exists $var] return
    
    if {$w == ""} {
	# Don't allow reset if we do this after form_done is called.
	if ![info exists form_inprogress] return
	set w $form_inprogress
    }
    
    set form_saved($w,$var) [set $var]
    if {![info exists form_saved_variables($w)] || \
	    ([lsearch $form_saved_variables($w) $var] < 0)} {
	lappend form_saved_variables($w) $var
    }
    if {$get != ""} {
	lappend form_saved_get($w,$var) $get
    } elseif ![info exists form_saved_get($w,$var)] {
	set form_saved_get($w,$var) ""
    }
    if {$set != ""} {
	lappend form_saved_set($w,$var) $set
    } elseif ![info exists form_saved_set($w,$var)] {
	set form_saved_set($w,$var) ""
    }
}

# This one sets up traces for the old-style activedata expressions (i.e. a
# list of disjunctions)

proc form_trace_active {w type var vals {menu_item ""}} {
    global form_inprogress form_finish_commands form_traces
    global form_traces_toplevel form_window_generation
    global form_traces_delete
    set varn [lindex [split $var "("] 0]; global $varn
    
    if [info exists form_inprogress] {
	set top $form_inprogress
    } else {
	set top $w
	while {$top != "."} {
	    if [info exists form_window_generation($top)] break
	    set top [winfo parent $top]
	}
	if {$top == ""} return
    }
    
    if ![winfo exists $w] {
        error "Trace active: no such widget $w"
    }
    if [string match !* $var] {
	set var [string range $var 1 end]
	set vals 0
    }
    if {($var != "0") && ($var != "1") && ($var != "or") && \
	    ![info exists $var]} {
	#error "Trace active: no such variable $var"
	set $var 1  ;# ??
    }
    
    if {$menu_item == ""} {
	lappend form_traces($w) "$var $vals"
    } else {
	lappend form_traces($w,$menu_item) "$var $vals"
    }
    set trace "form_setstate \"$w\" $type $menu_item; list"
    lappend form_traces_toplevel($top) [list $var $trace]
    if {($var != "0") && ($var != "1") && ($var != "or")} {
	trace variable $var w $trace
	set vdel "global $varn form_traces ;\
		trace vdelete \{$var\} w \{$trace\}"
	lappend form_finish_commands($top) $vdel
	set form_traces_delete($w) $vdel
	form_setstate $w $type $menu_item
    }
}

# This is the new style trace-applying code

proc form_trace_active_expr {w type activedata {menu_item ""} {top ""}} {
    global form_inprogress form_finish_commands form_traces
    global form_traces_toplevel form_window_generation
    global form_traces_delete
    
    if {$top == ""} {
	if [info exists form_inprogress] {
	    set top $form_inprogress
	} else {
	    set top $w
	    while {$top != "."} {
		if [info exists form_window_generation($top)] break
		set top [winfo parent $top]
	    }
	    if {$top == ""} return
	}
	if ![winfo exists $w] {
	    error "Trace active: no such widget $w"
	}
    }
    
    set var [lindex $activedata 0]
    switch $var {
	and - or {
	    foreach sub [lrange $activedata 1 end] {
		form_trace_active_expr $w $type $sub $menu_item $top
	    }
	}
	0 - 1 {
	}
	default {
	    if [string match !* $var] {
		set var [string range $var 1 end]
		set vals 0
	    }
	    set varn [lindex [split $var "("] 0]; global $varn
	    if ![info exists $var] { set $var 1 }
	    
	    set trace "form_setstate_expr \"$w\" $type $menu_item; list"
	    lappend form_traces_toplevel($top) [list $var $trace]
	    trace variable $var w $trace
	    set vdel "global $varn form_traces ;\
		trace vdelete $var w \{$trace\}"
	    lappend form_finish_commands($top) $vdel
	    set form_traces_delete($w) $vdel
	    form_setstate_expr $w $type $menu_item
	}
    }
}

proc form_active_extract_depends {activedata} {
    switch [lindex $activedata 0] {
	and - or {
	    set deps [form_active_extract_depends_new $activedata]
	}
	default {
	    set deps [form_active_extract_depends_old $activedata]
	}
    }
    foreach d $deps { set got($d) 1 }
    return [array names got]
}

proc form_active_extract_depends_new {activedata} {
    set deps ""
    set var [lindex $activedata 0]
    switch $var {
	and - or {
	    foreach sub [lrange $activedata 1 end] {
		set deps [concat $deps [form_active_extract_depends_new $sub]]
	    }
	}
	default {
	    if [string match !* $var] {
		set var [string range $var 1 end]
	    }
	    lappend deps $var
	}
    }
    return $deps
}

proc form_active_extract_depends_old {activedata} {
    set deps ""
    foreach vv $activedata {
	set var [lindex $vv 0]
	if [string match !* $var] {
	    set var [string range $var 1 end]
	}
	lappend deps $var
    }
    return $deps
}

# Since the last time we put this form up the variables used in the
# trace active stuff might have been unset.  Reenable them.

proc form_reenable_traces {w} {
    global form_traces_toplevel
    
    if [info exists form_traces_toplevel($w)] {
	foreach tr $form_traces_toplevel($w) {
	    form_reenable_trace_one [lindex $tr 0] [lindex $tr 1]
	}
    }
}

proc form_reenable_trace_one {var trace} {
    upvar \#0 $var lvar
    set vi [trace vinfo lvar]
    set okay 0
    foreach vv $vi {
	if {$vv == [list w $trace]} {
	    #puts "don't need to add trace: $var $trace"
	    return
	}
    }
    #puts "need to add trace: $var $trace"
    trace variable lvar w $trace
}

proc form_setstate {w type {menu_item ""}} {
    global form_traces
    
    if ![winfo exists $w] return
    
    if {$menu_item != ""} {
	form_${type}_setstate $w \
	    [form_checkstate $form_traces($w,$menu_item)] $menu_item
    } else {
	form_${type}_setstate $w [form_checkstate $form_traces($w)]
    }
}

proc form_setstate_expr {w type {menu_item ""}} {
    global form_traces
    
    if ![winfo exists $w] return
    
    if {$menu_item != ""} {
	form_${type}_setstate $w \
	    [form_checkstate_expr $form_traces($w,$menu_item)] $menu_item
    } else {
	form_${type}_setstate $w [form_checkstate_expr $form_traces($w)]
    }
}

proc form_checkstate {data} {
    global expression_dont_ask_if_undef
    
    set okay 1
    set do_or 0
    foreach i $data {
	set var [lindex $i 0]
	if {$var == 0} {
	    set okay 0
	    break
	} elseif {$var == 1} {
	    # set okay 1
	    # break
	} elseif {$var == "or"} {
	    set do_or 1
	    set okay 0
	} else {
	    set vals [lrange $i 1 end]
	    global [lindex [split $var \(] 0]
	    # It might somehow be undefined ...
	    if [catch {set $var} cur] continue
	    
	    set expression_dont_ask_if_undef 1
	    catch {set cur [expression_evaluate $cur]}
	    unset expression_dont_ask_if_undef
	    
	    set this_ok 0
	    if {$vals == ""} {
		set this_ok [expr {($cur != "") && ($cur != 0)}]
	    } else {
		foreach val $vals {
		    if [string match !* $val] {
			if {$cur != [string range $val 1 end]} { set this_ok 1 }
		    } else {
			if {$cur == $val} { set this_ok 1 }
		    }
		}
	    }
	    if $do_or {
		if $this_ok { set okay 1; break }
	    } else {
		if !$this_ok { set okay 0; break }
	    }
	}
    }
    return $okay
}

proc form_checkstate_expr {data} {
    switch [lindex $data 0] {
	and {
	    foreach sub [lrange $data 1 end] {
		if ![form_checkstate_expr $sub] { return 0 }
	    }
	    return 1
	}
	or {
	    foreach sub [lrange $data 1 end] {
		if [form_checkstate_expr $sub] { return 1 }
	    }
	    return 0
	}
	0 - 1 { return $data }
	default {
	    set var [lindex $data 0]
	    set vals [lrange $data 1 end]
	    if [string match !* $var] {
		set var [string range $var 1 end]
		set vals 0
	    }
	    upvar \#0 $var lvar
	    if ![info exists lvar] { return 0 }
	    if {$vals == ""} {
		return [expr {($lvar != "") && ($lvar != "0")}]
	    } else {
		foreach val $vals {
		    if [string match !* $val] {
			if {$lvar != [string range $val 1 end]} { return 1 }
		    } else {
			if {$lvar == $val} { return 1 }
		    }
		}
		return 0
	    }
	}
    }
}

proc form_active_replace_varnames {data mapping {val_mapping ""}} {
    switch [lindex $data 0] {
	and - or - 0 - 1 {
	    set ret [lindex $data 0]
	    foreach sub [lrange $data 1 end] {
		lappend ret [form_active_replace_varnames [list $sub] \
				 $mapping $val_mapping]
	    }
	    return $ret
	}
	default {
	    foreach sub $data {
		switch [lindex $sub 0] {
		    and - or - 0 - 1 {
			set ret [lindex $sub 0]
			foreach sub2 [lrange $sub 1 end] {
			    lappend ret [form_active_replace_varnames \
					     [list $sub2] $mapping \
					     $val_mapping]
			}
		    }
		    default {
			set var [lindex $sub 0]
			set vals [lrange $sub 1 end]
			if [string match !* $var] {
			    set var [string range $var 1 end]
			    set vals 0
			}
			array set map $mapping
			set var_before $var
			if [info exists map($var)] {
			    set var $map($var)
			} elseif {[string match param_values* $var]} {
			    # This shouldn't be here but it's hard to do 
			    # otherwise
			    set vname [lindex [split $var ()] 1]
			    set var param_edit(val,$vname)
			    
			    global param_edit param_values
			    if ![info exists param_edit(val,$vname)] {
				set param_edit(val,$vname) $param_values($vname) 
			    }
			}
			foreach {n chl} $val_mapping {
			    if {$n == [lindex [split $var :] end]} {
				catch {unset vmap}
				foreach {tn} $chl { set vmap([lindex $tn 0]) [lindex $tn 1] }
				set vals2 ""
				foreach v $vals {
				    if [info exists vmap($v)] { set v $vmap($v) }
				    lappend vals2 $v
				}
				set vals $vals2
				break
			    }
			}
			if [info exists ret] {
			    lappend ret [concat [list $var] $vals]
			} else {
			    set ret and
			    lappend ret [concat [list $var] $vals]
			}
		    }
		}
	    }
	    return $ret
	}
    }
}

proc form_active_concat_and {c1 c2} {
    if {$c2 == ""} { return $c1 }
    switch [lindex $c1 0] {
	and - or {
	    return [list and $c1 $c2]
	}
	default {
	    if {[llength $c1] == 1} {
		return [list and [lindex $c1 0] $c2]
	    } else {
		puts "ERROR: can't concat $c1 and $c2"
		return ""
	    }
	}
    }
}

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

proc form_dotab {w tabdata stick} {
    global small_screen_hack
    
    set parent [winfo parent $w]
    
    if {$tabdata == {}} return
    
    if {$tabdata == "forget"} {
	grid forget $w
	return
    }
    
    set row [lindex $tabdata 0]
    set col [lindex $tabdata 1]
    if $small_screen_hack {
	set options {-padx 0}
    } else {
	set options {-padx 3}
    }
	
    set len [llength $tabdata]
    set fillgrid 0
    foreach {name value} [lrange $tabdata 2 end] {
	switch -- $name {
	    -rows {
		if {$value == "-"} {set value 10}
		lappend options -rowspan $value
	    }
	    -cols {
		if {$value == "-"} {set value 10}
		lappend options -columnspan $value
	    }
	    -fill {
		switch $value {
		    none { set stick "" }
		    both { set stick "nwes" }
		    x { set stick "ew" }
		    y { set stick "ns" }
		}
	    }
	    -anchor { append stick $value }
	    -sticky { set stick $value }
	    -fillgrid { set fillgrid $value }
	    default {
		lappend options $name $value
	    }
	}
    }
#    puts "grid $w -row $row -column $col -sticky \"$stick\" $options"
    eval grid $w -row $row -column $col -sticky \"$stick\" $options
    set par [winfo parent $w]
    switch [winfo class $w] {
	Entry {
	    grid columnconfigure $par $col -weight 1
	}
	Text - Listbox - Frame {
	    grid columnconfigure $par $col -weight 1
	    grid rowconfigure $par $row -weight 1
	}
    }
    if $fillgrid {
	grid rowconfigure $par $row -weight 1000000
	grid columnconfigure $par $col -weight 1000000
    }
}

proc form_delete {w {destroy 1}} {
    global form_entry_datatype form_entry_var form_traces form_traces_toplevel
    global form_traces_delete form_active_blank
    
    if $destroy { catch {top_destroy $w} }
    catch {unset form_entry_var($w)}
    catch {unset form_entry_datatype($w)}
    catch {unset form_active_blank($w)}
    catch {unset form_traces($w)}
    if [info exists form_traces_delete($w)] {
	eval $form_traces_delete($w)
	unset form_traces_delete($w)
    }
}

proc form_unmap {w} {
    global form_map_info has_blt
    
    catch {
	if $has_blt {
	    set form_map_info($w) [blt_table info $w]
	    blt_table forget $w
	} else {
	    set form_map_info($w) [grid info $w]
	    grid forget $w
	}
    }
}

proc form_map {w} {
    global form_map_info has_blt
    
    if $has_blt {
	eval blt_table [winfo parent $w] $form_map_info($w)
    } else {
	eval grid $w $form_map_info($w)
    }
	
    unset form_map_info($w)
}

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

## Make the width of the given column in the form be <b>width</b>.  If
## <b>units</b> is non-empty then the width will be taken to be character
## widths, otherwise it will be considered pixels.

proc form_colwidth {w num width {units ""}} {
    global form_gridval has_blt
    
    if {$units != ""} { set width [expr {$width * $form_gridval}] }
    if $has_blt {
	blt_table_column $w configure $num -width $width
    } else {
	grid columnconfigure $w $num -minsize $width -weight 0
    }
}

## Make the height of the given row in the form be <b>height</b>.

proc form_rowheight {w num height} {
    global has_blt
    
    if {$w == ""} error
    
    if $has_blt {
	blt_table_row $w configure $num -height $height
    } else {
	grid rowconfigure $w $num -minsize $height -weight 0
    }
}

proc form_doactive {w type activedata {menu_item ""}} {
    global form_traces form_active_blank form_inprogress
    
    # We allow widgets to be added after form_finish but they can't use
    # active stuff.  -- Not quite .......
    # if ![info exists form_inprogress] return

    catch {unset form_traces($w)}
    catch {unset form_active_blank($w)}

    if {[lindex $activedata 0] == "-blank"} {
	set form_active_blank($w) 1
	set activedata [lrange $activedata 1 end]
    }
    switch [lindex $activedata 0] {
	and - or {
	    if {$menu_item == ""} {
		set form_traces($w) $activedata
	    } else {
		set form_traces($w,$menu_item) $activedata
	    }
	    form_trace_active_expr $w $type $activedata $menu_item
	}
	default {
	    foreach a $activedata {
		if {$a == "0"} {
		    form_${type}_setstate $w 0
		    return
		} elseif {$a != ""} {
		    if [string match !* $a] {
			set a [list [string range $a 1 end] 0]
		    }
		    form_trace_active $w $type [lindex $a 0] \
			[lrange $a 1 end] $menu_item
		}
	    }
	}
    }
}

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

## Create a canvas widget.  <b>geo</b> is of the form
## <i>width</i><b>x</b><i>height</i> and gives the size of the canvas.
## If <b>xs</b> or <b>ys</b> is 1 then an X or Y scrollbar, respectively,
## is created.

proc form_canvas {w geo relief borderwidth tabdata {xs 1} {ys 1}} {
    global input_background
    
    ScrolledWindow $w -relief $relief -borderwidth $borderwidth
    canvas $w.c -relief flat -borderwidth 0 -background $input_background
    if {$geo != ""} {
	set xx [split $geo x]
	$w.c configure -width [lindex $xx 0] -height [lindex $xx 1]
    }
    $w setwidget $w.c
    form_dotab $w $tabdata news
    return $w.c
}

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

## Create a table widget

proc form_table {w coltitles variable relief borderwidth cellw tabdata \
		 {xs 1} {ys 1} {nrows 1}} {
    global input_background form_table_data boldfont
    
    ScrolledWindow $w -relief $relief -borderwidth $borderwidth
    table $w.t \
	-anchor center \
	-rows $nrows \
	-cols [llength [lindex $coltitles 0]] \
	-variable $variable \
	-titlerows [llength $coltitles] \
	-titlecols 0 \
	-roworigin 0 \
	-rowstretchmode none -colstretch unset \
	-bg $input_background \
	-selectmode extended \
	-resizeborders col \
	-sparsearray 0 \
	-multiline 0 \
	-validate 0 \
	-autoclear 0 \
	-colwidth $cellw
    $w setwidget $w.t
    form_dotab $w $tabdata news
    set form_table_data(var,$w) $variable
    set form_table_data(nrows,$w) 0
    foreach ct $coltitles {
	form_table_addrow $w $ct "" 0
    }
    $w.t tag configure title -font $boldfont -fg black -bg \#ccc
    if 0 {
	trying to figure out how to do thick column borders
	if {[llength $coltitles] > 1} {
	    set r1 [lindex $coltitles 0]
	    for {set c 1} {$c < [llength $r1]} {incr c} {
		if {[lindex $r1 $c] != "."} {
		}
	    }
	}
    }
    form_table_fixwidths $w
    return $w.t
}

proc form_table_addrow {w vals {row ""} {fixw 1}} {
    global form_table_data
    upvar \#0 $form_table_data(var,$w) lvar
    if {$row == ""} {
	set row $form_table_data(nrows,$w)
	incr form_table_data(nrows,$w)
	$w.t insert rows -keeptitles -- $row 1
    } else {
	while {$row > $form_table_data(nrows,$w)} {
	    $w.t insert rows -keeptitles -- $row 1
	    incr form_table_data(nrows,$w)
	}
    }
    set i 0
    set previ -1
    foreach v $vals {
	if {$v != ""} {
	    if {$v == "."} {
		$w.t spans $row,$previ 0,[expr $i - $previ]
		set lvar($row,$i) ""
	    } else {
		set lvar($row,$i) $v
		set previ $i
	    }
	}
	incr i
    }
    if $fixw {
	form_table_fixwidths $w
    }
}

proc form_table_fixwidths {w} {
    global form_table_data
    upvar \#0 $form_table_data(var,$w) lvar
    set font0 [$w.t tag cget title -font]
    set font1 [$w.t cget -font]
    for {set c 0} {$c < [$w.t cget -cols]} {incr c} {
	set cw 20
	for {set r 0} {$r < [$w.t cget -rows]} {incr r} {
	    if ![info exists lvar($r,$c)] continue
	    foreach line [split $lvar($r,$c) \n] {
		if $c {
		    set sw [font measure $font1 $line]
		} else {
		    set sw [font measure $font0 $line]
		}
	    }
	    if {$sw > $cw} { set cw $sw }
	}
	incr cw 4
	$w.t width $c -$cw
    }
}

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

## Create a listbox widget.  The arguments are:
## <ul>
## <li> <b>title</b> : a string to put at the top of the listbox
## <li> <b>items</b> : a list of items which go in the listbox initially
## <li> <b>click_cmd</b> : if nonempty, a command which gets bound to a
## single left mouse click in the listbox.  The item is appended to the
## command unless <b>call_with_index</b> is set in which case the index
## of the item is used instead.
## <li> <b>dclick_cmd</b> : if nonempty, a command which gets bound to a
## double left mouse click in the listbox.  The item is appended to the
## command unless <b>d_call_with_index</b> is set in which case the index
## of the item is used instead.
## <li> <b>geo</b> : the value is of the form
## <i>width</i><b>x</b><i>height</i> and gives the size of the listbox
## <li> <b>multi_select</b> : if this is 1 then it will be possible to 
## select more than one item at once, and the <b>click_cmd</b> and
## <b>dclick_cmd</b> functions will be called with a list of items rather
## than just one.
## </ul>

proc form_listbox {w title items click_cmd dclick_cmd geo \
		       tabdata {activedata ""} \
		       {call_with_index 0} {d_call_with_index 0} \
		       {multi_select 0} {xscroll 0}} {
    global subtitle_font input_font input_background form_label_text form_bw
    
    if [info exists form_label_text($w)] { set title $form_label_text($w) }
    if [info exists form_label_text($title)] { set title $form_label_text($title) }
    
    frame $w
    if {$title != ""} {
	label $w.title -text $title
    }
    if $xscroll {
        listbox $w.list -relief sunken -borderwidth $form_bw -yscroll "$w.scroll set" \
	    -background $input_background -exportselection 0 -foreground black \
            -xscroll "$w.xscroll set"
    } else {  
        listbox $w.list -relief sunken -borderwidth $form_bw -yscroll "$w.scroll set" \
	    -background $input_background -exportselection 0 -foreground black
    }
    if $multi_select { $w.list configure -selectmode multiple }
    
    if {$geo != ""} {
	set xx [split $geo x]
	$w.list configure -width [lindex $xx 0] -height [lindex $xx 1]
    }
    scrollbar $w.scroll -command "$w.list yview"
    if $xscroll {
	scrollbar $w.xscroll -command "$w.list xview" -orient horizontal
    }
    if {$title != ""} {pack append $w $w.title {top frame w}}
    if $xscroll {
        pack append $w \
	    $w.scroll {right filly} \
            $w.xscroll {bottom fillx} \
            $w.list {left fill expand}
    } else {
        pack append $w \
	    $w.list {left fill expand} \
	    $w.scroll {left fill}
    }
    foreach i $items {
	$w.list insert end $i
    }
    if {$click_cmd != ""} {
	bind $w.list <Button-1> \
		"form_listbox_action $w $multi_select %y \
		\{$click_cmd\} $call_with_index; break"
	bind <Button1-Motion> $w.list break
	bind <ButtonRelease-1> $w.list break
	
    }
    if {$dclick_cmd != ""} {
	bind $w.list <Double-Button-1> \
		"form_listbox_action $w 0 %y \
		\{$dclick_cmd\} $d_call_with_index; break"
    }
    form_dotab $w "$tabdata -fill both" news
    form_doactive $w listbox $activedata
}

proc form_listbox_action {w multi y com call_with_index} {
    set choice [$w.list nearest $y]

    if $multi {
	if [$w.list selection includes $choice] {
	    $w.list selection clear $choice
	} else {
	    $w.list selection set $choice
	}
    } else {
	$w.list selection clear 0 end
	$w.list selection set $choice
	
    }
    if $call_with_index {
	uplevel #0 eval $com $choice
    } else {
	uplevel #0 eval $com \{\{[$w.list get $choice]\}\}
    }
}

## Add the item to the end of the listbox, unless it is already there

proc form_listbox_add {w item} {
    for {set i 0} {$i < [$w.list size]} {incr i} {
	if {[$w.list get $i] == $item} return
    }
    $w.list insert end $item
}

## Add the item to the end of the listbox, whether it is there or not

proc form_listbox_add_dup {w item} {
    $w.list insert end $item
}

## Delete the item from the listbox.  This returns the item right after
## the deleted one or before if it was the last

proc form_listbox_delete {w item} {
    set lastd 0
    for {set i 0} {$i < [$w.list size]} {incr i} {
	if {[$w.list get $i] == $item} {
	    $w.list delete $i
	    set lastd $i
	}
    }
    if {$lastd < [$w.list size]} {
	return [$w.list get $lastd]
    } else {
	return [$w.list get [expr [$w.list size] - 1]]
    }
}

## Delete the item at the specified position in the listbox

proc form_listbox_delete_index {w pos} {
    $w.list delete $pos
}

## Change the item <b>old</b> to <b>new</b>

proc form_listbox_change {w old new} {
    for {set i 0} {$i < [$w.list size]} {incr i} {
	if {[$w.list get $i] == $old} {
	    $w.list delete $i; $w.list insert $i $new
	}
    }
}

## Make the given item be the currently selected one

proc form_listbox_select {w item {glob 0}} {
    if {$item != ""} {
	for {set i 0} {$i < [$w.list size]} {incr i} {
	    if {(!$glob && ([$w.list get $i] == $item)) ||
		($glob && [string match $item [$w.list get $i]])} {
		form_listbox_select_index $w $i
		return
	    }
	}
    }
    $w.list select clear 0 end
}

## Make the item at the given position be the currently selected one

proc form_listbox_select_index {w pos} {
    if {$pos >= [$w.list size]} {
 	$w.list select clear 0 end
	return 0
    }
    $w.list see $pos
    $w.list selection clear 0 end
    $w.list selection set $pos
    return 1
}

## Return the index of the currently selected item

proc form_listbox_get_select_index {w} {
    return [$w.list curselection]
}

## Return the value of the currently selected item

proc form_listbox_get_selected {w} {
    set s [$w.list curselection]
    if {$s == ""} { return "" }
    if {[$w.list cget -selectmode] == "multiple"} {
	set ret ""
	foreach s1 $s {
	    lappend ret [$w.list get $s1]
	}
	return $ret
    } else {
	return [$w.list get $s]
    }
}

## Set the value of the currently selected item

proc form_listbox_set_selected {w vals} {
    $w.list selection clear 0 end
    foreach v $vals { set sel($v) 1 }
    for {set i 0} {$i < [$w.list size]} {incr i} {
	if [info exists sel([$w.list get $i])] {
	    $w.list selection set $i
	}
    }
}

## Delete all items from the listbox

proc form_listbox_clear {w} {
    $w.list delete 0 end
}

## Set the items in the listbox to be the ones in the list.  If resize is
## 1 then make sure the listbox is wide enough to hold all the items.

proc form_listbox_set {w items {resize 0}} {
    form_listbox_clear $w
    set maxw 8
    eval $w.list insert end $items
    foreach s $items {
	if {$maxw < [string length $s]} { set maxw [string length $s] }
    }
    if $resize {
	if {$maxw > 50} { set maxw 50 }
	$w.list configure -width $maxw
    }
}

## Set the item at the given position to be <b>item</b>

proc form_listbox_set_index {w num item} {
    if {$num >= [$w.list size]} {
	$w.list insert end $item
    } else {
	$w.list delete $num $num
	$w.list insert $num $item
    }
}

## Get the item at the given position, or all items if it is blank

proc form_listbox_get {w {num ""}} {
    if {$num == ""} {
	set stuff {}
	for {set i 0} {$i < [$w.list size]} {incr i} {
	    lappend stuff [$w.list get $i]
	}
	return $stuff
    } else {
	return [$w.list get $num]
    }
}

## Return the number of entries in the listbox

proc form_listbox_size {w} {
    return [$w.list size]
}

## Resize the listbox to have the given number of rows

proc form_listbox_scale {w size} {
    for {set i 0} {$i < [$w.list size]} {incr i} {
	set l [string length [$w.list get $i]]
	if {$l > $size} { set size $l }
    }
    if {$size > 60} { set size 60 }
    $w.list configure -width $size
}

proc form_listbox_setstate {w on} {
    if $on {
	$w.list configure -foreground black
	catch {$w.title configure -state normal -foreground black}
    } else {
	$w.list configure -foreground grey
	catch {$w.title configure -state disabled -foreground grey}
    }
}

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

proc form_sync_listboxes {w titles widths click_cmd height \
			      tabdata {activedata ""} {titlemenu ""}} {

    global subtitle_font input_font input_background form_label_text
    
    if [info exists form_label_text($w)] { set title $form_label_text($w) }
    
    frame $w -relief flat -borderwidth 0
    set col 0
    if {$titlemenu == "" } {
	foreach title $titles width $widths {
	    if [string match "-variable*" $title] {
		label $w.title$col -textvariable [lindex $title 1]
	    } else {
		label $w.title$col -text $title
	    }
	    listbox $w.list$col -relief sunken -borderwidth 1 -yscroll \
		"$w.scroll set" -background $input_background -exportselection 0 \
		-foreground black -width $width -height $height
	    
	    
	    grid $w.title$col -row 0 -column $col
	    grid $w.list$col -row 1 -column $col
	    incr col
	}
    } else {
	# number of list boxes depends on column width data
	# titles contains the name of a function, returning a list 
	# of menu items
	# which can be different from the number of columns
	# this will make the same menu for each column
	foreach width $widths {
	    futil_menuentry_labels $w.title$col header$col "$titles" "" "" "" ""
	    $w.title$col.e configure -width $width
#	    label $w.title$col -text $title
	    listbox $w.list$col -relief sunken -borderwidth 1 -yscroll \
		"$w.scroll set" -background $input_background -exportselection 0 \
		-foreground black -width $width -height $height
	    grid $w.title$col -row 0 -column $col
	    grid $w.list$col -row 1 -column $col
	    incr col
	}	
    }
    scrollbar $w.scroll -command "form_sync_listboxes_yview $w.list $col"
    grid $w.scroll -row 1 -column $col -sticky ns
    
    if {$click_cmd != ""} {
	for {set i 0} {$i < $col} {incr i} {
	    bind $w.list$i <Button-1> \
		"form_sync_listboxes_action %W $col %y \{$click_cmd 0\}; break"
	    bind $w.list$i <Double-Button-1> \
		"form_sync_listboxes_action %W $col %y \{$click_cmd 1\}; break"
	    bind <Button1-Motion> $w.list$i break
	    bind <ButtonRelease-1> $w.list$i break
	}
    }
    form_dotab $w "$tabdata -fill both" news
    form_doactive $w sync_listbox $activedata
}

proc form_sync_listboxes_select_index {w pos} {
    for {set n 0} {[winfo exists $w.list$n]} {incr n} {
       if {$pos >= [$w.list$n size]} {
          $w.list$n select clear 0 end
       } else {
          $w.list$n see $pos
          $w.list$n selection clear 0 end
          $w.list$n selection set $pos
       }
    }
}

proc form_sync_listboxes_delete_index {w pos} {
    for {set n 0} {[winfo exists $w.list$n]} {incr n} {
	$w.list$n delete $pos
    }
}

proc form_sync_listboxes_delete_matching {w col val} {
    set lb $w.list$col
    for {set i 0} {$i < [$lb size]} {incr i} {
	if {[$lb get $i] == $val} {
	    form_sync_listboxes_delete_index $w $i
	    incr i -1
	}
    }
}

proc form_sync_listboxes_clear {w} {
    for {set n 0} {[winfo exists $w.list$n]} {incr n} {
	$w.list$n delete 0 end
    }
}

proc form_sync_listboxes_add {w vals {by_rows 0} {select 0}} {
    set nr 0
    for {set n 0} {[winfo exists $w.list$n]} {incr n} {
       set m [$w.list$n index end]
       if {$nr < $m} {set nr $m}
    }
    for {set i 0} {$i < $n} {incr i} {
       set m [$w.list$i index end]
       while {$m < $nr} {
          $w.list$i insert end ""
          incr m
       }
    } 
 
    if $by_rows {
       foreach row $vals {
          set i 0
          foreach val $row {
             if {$i < $n} {$w.list$i insert end $val}
             incr i
          }
          while {$i < $n} {
             $w.list$i insert end ""
             incr i
          }
       }
    } else {
       set i 0
       foreach val $vals {
          if {$i >= $n} {break}
          eval $w.list$i insert end $val
          incr i
       }
    }
    if $select {
	set this [expr [$w.list0 index end] - 1]
	form_sync_listboxes_select_index $w $this
    }
}


proc form_sync_listboxes_set {w vals {by_rows 0}} {
    for {set n 0} {[winfo exists $w.list$n]} {incr n} {} 
    form_sync_listboxes_clear $w

    if $by_rows {
	# what to do here if less than n entries?
	# add empty data so rows are aligned?
	foreach row $vals {
	    set i 0
	    foreach val $row {
		if {$i >= $n} { error "too many entries in row" }
		$w.list$i insert end $val
		incr i
	    }
	    while {$i < $n} {
		$w.list$i insert end ""
		incr i
	    }
	}
	
    } else {
	set i 0
	foreach val $vals {
	    eval $w.list$i insert end $val
	    incr i
	}
    }
}

proc form_sync_listboxes_yview {pref ncols args} {
    for {set i 0} {$i < $ncols} {incr i} {
	eval $pref$i yview $args
    }
}

proc form_sync_listboxes_action {w nc y com} {
    set choice [$w nearest $y]
    set w [winfo parent $w]
    for {set i 0} {$i < $nc} {incr i} {
	$w.list$i selection clear 0 end
	$w.list$i selection set $choice
    }
    uplevel #0 eval $com $choice
}

proc form_sync_listboxes_get {w row} {
    set ret ""
    for {set n 0} {[winfo exists $w.list$n]} {incr n} {
	lappend ret [$w.list$n get $row]
    }
    return $ret
}

proc form_sync_listbox_setstate {w on} {
    for {set n 0} {[winfo exists $w.list$n]} {incr n} {
        if $on {
            $w.list$n configure -foreground black
            catch {$w.title$n configure -state normal -foreground black}
        } else {
            $w.list$n configure -foreground grey
            catch {$w.title$n configure -state disabled -foreground grey}
        }
    }
}

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

proc form_set_tablist {w ents} {
    global form_tablist
    
    set form_tablist($w) $ents
    foreach e $ents {
	bind $e <Tab> "form_tab $e $w 1; break"
	bind $e <Down> "form_tab $e $w 1; break"
	bind $e <Shift-Tab> "form_tab $e $w 0; break"
	bind $e <Up> "form_tab $e $w 0; break"
    }
}

## Create an entry widget.  The arguments are:
## <ul>
## <li> <b>var</b> : the variable to bind to the widget's value
## <li> <b>datatype</b> : the data type to check the value against, if
## non-blank.  May be one of:
## <ul>
## <li> <b>float</b> : a floating point number
## <li> <b>float_expr</b> : a floating point number or tcl expression
## <li> <b>float_var</b> : a floating point number or $var string
## <li> <b>float_blank</b> : a floating point number or blank
## <li> <b>float_cmp</b> : a floating point number greater than 1
## <li> <b>int</b> : an int
## <li> <b>int_blank</b> : an int or blank
## <li> <b>pct</b> : a float between 0 and 100
## <li> <b>coords</b> : 3 floats separated by spaces
## <li> <b>coords_float</b> : 3 floats separated by spaces or 1 float
## <li> <b>choice</b> : this keyword is followed by a list of options.  The
## value in the entry must be one of the options
## <li> <b>choice_others</b> : the same as choice but no checking is done
## <li> <b>string</b> : anything
## </ul>
## <li> <b>width</b> : the width of the widget
## </ul>

proc form_entry {w var datatype tabdata {activedata ""} {width 8} {rjust ""} {save_var ""} {cmd ""}} {
    global subtitle_font input_font input_background form_entry_var
    global form_tablist form_inprogress form_entry_datatype form_retcmd
    global form_entry_justify_right form_tail_var form_traces_toplevel
    global form_bw form_default_retcmd
    
    if {$var != ""} { global [lindex [split $var "("] 0] }
    
    set rj [expr {[info exists form_entry_justify_right] && $form_entry_justify_right}]
    set tail 0
    switch [lindex $datatype 0] {
	float - int - int_blank - pct - 
	float_expr - float_var - float_cmp - float_blank { }
	path_tail {
	    set tail 1
	    if {$width == 8} { set width 12 } ; set rj 0
	}
	default { if {$width == 8} { set width 12 } ; set rj 0 }
    }
    if {$rjust != ""} { set rj $rjust }
    
    if $tail {
	if ![info exists $var] { set $var "" }
	set evar form_tail_var($w)
	set $evar [file tail [set $var]]
	set trace1 "[list form_entry_trace_tail $w $evar $var 1]; list"
	set trace2 "[list form_entry_trace_tail $w $evar $var 0]; list"
	trace variable $evar w $trace1
	trace variable $var w $trace2
	if [info exists form_inprogress] {
	    lappend form_traces_toplevel($form_inprogress) \
		[list $evar $trace1] [list $var $trace2]
	}
    } else {
	set evar $var
    }
    entry $w -borderwidth $form_bw -relief sunken -exportselection 1 -width $width \
	-background $input_background -textvariable $evar -foreground black
    if $rj { $w configure -justify right }
    if {$datatype == "readonly"} { $w configure -state disabled }
    
    # Set up the tab and return bindings, unless we've already called
    # form_done.
    if [info exists form_inprogress] {
	lappend form_tablist($form_inprogress) $w
	
	bind $w <Tab> "form_tab $w $form_inprogress 1; break"
	bind $w <Down> "form_tab $w $form_inprogress 1; break"
	bind $w <Shift-Tab> "form_tab $w $form_inprogress 0; break"
	bind $w <Up> "form_tab $w $form_inprogress 0; break"
	if {$cmd == ""} { set cmd $form_retcmd($form_inprogress) }
	if {$cmd == "tab_to_next"} { set cmd "form_tab $w $form_inprogress 1" }
	bind $w <Return> "$cmd; break"
    } elseif [info exists form_default_retcmd] {
	bind $w <Return> "$form_default_retcmd; break" 
    }
    if $tail {
	bind $w / break
    }
    # $w insert end [set $var]
    
    bind $w <3> {
	tkEntryButton1 %W %x
	%W delete 0 end
	catch {%W insert insert [selection get -displayof %W]}
	tkEntrySeeInsert %W
    }
    if {$save_var == ""} { set save_var $var }
    if {$save_var != ""} {
	form_add_save $save_var "form_entry_get $w" "form_entry_set $w"
	set form_entry_var($w) $save_var
    }
    set form_entry_datatype($w) $datatype
    form_dotab $w $tabdata ew
    form_doactive $w entry $activedata
}

proc form_set_default_return_command {cmd} {
    global form_default_retcmd
    set form_default_retcmd $cmd
}

proc form_entry_trace_tail {wid short long setshort} {
    global [lindex [split $short "("] 0] [lindex [split $long "("] 0]
    global in_form_entry_trace_tail
    
    if {![info exists $short] || ![info exists $long] ||
	![winfo exists $wid]} {
	trace vdelete $short w "[list form_entry_trace_tail $wid $short $long 1]; list"
	trace vdelete $long w "[list form_entry_trace_tail $wid $short $long 0]; list"
	return
    }
    if ![info exists in_form_entry_trace_tail] {
	set in_form_entry_trace_tail 1
	if $setshort {
	    set longval [set $long]
	    if { [ string index $longval end ] == "/" } {
		set dirname $longval
	    } else {
		set dirname [file dirname $longval ]/
	    }
	    set nlong $dirname[set $short]
	    if {[set $long] != $nlong} { set $long $nlong }
	} else {
	    set nshort [file tail [set $long]]
	    if {[set $short] != $nshort} { set $short $nshort }
	}
	unset in_form_entry_trace_tail
    }
}

proc form_tab {w form fore} {
    global form_tablist
    
    if {$form_tablist($form) == ""} return
    
    if {$w == ""} {
	set ind -1
    } else {
	set ind [lsearch $form_tablist($form) $w]
	if {$ind == -1} {error "entry not in list!"}
    }
    set num [llength $form_tablist($form)]
    set oind $ind
    if $fore {
	incr ind
	while {$ind != $oind} {
	    if {$ind == $num} {set ind 0}
	    set ent [lindex $form_tablist($form) $ind]
	    if {[form_winmapped $ent] &&
		([lindex [$ent configure -state] 4] == "normal")} break
	    incr ind
	}
    } else {
	incr ind -1
	while {$ind != $oind} {
	    if {$ind == -1} {set ind [expr {$num - 1}]}
	    set ent [lindex $form_tablist($form) $ind]
	    if {[form_winmapped $ent] &&
		([lindex [$ent configure -state] 4] == "normal")} break
	    incr ind -1
	}
    }
    focus $ent
    $ent select range 0 end
}

proc form_entry_get {w} {
    global form_entry_var
    set vn $form_entry_var($w)
    set varn [lindex [split $vn "("] 0]; global $varn
    return [set $vn]
}

proc form_entry_set {w value} {
    global form_entry_var
    
    set ostate [lindex [$w configure -state] 4]
    $w configure -state normal
    set vn $form_entry_var($w)
    set varn [lindex [split $vn "("] 0]; catch {global $varn}
    set $vn $value
    $w configure -state $ostate    
}

proc form_entry_setstate {w on} {
    global input_background input_inactiveb input_inactivef form_active_blank
    global form_background form_inactive_nogray form_entry_never_active
    
    set normstate normal
    if [info exists form_entry_never_active($w)] { set normstate disabled }
    
    if $on {
	$w configure -background $input_background \
	    -foreground black -state $normstate -relief sunken
    } else {
	if [info exists form_active_blank($w)] {
	    $w configure -background $form_background \
		    -foreground $form_background \
		-state disabled -relief flat
	} else {
	    if [info exists form_inactive_nogray($w)] {
		set fore black
	    } else {
		set fore $input_inactivef
	    }
	    $w configure -background $input_inactiveb -foreground $fore \
		-state disabled -relief sunken
	}
    }
}

proc form_entry_check {w} {
    global form_entry_datatype error_background input_background
    global form_previous_label
    
    set type $form_entry_datatype($w)
    if {($type == "readonly") || ($type == "nocheck")} { return 1 }
    
    set val [$w get]
    set correct [form_check_type $type $val]
    
    if [info exists form_previous_label($w)] {
	$w.title configure -text $form_previous_label($w)
    }
    if {$correct != ""} {
	#set title [lindex [$w.title configure -text] 4]
	#set form_previous_label($w) $title
	# This is probably more annoyance than anything else.
	# $w.title configure -text "${title}($correct)"
	$w configure -background $error_background
	return 0
    } else {
	$w configure -background $input_background
	return 1
    }
}

proc form_check_type {type val {allow_exprs 1}} {
    set int_re {^[	]*-?[0-9]+[	]*$}
    set float_re1 \
	    {[	]*-?[0-9]*(\.[0-9]*)?([eE][+-]?[0-9]+)?[ 	]*}
    set float_re "^$float_re1\$"
    set coords_re "^$float_re1\[ \t\]*$float_re\[ \t\]*$float_re\$"
    # Just give up on this if it's an expression ...
    if {$allow_exprs && [string match *\$* $val]} { return "" }
    if {([string trim $val] == "") && [string match *_blank $type]} { return "" }
    set correct ""
    set len [string length [string trim $val]]
    set try_choices 1
    switch [lindex $type 0] {
	float {
	    if {![regexp $float_re $val dummy] || !$len || [string match e* $val]} {
		set correct real
	    }
	}
	float_cmp {
	    if {![regexp $float_re $val dummy] || !$len} {
		set correct real
	    }
	    set try_choices 0
	    
	    foreach cmp [lrange $type 1 end] {
		if !($val$cmp) {
		    set correct "real $cmp"
		    break
		}
	    }
	}
	float_blank {
	    if ![regexp $float_re $val dummy] {
		set correct real
	    }
	}
	float_expr {
	    # too hard to check, but just make sure it's not blank
	    if {[string trim $val] == ""} {
		set correct "real or expression"
	    }
	}
	float_var {
	    if {(![regexp $float_re $val dummy] && \
		     ![string match \$* [string trim $val]]) || !$len} {
		set correct "real or variable"
	    }
	}
	coords {
	    if {[scan $val "%g %g %g" d1 d2 d3] != 3} {
		set correct coords
	    }
	}
	coords_float {
	    if {([scan $val "%g %g %g" d1 d2 d3] != 3) && \
		    ![regexp $float_re $val dummy]} {
		set correct "coords or real"
	    }
	}
	int {
	    if ![regexp $int_re $val dummy] {
		set correct integer
	    }
	}
	int_blank {
	    if ![regexp $int_re $val dummy] {
		set correct integer
	    }
	}
	pct {
	    if {![regexp $float_re $val dummy] || \
		    ($val < 0) || ($val > 100)} {
		set correct percentage
	    }
	}
	choice {
	    set correct choice
	}
	choice_others {
	    set correct ""
	}
	path_tail {
	    if {$val == ""} {
		set correct "non-blank filename"
	    }
	}
    }
    
    if {$correct == ""} {return ""}
    if $try_choices {
	foreach alt [lrange $type 1 end] {
	    if {[string trim $alt] == [string trim $val]} {return ""}
	}
    }
    return $correct
}

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

## Create a text widget.  The arguments are:
## <ul>
## <li> <b>title</b> : a string to put above the window
## <li> <b>var</b> : the variable to bind to the widget's value
## <li> <b>geo</b> : the value is of the form
## <i>width</i><b>x</b><i>height</i> and gives the size of the text area
## </ul>
## Note that unlike the entry widget, the value in the text area is only
## synchronized when the form is mapped and accepted.

proc form_text {w title var tabdata {activedata ""} {geo 40x10} {xscroll 0} {font ""}} {
    global subtitle_font input_font input_background form_label_text form_bw
    global is_win
    global [lindex [split $var "("] 0]
    
    if {$is_win && ($font == "fixed")} { set font systemfixed }
    if [info exists form_label_text($w)] { set title $form_label_text($w) }
    if [info exists form_label_text($title)] { set title $form_label_text($title) }
    
    frame $w
    
    if {$title != ""} {
	label $w.title -text $title
	grid $w.title -row 0 -column 0 -sticky w
    }
    text $w.text -borderwidth $form_bw -relief sunken \
	    -padx 4 -pady 4 -yscroll "$w.scroll set" \
	    -background $input_background -exportselection 1
    if {$font != ""} { $w.text configure -font $font }
    if {$geo != ""} {
	set width [lindex [split $geo x] 0]
	set height [lindex [split $geo x] 1]
	if $width { $w.text configure -width $width }
	if $height { $w.text configure -height $height }
    }
    grid $w.text -row 1 -column 0 -sticky news
    grid rowconfigure $w 1 -weight 1000
    grid columnconfigure $w 0 -weight 1000
    
    scrollbar $w.scroll -command "$w.text yview"
    grid $w.scroll -row 1 -column 1 -sticky ns
    
    if $xscroll {
	scrollbar $w.xscroll -command "$w.text xview" -orient h
	$w.text configure -xscrollcommand "$w.xscroll set" -wrap none
	grid $w.xscroll -row 2 -column 0 -sticky ew
    }
    
    if {$var != ""} {
	form_add_save $var "form_text_get $w" "form_text_set $w"
	$w.text insert end [set $var]
    }
    form_dotab $w "$tabdata -fill both" news
    form_doactive $w text $activedata
    return $w.text
}

## Return the text in a text widget

proc form_text_get {w} { return [$w.text get 1.0 end] }

## Set the text in a text widget

proc form_text_set {w value} {
    set ostate [lindex [$w.text configure -state] 4]
    $w.text configure -state normal
    $w.text delete 1.0 end; $w.text insert end $value
    $w.text configure -state $ostate
}

## Append to a text widget

proc form_text_append {w value} {
    set ostate [lindex [$w.text configure -state] 4]
    $w.text configure -state normal
    $w.text insert end $value
    $w.text see end
    $w.text configure -state $ostate
}

proc form_text_setstate {w on} {
    global input_inactivef
    
    if $on {
        $w.text configure -state normal -foreground black
        catch {$w.title configure -foreground black}
    } else {
        $w.text configure -state disabled -foreground $input_inactivef
        catch {$w.title configure -foreground $input_inactivef}
    }
}

proc form_text_editor {w main title var tabdata {activedata ""} {geo 40x10} {font ""}} {
    global subtitle_font input_font input_background form_bw
    global is_win form_text_editor_linenumber
    global [lindex [split $var "("] 0]
    
    if {$is_win && ($font == "fixed")} { set font systemfixed }

    frame $w  
    if {$title != ""} {
        label $w.title -text $title -textvariable form_text_editor_linenumber
        grid $w.title -row 0 -column 0 -sticky w
    }
    text $w.txt -borderwidth $form_bw -relief sunken -yscroll "$w.scroll set" \
	    -background $input_background -exportselection 1 -undo 1 -autosep 1 \
	    -spacing1 1 
    if {$font != ""} { $w.txt configure -font $font }
    
    if {$geo != ""} {
        set width [lindex [split $geo x] 0]
        set height [lindex [split $geo x] 1]
        if $width { $w.txt configure -width $width }
        if $height { $w.txt configure -height $height }
    }
    
    grid $w.txt -row 1 -column 0 -sticky news
    grid rowconfigure $w 1 -weight 1000
    grid columnconfigure $w 0 -weight 1000
    scrollbar $w.scroll -command "$w.txt yview"
    $w.scroll activate slider
    grid $w.scroll -row 1 -column 1 -sticky ns -rowspan 2
    scrollbar $w.xscroll -command "$w.txt xview" -orient h  
    $w.txt configure -xscrollcommand "$w.xscroll set" -wrap none
    grid $w.xscroll -row 2 -column 0 -sticky ew
    
    if {$var != ""} {
        form_add_save $var "form_text_editor_get $w" "form_text_editor_set $w"
        $w.txt insert end [set $var]
    }
    
    form_dotab $w "$tabdata -fill both" news
    form_doactive $w text_editor $activedata
    return $w.txt
}

proc form_text_editor_create_menu {w main type state} {

    if ![winfo exists $main.mbar] {
        $main configure -menu $main.mbar
        set m [menu $main.mbar]
    } else {
        set m $main.mbar
    }
    if ![winfo exists $main.tool] {
        set tool [frame $main.tool]
    } else {
        set tool $main.tool
    }
    if ![winfo exists $main.tool2] {
        set tool2 [frame $main.tool2]
    } else {
        set tool2 $main.tool2
    }

    switch $type {
        file {
            $m add cascade -label "File" -menu $m.file
            set f [menu $m.file -type menubar -tearoff 0]
            $f add command -label "New" -command "form_text_editor_new $w.txt"
            $f add command -label "Open" -command "form_text_editor_open $w.txt"
            $f add command -label "Save" -command "form_text_editor_save $w.txt"
            $f add command -label "Save As..." -command "form_text_editor_saveas $w.txt"
            foreach i "0 1 2 3" {
	            $m.file entryconfigure $i -state $state
	        }
        }
        file_replay {
            $m add cascade -label "File" -menu $m.file
            set f [menu $m.file -type menubar -tearoff 0]
            $f add command -label "Load" -command "form_text_editor_replay_open $w.txt"
            $f add command -label "Save" -command "form_text_editor_replay_save $w.txt"
            foreach i "0 1" {
	            $m.file entryconfigure $i -state $state
	        }
        }
        file_tool {
	        set bar1 [ButtonBox $tool.bbox1 -spacing 2 -padx 1 -pady 1]
            $bar1 add -image [Bitmap::get open] -highlightthickness 0 \
                -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
        	    -helptext "Open" -command "form_text_editor_open $w.txt"
            $bar1 add -image [Bitmap::get save] -highlightthickness 0 \
                -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
        	    -helptext "Save" -command "form_text_editor_save $w.txt"
        	foreach i "0 1" {
        	    $bar1 itemconfigure $i -state $state
        	}
            pack $bar1 -side left -anchor w -padx 4
            pack $tool -before $main.main -side top -anchor nw
	        
        }
        file_tool_replay {
	        set bar1 [ButtonBox $tool.bbox1 -spacing 2 -padx 1 -pady 1]
            $bar1 add -image [Bitmap::get open] -highlightthickness 0 \
                -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
        	    -helptext "Load" -command "form_text_editor_replay_open $w.txt"
            $bar1 add -image [Bitmap::get save] -highlightthickness 0 \
                -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
        	    -helptext "Save" -command "form_text_editor_replay_save $w.txt"
        	foreach i "0 1" {
        	    $bar1 itemconfigure $i -state $state
        	}
            pack $bar1 -side left -anchor w -padx 4
            pack $tool -before $main.main -side top -anchor nw
	        
        }
	    edit {
	        $m add cascade -label "Edit" -menu $m.edit
	        set e [menu $m.edit -type menubar -tearoff 0] 
	        $e add command -label "Undo" -command "form_text_editor_undo $w.txt"
	        $e add command -label "Redo" -command "form_text_editor_redo $w.txt"
	        $e add separator
	        $e add command -label "Cut" -command "form_text_editor_cut $w.txt"
	        $e add command -label "Copy" -command "form_text_editor_copy $w.txt"
	        $e add command -label "Paste" -command "form_text_editor_paste $w.txt"
	        $e add separator
	        $e add command -label "Search" -command "form_text_editor_search $w.txt"
	        $e add command -label "Replace" -command "form_text_editor_replace $w.txt"
            foreach i "0 1 3 4 5 7 8" {
                $m.edit entryconfigure $i -state $state
            }
	    }
	    edit_tool {
	        set bar2 [ButtonBox $tool.bbox2 -spacing 2 -padx 1 -pady 1]
            $bar2 add -image [Bitmap::get undo] -highlightthickness 0 \
	        	 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
        		 -helptext "Undo" -command "form_text_editor_undo $w.txt"
            $bar2 add -image [Bitmap::get redo] -highlightthickness 0 \
	        	 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
        		 -helptext "Redo" -command "form_text_editor_redo $w.txt"
            $bar2 add -image [Bitmap::get cut] -highlightthickness 0 \
	        	 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
        		 -helptext "Cut" -command "form_text_editor_cut $w.txt"
            $bar2 add -image [Bitmap::get copy] -highlightthickness 0 \
	        	 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
        		 -helptext "Copy" -command "form_text_editor_copy $w.txt"
            $bar2 add -image [Bitmap::get paste] -highlightthickness 0 \
	        	 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
        		 -helptext "Paste" -command "form_text_editor_paste $w.txt"
            foreach i "0 1 2 3 4" {
                $bar2 itemconfigure $i -state $state
            }
            pack $bar2 -side left -anchor w -padx 4
            pack $tool -before $main.main -side top -anchor nw
	    }
	}
}

proc form_text_editor_set_linenumber {} {
    global replay_editbox form_text_editor_linenumber
    global replay_current

    set t $replay_editbox.txt
    update idletasks
    set num [lindex [split [$t index insert] .] 0]
    if {$num != ""} {
        set form_text_editor_linenumber "Edit mode (Line: $num)"
        $replay_editbox.txt tag delete yellow
        $replay_editbox.txt tag add yellow $num.0 $num.end
        $replay_editbox.txt tag configure yellow -background yellow
        set replay_current $num
    }
}

proc form_text_editor_trace_linenumber {state} {
    global replay_main_box replay_editbox form_text_editor_linenumber
    
    set t $replay_editbox.txt
    set t2 [winfo parent $replay_main_box].tool2.line
    if {$state == "delete"} {
        set form_text_editor_linenumber ""
    } elseif {$state == "create"} {
        if {[info commands ${t}_] == ""} {
            catch { rename $t ${t}_ }
            interp alias {} $t {} form_text_editor_monitor ${t}_
        }
    }
}

proc form_text_editor_monitor {proc args} {
	global form_text_editor_linenumber

	set command [lindex $args 0]
	set args [lrange $args 1 end]
	if {$args == ""} return
	if {[string equal $command "insert"] || [string equal $command "delete"] || [string equal $command "see"] || [string equal $command "edit"]} {
        if {$form_text_editor_linenumber != ""} { form_text_editor_set_linenumber }
	}
	eval "$proc $command $args"
}

proc form_text_editor_open {t {file ""}} {
	global AppName
	
    if {$file == ""} {
        set file [tk_getOpenFile -title "$AppName Open"]
	}
	if {$file != ""} {
		set fp [open $file r]
	    set state [$t cget -state]
	    $t configure -state normal
		$t delete 1.0 end
	    while {![eof $fp]} {
		    $t insert end [read -nonewline $fp]
		}
		close $fp
	    $t configure -state $state
	}
	focus $t
	$t edit reset
}

proc form_text_editor_replay_open {t} {
	global AppName replay_file file_name wb_initProjName

    if [file exists $file_name(settings)] {
        set init_replay_file_name [file rootname [file tail $file_name(settings)]].rpl
    } else {
        set init_replay_file_name ""
    }
    if [aie_wb2_is_running] {
        if {[replay_gui_is_running] == "replay_wb_mode"} {
            set init_replay_file_name $wb_initProjName.rpl
        }
    }
    set file [tk_getOpenFile -filetypes {{{Replay Files} {.rpl .jrf .tcl}} {{All Files} *}} \
        -title "$AppName Open Script File" -parent . -initialfile $init_replay_file_name \
        -initialdir [pwd] -defaultextension ".rpl"]
	if {$file != ""} {
		set fp [open $file r]
	    set state [$t cget -state]
	    $t configure -state normal
		$t delete 1.0 end
	    while {![eof $fp]} {
		    $t insert end [read -nonewline $fp]
		}
		close $fp
	    $t configure -state $state
	    set replay_file $file
	} else {
	    return
	}
	focus $t
	$t edit reset
}

proc form_text_editor_save {t {file ""}} {
	global AppName
	
    if {$file == ""} {
        set file [tk_getSaveFile -title "$AppName Save"]
	}
	if {$file != ""} {
		set fp [open $file w]
		set data [$t get 1.0 end]
		puts $fp $data
		close $fp
	} else {
	    return
	}
	focus $t
	$t edit reset
}

proc form_text_editor_replay_save {t} {
	global AppName file_name replay_file wb_initProjName
	
    if {[aie_wb2_is_running] && [replay_gui_is_running] == "replay_wb_mode"} {
         set file $wb_initProjName.rpl
    } else {
        if {([info exists replay_file] && ($replay_file == "" || $replay_file == "replay_file")) && ([info exists file_name(settings)] && $file_name(settings) != "")} {
           set def [file rootname $file_name(settings)].rpl
        } else {
            if [info exists replay_file] {
                set def $replay_file
            } else {
                set def [pwd]
            }
        }
        set file [tk_getSaveFile -filetypes {{{Replay Files} {.rpl .jrf .tcl}} {{All Files} *}} -title "$AppName Save Script File" \
			  -parent . -initialfile $def -initialdir [pwd] -defaultextension ".rpl"]
	}
	if {$file != ""} {
		set fp [open $file w]
		set data [$t get 1.0 end]
		puts $fp $data
		close $fp
	} else {
	    return
	}
	focus $t
	$t edit reset
}


proc form_text_editor_saveas {t} {
	global AppName
	
    set file [tk_getSaveFile -title "$AppName Save As"]
    if {$file != ""} {
        form_text_editor_save $t $file
    }
}

proc form_text_editor_new {t} {
	global AppName

    if [llength [$t get 1.0 end]] {
		if { [tk_messageBox -type okcancel -icon question -title $AppName -message "Save the changes made to a file?"] == "ok" } {
			form_text_editor_save $t
		}
    }
	set state [$t cget -state]
	$t configure -state normal
	$t delete 1.0 end
	$t configure -state $state
	$t edit reset
}

proc form_text_editor_search {t} {
    global form_text_search_text form_text_search_start form_text_search_end form_text_search_dir form_text_search_case

    if [winfo exists .text_replace] {
        destroy .text_replace
    }
    if [winfo exists .text_search] {
        focus .text_search
        return
    }

    set line [lindex [split [$t index insert] .] 0]
    set col [lindex [split [$t index insert] .] 1]
    set form_text_search_text ""
    set form_text_search_start $line.$col
    set form_text_search_end end
    set form_text_search_dir forwards
    catch { destroy .text_search }
    set d [form_init .text_search "Find" "" done]
    if {$d != ""} {
        form_frame $d.f1 flat 3 "0 0 -fill x"
	    form_label $d.f1.find "Find what:" {0 0 -ipady 3} ""
	    form_entry $d.f1.txt form_text_search_text string {0 1}
	    $d.f1.txt configure -width 30
	    form_button $d.f1.next "Find next" "form_text_find_next $t" "0 2 -padx 3 -ipadx 3 -ipady 1" ""
	    $d.f1.next configure -width 10
	    form_frame $d.f2 flat 3 "1 0 -fill x"
	    form_checkbutton $d.f2.case "Match case" form_text_search_case "0 0" "" "" 
	    form_frame $d.f2.f3 groove 3 "0 1"
	    form_label $d.f2.f3.dir "Search direction:" {0 0}
	    form_radiobutton $d.f2.f3.up "Up" form_text_search_dir backwards "0 1" "" "form_text_editor_direction $t backwards"
	    form_radiobutton $d.f2.f3.dn "Down" form_text_search_dir forwards "0 2" "" "form_text_editor_direction $t forwards"
	    form_finish bot
    }
    wm transient .text_search $t
    wm resizable .text_search 0 0
    form_wait .text_search
    if {[llength [$t tag ranges currentSearch]]} {
         $t tag delete currentSearch 
    }
    destroy .text_search
}

proc form_text_editor_replace {t} {
    global form_text_search_text form_text_search_start form_text_search_end form_text_search_case form_text_replace_text

    if [winfo exists .text_search] {
        destroy .text_search
    }
    if [winfo exists .text_replace] {
        focus .text_replace
        return
    }

    set line [lindex [split [$t index insert] .] 0]
    set col [lindex [split [$t index insert] .] 1]
    set form_text_search_text ""
    set form_text_search_start $line.$col
    set form_text_search_end end
    set form_text_search_dir forwards
    catch { destroy .text_replace }
    set d [form_init .text_replace "Replace" "" done]
    if {$d != ""} {
        form_frame $d.f1 flat 3 "0 0 -fill x"
	    form_label $d.f1.find "Find what:" {0 0 -ipady 3} ""
	    form_entry $d.f1.txt form_text_search_text string {0 1}
	    $d.f1.txt configure -width 30
	    form_button $d.f1.next "Find next" "form_text_find_next $t" "0 2 -padx 3 -ipadx 3 -ipady 1" ""
	    $d.f1.next configure -width 10
	    form_label $d.f1.replace "Replace with:" {1 0 -ipady 3} "" 16 
	    form_entry $d.f1.txt2 form_text_replace_text string {1 1}
	    $d.f1.txt2 configure -width 30
	    form_button $d.f1.replace2 "Replace" "form_text_find_replace $t" "1 2 -padx 3 -ipadx 3 -ipady 1" ""
	    $d.f1.replace2 configure -width 10
	    form_button $d.f1.replace3 "Replace all" "form_text_find_replace $t 1" "2 2 -padx 3 -ipadx 3 -ipady 1" ""
	    $d.f1.replace3 configure -width 10
	    form_frame $d.f2 flat 3 "1 0"
	    form_checkbutton $d.f2.case "Match case" form_text_search_case "0 0" "" "" 
	    form_finish bot
    }
    wm transient .text_replace $t
    wm resizable .text_replace 0 0
    form_wait .text_replace
    if {[llength [$t tag ranges currentSearch]]} {
         $t tag delete currentSearch 
    }
    destroy .text_replace
}

proc form_text_find_next {t {replace 0}} {
    global form_text_search_text form_text_search_start form_text_search_end form_text_search_dir form_text_search_case
  
    set ranges [$t tag ranges currentSearch]
    if {[llength $ranges]} {
         $t tag delete currentSearch 
    }
    
    if {$form_text_search_text == ""} return
    
    if $form_text_search_case {
        set found [$t search -regexp -$form_text_search_dir -- "$form_text_search_text" $form_text_search_start $form_text_search_end]
    } else {
        set found [$t search -nocase -regexp -$form_text_search_dir -- "$form_text_search_text" $form_text_search_start $form_text_search_end]
    }

    if {$found != ""} {
        set len [string length $form_text_search_text]
        set line [lindex [split $found .] 0]
        set col [expr [lindex [split $found .] 1] + $len]
        $t tag add currentSearch $found $line.$col
        $t tag configure currentSearch -background yellow
        $t tag raise currentSearch
        $t mark set insert $line.$col
        $t see insert
        if {$form_text_search_dir == "forwards"} {
            set form_text_search_start $line.$col
            set form_text_search_end end
        } else {
            set form_text_search_start $found
            set form_text_search_end 1.0
        }
    } else {
        mess "Pattern \"$form_text_search_text\" not found, continue next search at the beginning.\n"
        if {$form_text_search_dir == "forwards"} {
            set form_text_search_start 1.0
            set form_text_search_end end
        } else {
            set form_text_search_start end
            set form_text_search_end 1.0
        }
    }
}

proc form_text_find_replace {t {all 0}} {
    global form_text_search_start form_text_search_end form_text_search_text form_text_replace_text form_text_search_case

    set len [string length $form_text_search_text]
    if !$len return

    set ranges [$t tag ranges currentSearch]
    if {[llength $ranges]} {
        foreach {from to} $ranges {
            $t mark set insert $from
            $t delete $from $to
            $t insert insert $form_text_replace_text
            if !$all {
                form_text_find_next $t
                return
            }
        }
    }

    if $all {
        set form_text_search_start 1.0
        set form_text_search_end end
    }
    
    while 1 {
        if $form_text_search_case {
            set found [$t search -regexp -forwards -- "$form_text_search_text" $form_text_search_start $form_text_search_end]
        } else {
            set found [$t search -nocase -regexp -forwards -- "$form_text_search_text" $form_text_search_start $form_text_search_end]
        }
        if {$found == ""} break
        set line [lindex [split $found .] 0]
        set col [expr [lindex [split $found .] 1] + $len]
        $t mark set insert $line.$col
        $t see insert
        set from $found 
        set to $line.$col
        $t delete $from $to
        $t insert insert $form_text_replace_text
        if !$all break
        set form_text_search_start $line.$col
    }
}

proc form_text_editor_direction {t dir} {
    global form_text_search_start form_text_search_end

    set line [lindex [split [$t index insert] .] 0]
    set col [lindex [split [$t index insert] .] 1]
    if {$dir == "forwards"} {
        set form_text_search_start $line.$col
        set form_text_search_end end
    } else {
        set form_text_search_start $line.$col
        set form_text_search_end 1.0
    }
}

proc form_text_editor_undo {t} {
    if [catch {$t edit undo} r] {
        mess "Nothing to be undone\n"
    }
}

proc form_text_editor_redo {t} {
    if [catch {$t edit redo} r] {
        mess "Nothing to be redone\n"
    }
}

proc form_text_editor_cut {t} {
	variable tkclipboard
	set indices [$t tag ranges sel]
	if {$indices == ""} return
	variable tkclipboard ""
	clipboard clear
	foreach {i1 i2} $indices {
	    set string [$t get $i1 $i2]
	    clipboard append -- $string
	    append tkclipboard $string
	    $t delete $i1 $i2
	}
}

proc form_text_editor_copy {t} {
	variable tkclipboard
	set indices [$t tag ranges sel]
	if {$indices == ""} return
	variable tkclipboard ""
	clipboard clear
	foreach {i1 i2} $indices {
	    set string [$t get $i1 $i2]
	    clipboard append -- $string
	    append tkclipboard $string 
	}
}

proc form_text_editor_paste {t} {
	variable tkclipboard
	if {![info exists tkclipboard] || $tkclipboard == ""} return
	$t insert insert $tkclipboard
}

proc form_text_editor_get {w} { return [$w.txt get 1.0 end] }

proc form_text_editor_set {w value} {
    set ostate [lindex [$w.txt configure -state] 4]
    $w.txt configure -state normal
    $w.txt delete 1.0 end; $w.txt insert end $value
    $w.txt configure -state $ostate
}

proc form_text_editor_append {w value} {
    set ostate [lindex [$w.txt configure -state] 4]
    $w.txt configure -state normal
    $w.txt insert end $value
    $w.txt see end
    $w.txt configure -state $ostate
}

proc form_text_editor_setstate {w on} {
    global input_inactivef
    
    if $on {
        $w.txt configure -state normal -foreground black
        catch {$w.title configure -foreground black}
    } else {
        $w.txt configure -state disabled -foreground $input_inactivef
        catch {$w.title configure -foreground $input_inactivef}
    }
}

## Format a table as text

proc form_make_table {rows1} {
    set rows ""
    foreach row $rows1 {
	set wordpos 0
	while 1 {
	    set nrow ""
	    set nfound 0
	    foreach col $row {
		set word [lindex [split $col \n] $wordpos]
		lappend nrow $word
		if {$word != ""} { incr nfound }
	    }
	    if {!$nfound && $wordpos} break
	    lappend rows $nrow
	    incr wordpos
	}
    }
    
    foreach row $rows {
	set c 0
	foreach col $row {
	    if {$col == "COLSPAN"} break
	    if {$col == "TAB"} { 
		set w 3 ;# plus the extra space gives 4
	    } else {
		set w [string length [string trim $col]]
	    }
	    if {![info exists width($c)] || ($width($c) < $w)} {
		set width($c) $w
	    }
	    incr c
	}
    }
    set text ""
    set maxw 0
    foreach c [array names width] {
	incr maxw [expr $width($c) + 1]
    }
    foreach row $rows {
	if {[lindex $row 0] == "COLSPAN"} {
	    append text "[lindex $row 1]\n"
	    set tl [string length [lindex $row 1]]
	    if {$tl > $maxw} { set maxw $tl }
	} else {
	    set c 0
	    set nextcs 0
	    set rwidth 0
	    foreach col $row {
		if $nextcs {
		    set tt [string trim $col]
		    append text $tt
		    set tl [expr $rwidth + [string length $tt]]
		    if {$tl > $maxw} { set maxw $tl }
		} elseif {$col == "COLSPAN"} {
		    set nextcs 1
		} else {
		    if {$col == "TAB"} { set col "" }
		    set tt [format "%-$width($c)s " [string trim $col]]
		    append text $tt
		    incr c
		    incr rwidth [string length $tt]
		}
	    }
	    append text \n
	}
    }
    return [list $text $maxw]
}

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

## Create a button.
## <ul>
## <li> <b>title</b> : the string on the widget
## <li> <b>command</b> : the command to bind to the button
## </ul>

proc form_button {w title command tabdata {activedata ""}} {
    global form_pad form_label_text
    
    if [info exists form_label_text($w)] { set title $form_label_text($w) }
    if [info exists form_label_text($title)] { set title $form_label_text($title) }
    
    button $w -text " $title " -command $command -anchor c \
	-padx $form_pad -pady $form_pad
    
    form_dotab $w $tabdata nw
    form_doactive $w button $activedata
}

## Create a bitmap button.
## <ul>
## <li> <b>bmap</b> : the bitmap to be drawn on the button
## <li> <b>command</b> : the command to bind to the button
## </ul>

proc form_button_bitmap {w bmap command tabdata {activedata ""}} {
    global form_pad
    
    button $w -bitmap $bmap -command $command -anchor c \
	-padx $form_pad -pady $form_pad
    
    form_dotab $w $tabdata nw
    form_doactive $w button $activedata
}

proc form_button_setstate {w on} {
    global form_active_blank form_background
    
    set back $form_background
    if [string match gray* [$w cget -bg]] {
	set back gray95
    }
    if $on {
	$w configure -state normal -foreground black -relief raised
    } elseif [info exists form_active_blank($w)] {
	$w configure -state disabled -disabledforeground $back -relief flat
    } else {
	$w configure -state disabled
    }
}

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

## Create a check button.
## <ul>
## <li> <b>title</b> : the string on the button
## <li> <b>var</b> : the boolean variable to assign to the button
## <li> <b>command</b> : the command to bind to the button
## <li> <b>nonbool</b> : (optional) accept nonboolean variables (e.g. catia v4 import) -fifi
## </ul>
## This has special code to deal with parameters.

proc form_checkbutton {w title var tabdata {activedata ""} \
			   {command ""} {nonbool ""}} {
    global form_label_text form_traces_toplevel form_inprogress
    global checkbuttons_have_params
    
    if [info exists form_label_text($w)] { set title $form_label_text($w) }
    if [info exists form_label_text($title)] { set title $form_label_text($title) }
    
    checkbutton $w -text $title -variable $var -anchor w -relief flat
    if {$command != ""} {
	$w configure -command $command
    }
    
    form_add_save $var
    
    if [info exists checkbuttons_have_params] {
	# If this is not a boolean value, disable the checkbutton but
	# still allow right-button editing to happen.
	if {$nonbool == ""} {
	    lappend activedata [list $var 0 1]
	}
	bind $w <3> [list form_checkbutton_edit_params $w $var "" $title]
	
	upvar \#0 $var lvar
	set trace1 "[list form_checkbutton_configure_param $w $var]; list"
	trace variable lvar w $trace1
	if [info exists form_inprogress] {
	    lappend form_traces_toplevel($form_inprogress) [list $var $trace1]
	}
	form_checkbutton_configure_param $w $var
    }
    
    form_dotab $w $tabdata nw
    form_doactive $w checkbutton $activedata
}

proc form_checkbutton_configure_param {w var} {
    if [winfo exists $w] {
	upvar \#0 $var lvar
	if [string match *\$* $lvar] {
	    $w configure -foreground \#00a000
	} else {
	    $w configure -foreground black
	}
    }
}

proc form_checkbutton_setstate {w on} {
    global input_inactivef form_active_blank form_background
    global is_win tcl_version
    
    set reset_selcolor [$w cget -indicatoron]
    
    if $on {
	$w configure -state normal
	if {$reset_selcolor && (!$is_win || ($tcl_version < 8.0))} {
	    $w configure -selectcolor #b03060
	}
	if [info exists form_active_blank($w)] {
	    $w configure -indicatoron 1
	}
    } elseif [info exists form_active_blank($w)] {
	$w configure -state disabled -disabledforeground $form_background \
	    -indicatoron 0
    } else {
	$w configure -state disabled
	if {$reset_selcolor && (!$is_win || ($tcl_version < 8.0))} {
	    $w configure -selectcolor $input_inactivef
	}
    }
}

proc form_checkbutton_edit_params {cw var val title} {
    global form_checkbutton_edit_params model_data
    
    # This is for icepak and violates the self-contained nature of this code, but ....
    set candosimple [info exists model_data(name)]
    
    upvar \#0 $var lvar
    
    # It will be of the form $a+$b == 7
    set spl [split $lvar =]
    if {[llength $spl] < 3} {
	if [string match *\$* $spl] {
	    set form_checkbutton_edit_params(exp) $spl
	    set form_checkbutton_edit_params(var) $spl
	} else {
	    set form_checkbutton_edit_params(exp) ""
	    set form_checkbutton_edit_params(var) ""
	}
	set form_checkbutton_edit_params(val) 1
    } else {
	# This is a bit wierd because the expression might look like
	# ($a == $b)==1
	set form_checkbutton_edit_params(exp) [join [lrange $spl 0 end-2] =]
	set form_checkbutton_edit_params(val) [lindex $spl end]
    }
    set pat {^(\$[a-zA-Z0-9_]+)=="(.*)"$}
    if {$candosimple && ([regexp $pat $lvar dummy var1 val1] == 1) && ($val1 == $model_data(name))} {
	set form_checkbutton_edit_params(general) name
    } elseif [string match *\$* $lvar] {
	set form_checkbutton_edit_params(general) expr
    } else {
	set form_checkbutton_edit_params(general) fixed
    }
    set form_checkbutton_edit_params(fixed) [expr {$lvar == "1"}]
    
    set oname [string match model_data* $var]
    
    set ww .button_edit_params_$oname
    set w [form_init $ww "$title parameter"]
    if {$w != ""} {
	if $oname {
	    form_radiobutton $w.simple "Option is ON if variable is equal to\n    this object's name" form_checkbutton_edit_params(general) name \
		{0 0 -cols -} $candosimple
	    set act {{form_checkbutton_edit_params(general) name}}
	    form_label $w.varl "Variable name" {1 1} $act
	    form_entry $w.var form_checkbutton_edit_params(var) string {1 2 -cols 2} $act
	}
	
	form_radiobutton $w.general "Option is ON if expression is equal to\n    a specified value" form_checkbutton_edit_params(general) expr \
	    {9 0 -cols -}
	set act {{form_checkbutton_edit_params(general) expr}}
	form_label $w.expl "Expression" {10 1} $act
	form_label $w.eql "=" {10 2} $act
	form_label $w.vall "Value" {10 3} $act
	form_entry $w.exp form_checkbutton_edit_params(exp) string {11 1} $act
	form_entry $w.val form_checkbutton_edit_params(val) string {11 3} $act
	
	form_radiobutton $w.fixed "Not parameterized" form_checkbutton_edit_params(general) fixed \
	    {20 0 -cols -}
	set act {{form_checkbutton_edit_params(general) fixed}}
	form_frame $w.fixedf flat 0 {21 0 -cols -}
	form_radiobutton $w.fixedf.on On form_checkbutton_edit_params(fixed) 1 {0 1} $act
	form_radiobutton $w.fixedf.off Off form_checkbutton_edit_params(fixed) 0 {0 2} $act
	form_colwidth $w 0 4 M
	form_colwidth $w.fixedf 0 4 M
	form_finish +[winfo pointerx $cw]+[winfo pointery $cw]
    } else {
	form_setgeometry $ww +[winfo pointerx $cw]+[winfo pointery $cw]
    }
    if [form_wait $ww] {
	set val $form_checkbutton_edit_params(val)
	set exp $form_checkbutton_edit_params(exp)
	switch $form_checkbutton_edit_params(general) {
	    expr {
		if {$val == ""} { set val 1 }
		if {$exp != ""} {
		    set lvar $exp==$val
		} else {
		    set lvar $val
		}
	    }
	    name {
		set var $form_checkbutton_edit_params(var)
		if {$var != ""} {
		    set lvar $var==\"$model_data(name)\"
		    expression_ensure_variable_has_value $var \"$model_data(name)\"
		} else {
		    set lvar $val
		}
	    }
	    fixed {
		set lvar $form_checkbutton_edit_params(fixed)
	    }
	}
    }
}

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

## Create a radio button.
## <ul>
## <li> <b>title</b> : the string on the button
## <li> <b>var</b> : the variable to assign to the button
## <li> <b>val</b> : the value to assign to the variable when the
## button is selected
## <li> <b>command</b> : the command to bind to the button
## </ul>
## This has special code to deal with parameters.

proc form_radiobutton {w title var val tabdata {activedata ""} \
			   {command ""} {allow_params 1}} {
    global form_label_text
    global checkbuttons_have_params
    
    if [info exists form_label_text($w)] { set title $form_label_text($w) }
    if [info exists form_label_text($title)] { set title $form_label_text($title) }

    radiobutton $w -text $title -variable $var -value $val -anchor w \
	-relief flat
    
    if {$command != ""} {
	$w configure -command $command
    }
    form_add_save $var
    
    if [info exists checkbuttons_have_params] {
	bind $w <3> [list form_radiobutton_edit_params $w]
	
	upvar \#0 $var lvar
	set trace1 "[list form_checkbutton_configure_param $w $var]; list"
	trace variable lvar w $trace1
	if [info exists form_inprogress] {
	    lappend form_traces_toplevel($form_inprogress) [list $var $trace1]
	}
	form_checkbutton_configure_param $w $var
    }
    
    form_dotab $w $tabdata nw
    form_doactive $w radiobutton $activedata
}

proc form_radiobutton_setstate {w on} {
    global input_inactivef form_active_blank form_background
    global is_win tcl_version

    set reset_selcolor [$w cget -indicatoron]
    
    if $on {
	$w configure -state normal
	if {$reset_selcolor && (!$is_win || ($tcl_version < 8.0))} {
	    $w configure -selectcolor #b03060
	}
	if [info exists form_active_blank($w)] {
	    $w configure -indicatoron 1
	}
    } elseif [info exists form_active_blank($w)] {
	$w configure -state disabled -disabledforeground $form_background \
	    -indicatoron 0
    } else {
	$w configure -state disabled
	if {$reset_selcolor && (!$is_win || ($tcl_version < 8.0))} {
	    $w configure -selectcolor $input_inactivef
	}
    }
}

proc form_radiobutton_edit_params {cw} {
    global form_radiobutton_edit_params
    
    set var [$cw cget -variable]
    
    upvar \#0 $var lvar
    
    # We have to find all the other radiobuttons in this form that have the same
    # variable
    for {set rw $cw} {[winfo parent $rw] != "."} {set rw [winfo parent $rw]} {}
    set allvars [form_collect_children $rw Radiobutton [list variable $var] {value text}]
    
    set form_radiobutton_edit_params(exp) $lvar
    set cur [expression_evaluate $lvar]
    
    set ww .radiobutton_edit_params
    form_kill $ww
    set w [form_init $ww "Option parameter"]
    form_label $w.lab "The value of the expression will determine which\noption is selected.  Listed below are the titles \nof the options and the value you must use to\nenable that option." {0 0 -cols -}
    
    form_label $w.expl "Expression" {1 0}
    form_entry $w.exp form_radiobutton_edit_params(exp) string {1 1 -cols 3}
    
    set r 10
    foreach var $allvars {
	set vv [lindex $var 1]
	if {[scan $vv %g dum] != 1} { set vv \"$vv\" }
	form_label $w.l$r "[lindex $var 2] : " "$r 0"
	form_label $w.v$r $vv "$r 1"
	if {$cur == [lindex $var 1]} {
	    form_label $w.c$r " (CURRENT)" "$r 2"
	}
	incr r
    }
    grid columnconfigure $w 3 -weight 1000
    form_finish +[winfo pointerx $cw]+[winfo pointery $cw]
    if [form_wait $ww] {
	set lvar $form_radiobutton_edit_params(exp)
    }
}

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

## Create a menu button.
## <ul>
## <li> <b>title</b> : the string on the button
## <li> <b>menu</b> : the menu to bind to the button
## </ul>

proc form_menubutton {w title menu tabdata {activedata ""}} {
    global subtitle_font form_label_text
    
    if [info exists form_label_text($w)] { set title $form_label_text($w) }
    if [info exists form_label_text($title)] { set title $form_label_text($title) }
    
    menubutton $w -text $title -menu $menu -font $subtitle_font 

    form_dotab $w $tabdata nw
    form_doactive $w menubutton $activedata
}

## Create a menu button, but make it look like a regular button.
## <ul>
## <li> <b>title</b> : the string on the button
## <li> <b>menu</b> : the menu to bind to the button
## </ul>

proc form_menubutton_regular {w title menu tabdata {activedata ""}} {
    global subtitle_font form_label_text form_pad form_bw
    
    if [info exists form_label_text($w)] { set title $form_label_text($w) }
    if [info exists form_label_text($title)] { set title $form_label_text($title) }
    
    menubutton $w -text $title -menu $menu -font $subtitle_font \
	-relief raised -borderwidth $form_bw -indicatoron 1 -pady 3

    form_dotab $w $tabdata nw
    form_doactive $w menubutton $activedata
}

proc form_menubutton_setstate {w on} {
    if $on {
	$w configure -state normal
    } else {
	$w configure -state disabled
    }
}

proc form_menu_item_setstate {w on item} {
    global input_background input_inactiveb input_inactivef form_active_blank
    global form_background form_inactive_nogray
    
    if $on {
	$w entryconfigure $item -state normal
    } else {
	$w entryconfigure $item -state disabled
    }
}

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

## Create a menu button and menu and define the text of the button to be the
## current value of the variable controlled by the menu.
## <ul>
## <li> <b>var</b> : the variable whose value is controlled by the menu
## <li> <b>opts</b> : a list of { value name } pairs
## which are added to the menu
## </ul>

proc form_optionmenu {w var opts tabdata {activedata ""} {changecmd ""}} {
    global form_optionmenu_options
    
    upvar \#0 $var v
    set name $v
    foreach o $opts {
	set ov [lindex $o 0]; set on [lindex $o 1]
	if {$on == ""} { set on $ov }
	if {$ov == $v} { set name $on }
    }

    form_menubutton_regular $w $name $w.m $tabdata $activedata
    menu $w.m -tearoff 0
    set rw 0
    foreach o $opts {
	set ov [lindex $o 0]; set on [lindex $o 1]
	if {$on == ""} { set on $ov }
	if { $on != "separator" } {
	    $w.m add command -label $on -command \
		"[list set $var $ov]; [list $w configure -text $on]; $changecmd"
	    set r [string length $on]
	    if {$r > $rw} { set rw $r }	    
	} else {
	    $w.m add separator
	}
    }
    $w configure -width [expr $rw + 1]
    form_add_save $var "" "form_optionmenu_update $w $var"
    set form_optionmenu_options($w) $opts
}

proc form_optionmenu_update {w var args} {
    global form_optionmenu_options
    upvar \#0 $var v
    set name $v
    foreach o $form_optionmenu_options($w) {
	set ov [lindex $o 0]; set on [lindex $o 1]
	if {$on == ""} { set on $ov }
	if {$ov == $v} { set name $on }
    }
    $w configure -text $name
}


## Create a menu button and menu and define the text of the button to be the
## current value of the variable controlled by the menu.  The list of
## available options is returned by a function that gets called every time
## the menu is posted.
## <ul>
## <li> <b>var</b> : the variable whose value is controlled by the menu
## <li> <b>opts</b> : a list of { value name } pairs
## which are added to the menu
## </ul>

proc form_optionmenu_dynamic {w var func tabdata {activedata ""}} {
    upvar \#0 $var v
    set opts [eval $func]
    set rw 0
    foreach o $opts {
	set ov [lindex $o 0]; set on [lindex $o 1]
	if {$on == ""} { set on $ov }
	if {$ov == $v} { set v $on }

	set r [string length $on]
	if {$r > $rw} { set rw $r }
	
    }
    form_menubutton_regular $w $v $w.m $tabdata $activedata
    menu $w.m -postcommand [list form_optionmenu_dynamic_post $w $var $func]
    $w configure -width $rw
}

proc form_optionmenu_dynamic_post {w var func} {
    $w.m delete 0 1000
    foreach o [eval $func] {
	set ov [lindex $o 0]; set on [lindex $o 1]
	if {$on == ""} { set on $ov }
	if { $on != "separator" } {
	    $w.m add command -label $on -command \
		"[list set $var $ov]; [list $w configure -text $on]"
	} else {
	    $w.m add separator
	} 
    }
}

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

## Create a menu button and menu and fill it with the given commands.

proc form_commandmenu {w text commands tabdata {activedata ""}} {
    form_menubutton $w $text $w.m $tabdata $activedata
    menu $w.m -tearoff 0
    foreach c $commands {
	eval $w.m add $c
    }
}

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

## Create a label with the given value.  If <b>try_ltext</b> is 1 then
## the language-specific lookup tables will be checked

proc form_label {w title tabdata {activedata ""} {try_ltext 1} {justify ""}} {
    global subtitle_font form_label_text
    global ai_environment
   
    if { ([info exists ai_environment] && $ai_environment) } {
	variable ::AIEnv::GUIManagement::GUIDisplayData
	set subtitle_font $::AIEnv::GUIManagement::GUIDisplayData("LabelFont")
    }
    
    if $try_ltext {
	set t2 [string trim $title]
	if [info exists form_label_text($w)] { set title $form_label_text($w) }
	if [info exists form_label_text($t2)] { set title $form_label_text($t2) }
    }
    
    set anchor w
    set k [lsearch $tabdata "-anchor"]
    if {$k > -1} {
       set anchor [lindex $tabdata [expr $k +1]]
       if {$anchor == ""} {set anchor w}
    }
    label $w -text $title -font $subtitle_font -anchor $anchor
    if {$justify != ""} { $w configure -justify $justify }

    form_dotab $w $tabdata nw
    form_doactive $w label $activedata
}

## Create a label with a bitmap

proc form_label_bitmap {w bitmap tabdata {activedata ""}} {
    global subtitle_font
    
    label $w -bitmap $bitmap -anchor w

    form_dotab $w $tabdata nw
    form_doactive $w label $activedata
}

## Create a label with an image

proc form_label_image {w file tabdata {activedata ""}} {
    global form_images
    if [info exists form_images($file)] {
	set im $form_images($file)
    } else {
	set im [image create photo -file $file]
	set form_images($file) $im
    }
    label $w -image $im -anchor w

    form_dotab $w $tabdata nw
    form_doactive $w label $activedata
}

## Create a label attached to a variable.

proc form_label_variable {w var tabdata {activedata ""}} {
    global subtitle_font form_label_text
    
    label $w -textvariable $var -font $subtitle_font -anchor w

    form_dotab $w $tabdata nw
    form_doactive $w label $activedata
}

proc form_label_setstate {w on} {
    global input_inactivef form_active_blank form_background
    
    if $on {
	$w configure -foreground black
    } else {
	if [info exists form_active_blank($w)] {
	    $w configure -foreground $form_background
	} else {
	    $w configure -foreground $input_inactivef
	}
    }
}

proc form_label_settext {w text} {
    global form_label_text
    
    set t2 [string trim $text]
    
    if [info exists form_label_text($t2)] {
	set text $form_label_text($t2)
    }
    $w configure -text $text
}

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

## Create a message widget
## <ul>
## <li> <b>text</b> : the text to put in the widget
## </ul>

proc form_message {w text tabdata {activedata ""}} {
    global subtitle_font form_label_text
    
    if [info exists form_label_text($w)] { set text $form_label_text($w) }
    if [info exists form_label_text($text)] { set text $form_label_text($text) }
    
    message $w -text $text -font $subtitle_font -justify left -anchor w \
	    -aspect 400
    
    form_dotab $w $tabdata nwes
    form_doactive $w message $activedata
}

proc form_message_setstate {w on} {
    global input_inactivef
    
    if $on {
	$w configure -foreground black
    } else {
	$w configure -foreground $input_inactivef
    }
}
# ---------------------------------------

## Create a scale widget.
## <ul>
## <li> <b>var</b> : the variable whose value is controlled by the scale
## <li> <b>command</b> : a command to issue each time the scale moves
## <li> <b>orient</b> : <b>v</b> for vertical and <b>h</b> for horizontal
## <li> <b>min</b> : the minimum value for the scale
## <li> <b>max</b> : the maximum value for the scale
## <li> <b>incr</b> : the minimum increment in the value
## <li> <b>on_release</b> : a command to execute when the scale button
## is released
## </ul>

proc form_scale {w var command orient min max incr tabdata {activedata ""} \
		     {on_release ""} {width ""}} {
    scale $w -variable $var -command $command -orient $orient \
	-from $min -to $max -resolution $incr
    if {$width != ""} { $w configure -length $width }
    #bind $w <Button1-Motion> $command
    
    if {$on_release != ""} {
	bind $w <ButtonRelease-1> $on_release
    }
    form_add_save $var
    
    form_dotab $w $tabdata news
    form_doactive $w scale $activedata
}

proc form_scale_setstate {w on} {
    global input_inactivef
    
    if $on {
	$w configure -state normal -foreground black
    } else {
	$w configure -state disabled -foreground $input_inactivef
    }
}

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

## Create an empty frame.

proc form_frame {w relief borderwidth tabdata} {
    frame $w -relief $relief -borderwidth $borderwidth
    if {$tabdata != ""} {
	if !$borderwidth { append tabdata " -padx 0" }
	set stick nw
	if {([lsearch $tabdata -fill] < 0) &&
	    ([lsearch $tabdata -sticky] < 0) && ($relief != "flat")} {
	    set stick nwes
	}
	form_dotab $w $tabdata $stick
    }
}

## Create an empty frame with a label and return the inner part.

proc form_label_frame {w label tabdata {act ""}} {
    global form_label_text
    if [info exists form_label_text($label)] {
	set label $form_label_text($label)
    }
    TitleFrame $w -text $label -side left
    if {$tabdata != ""} {
	set stick nw
	if {([lsearch $tabdata -fill] < 0) &&
	    ([lsearch $tabdata -sticky] < 0)} {
	    set stick nwes
	}
	form_dotab $w $tabdata $stick
    }
    set fr [$w getframe]
    grid columnconfigure $fr 1000 -weight 1000 -minsize 0
    grid rowconfigure $fr 1000 -weight 1000 -minsize 0
    if {$act != ""} {
	form_doactive $w label_frame $act
    }
    return $fr
}

proc form_label_frame_setstate {w on} {
    if $on {
	$w configure -fg black
    } else {
	$w configure -fg gray
    }
}

## Create an empty frame that can be used with the <b>form_setup_switch</b>
## function.

proc form_choiceframe {w} {
    form_frame $w flat 0 ""
}

proc form_subframe {w sub} {
    if {[pack slaves $w] != $sub} {
	foreach sl [pack slaves $w] { pack unpack $sl }
	if {$sub != ""} {
	    pack $sub -in $w -fill both -expand 1
	}
    }
}

## Create an underline.

proc form_underline {w tabdata} {
    frame $w -relief flat -borderwidth 0 -height 1 -background black
    form_dotab $w $tabdata ew
}

## After creating a number of sub-frames using <b>form_choiceframe</b>, 
## which must all be children of a single parent frame, this function
## sets up a trace on a variable which makes which subframe is visible
## depend on the value of the variable.  If the subframes are
## <b>$d.sub.val1</b>, <b>$d.sub.val2</b>, etc, and there is a variable
## <b>choicevar</b> which is maybe controlled by a set of radiobuttons
## elsewhere on the form, and can have the values <b>val1</b>,
## <b>val2</b>, etc, then
## <b>form_setup_switch $d.sub choicevar</b> would set this up.
## The other arguments:
## <ul>
## <li> <b>opts</b> : extra options that can be passed through to the
## place command that actually puts the subframe in the parent
## <li> <b>cmd</b> : a command that gets executed after the switch is done
## </ul>

proc form_setup_switch {frame varname {opts ""} {cmd ""} {change_size 1}} {
    return [futil_setup_switch $frame $varname $opts $cmd $change_size]
}

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

## Create a scrolled window.
## <ul>
## <li> <b>maxh</b> : the maximum height for the outside window
## <li> <b>hfixed</b> : if non-0, the fixed height for the outside window
## <li> <b>wfixed</b> : if non-0, the fixed width for the outside window
## </ul>
## The return value is a sub-frame that you can then use to put other
## widgets in.

proc form_scroller {w maxh tabdata {hfixed 0} {wfixed 0}} {
    global form_scroller_prev form_scroller_maxh form_bw
    
    frame $w -relief flat -borderwidth 0 -height $maxh
    set tabdata "$tabdata -padx 0"
    form_dotab $w $tabdata news
    
    scrollbar $w.scroll -command "$w.c yview" -relief sunken \
	    -borderwidth $form_bw -orient v
    canvas $w.c -yscrollcommand "$w.scroll set" -height $maxh
    set hscroll 0
    if {$wfixed > 0} {
	$w.c configure -width $wfixed
    } elseif {$wfixed < 0} {
	$w.c configure -width [expr -$wfixed]
	set hscroll 1
	
	scrollbar $w.hscroll -command "$w.c xview" -relief sunken \
	    -borderwidth $form_bw -orient h
	$w.c configure -xscrollcommand "$w.hscroll set"
    }
    if { [ info commands grid ] == "" } {
	pack $w.c -side left -fill both -expand 1
        pack $w.scroll -side left -fill y
    } else {
        grid $w.c -sticky news -row 0 -column 0
        grid $w.scroll -sticky ns -row 0 -column 1
        if $hscroll {
	    grid $w.hscroll -sticky ew -row 1 -column 0
        }
	if !$hfixed {
	    grid rowconfigure $w 0 -weight 1000
	}
    }
    frame $w.c.win
    set fitem [$w.c create window 0 0 -window $w.c.win -anchor nw]
    bind $w.c.win <Configure> "form_scroller_update $w $hfixed $wfixed"
    #bind $w.c.win <Map> "form_scroller_update $w $hfixed"
    set form_scroller_prev($w.c) ""
    set form_scroller_maxh($w.c) $maxh
    
    return $w.c.win
}

proc form_scroller_update {w hfixed {wfixed 0}} {
    global form_scroller_prev form_scroller_maxh
    
    set can $w.c
    set maxh $form_scroller_maxh($can)
    set w [winfo reqwidth $can.win]
    set h [winfo reqheight $can.win]
    if {$form_scroller_prev($can) == "$w $h"} return
    set form_scroller_prev($can) "$w $h"
    
    set wh $h; set ww $w
    if {($wh > $maxh) || $hfixed} { set wh $maxh }
    if {$wfixed} { set ww [expr abs($wfixed)] }
    if {!$hfixed || !$wfixed} {
	$can configure -width $ww -height $wh
    }
    $can configure -scrollregion "0 0 $w $h"
    $can yview moveto [lindex [$can yview] 0]
}

proc form_scroller_hack {w} {
    after 1 "$w configure -height [expr {[winfo reqheight $w] + 1}]"
}

proc form_label_text {w {def ""}} {
    global form_label_text 
    if [info exists form_label_text($w)] { return $form_label_text($w) }
    if {$def != ""} { return $def } else { return $w }
}

proc form_set_label_text {pairs} {
    global form_label_text 
    
    array set form_label_text $pairs
}

## Because of some strange window system interactions, after calling
## <b>form_finish</b> you should call this function for each scroller in the
## form, otherwise the size will not be quite right.

proc form_scroller_adjust {d} {
    $d.fr configure -height [expr {[winfo reqheight $d.fr] + 1}]
}

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

proc form_collect_children {win class req fields} {
    if {[winfo class $win] == $class} {
	set ok 1
	foreach {var val} $req {
	    if {[$win cget -$var] != $val} { set ok 0 }
	}
	if $ok {
	    set ret [list $win]
	    foreach f $fields {
		lappend ret [$win cget -$f]
	    }
	    return [list $ret]
	} else {
	    return ""
	}
    } else {
	set ret {}
	foreach ch [winfo children $win] {
	    set ret [concat $ret [form_collect_children $ch $class $req $fields]]
	}
	return $ret
    }
}

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

if $has_blt {
    if {$tcl_version < 8.0} {
	proc blt_table_column {w args} {
	    eval blt_table column $w $args
	}
	
	proc blt_table_row {w args} {
	    eval blt_table row $w $args
	}
	proc blt_table_slaves {w} {
	    return [blt_table slaves $w]
	}
    } else {
	proc blt_table_column {w args} {
	    set what [lindex $args 0]
	    set num [lindex $args 1]
	    set rest [lrange $args 2 end]
	    regsub -all Inf $rest 1000 rest
	    eval blt_table $what $w c$num $rest
	}
	
	proc blt_table_row {w args} {
	    set what [lindex $args 0]
	    set num [lindex $args 1]
	    set rest [lrange $args 2 end]
	    regsub -all Inf $rest 1000 rest
	    eval blt_table $what $w r$num $rest
	}
	proc blt_table_slaves {w} {
	    return [blt_table search $w]
	}
	if $has_blt {
	    foreach cmd { table busy graph bell } {
		proc blt_$cmd {args} "return \[eval blt::$cmd \$args\]"
	    }
	}
    }
}

proc grid_uniform_cols {par widgets} {
    set maxw 1
    foreach c $widgets {
	set bad 0
	foreach {n v} [grid info $par.$c] {
	    if {$n == "-column"} { set found($v) 1 }
	    if {($n == "-columnspan") && ($v > 1)} { set bad 1 }
	}
	if $bad continue
	set w [winfo reqwidth $par.$c]
	if {$w > $maxw} { set maxw $w }
    }
    incr maxw 10
    foreach c [array names found] {
	grid columnconfigure $par $c -minsize $maxw -weight 0
    }
}

if {$tcl_version < 8.0} {
    if $is_win {
	proc set_cursor {w spec} { $w configure -cursor arrow }
    } else {
	proc set_cursor {w spec} { $w configure -cursor $spec }
    }
}

proc form_auto_raise {w} {
    global is_win
    if !$is_win return
    if {([bind $w <Visibility>] == "") && ([info commands clock] != "")} {
	bind $w <Visibility> "form_auto_raise_window $w %s"
    }
}

proc form_auto_raise_window {w state} {
    global auto_raise_lasttime auto_raise_forms tk::Priv
    global toplevel
    
    if {[info exists toplevel(single)] && $toplevel(single)} return

    if {!$auto_raise_forms || ($state == "VisibilityUnobscured") || \
	    ([winfo parent $w] != ".") || ($tk::Priv(postedMb) != "")} return
    foreach p {.bubble_win .pathentry_popup .file_select.menu} {
	if {[winfo exists $p] && [winfo ismapped $p]} return
    }
    set now [clock seconds]
    if {[info exists auto_raise_lasttime($w)] && \
	    ($now == $auto_raise_lasttime($w))} return
    set auto_raise_lasttime($w) $now
    
    raise $w; update
}

proc form_notebook {w pages tabdata} {
    NoteBook $w
    set ret ""
    foreach page $pages {
	lappend ret [eval form_notebook_addpage $w $page]
    }
    form_dotab $w $tabdata nw
    return $ret
}

proc form_notebook_addpage {w name title {act ""} {raisecmd ""}} {
    global form_label_text
    set state normal
    if {($act != "") && ![form_checkstate $act]} { set state disabled }
    if [info exists form_label_text($title)] {
	set title $form_label_text($title)
    }
    set ret [$w insert end $name -text $title -state $state \
		 -raisecmd $raisecmd]
    if {[winfo children $ret] != ""} { return "" }  ;# it was already filled in
    form_doactive $w notebook $act $name
    return $ret
}

proc form_notebook_deletepage {w name} {
    $w delete $name 0
}

proc form_notebook_finish {w {nofill ""}} {
    foreach p [$w pages] {nfw nfh} $nofill {
	if {$nfw != "0"} {
	    # make sure that extra space is at the bottom rather that spread out
	    grid rowconfigure [$w getframe $p] 1000 -weight 1000
	}
	if {$nfh != "0"} {
	    grid columnconfigure [$w getframe $p] 1000 -weight 1000
	}
    }
    $w compute_size
    $w raise [$w pages 0]
}

proc form_notebook_setstate {w on page} {
    global input_background input_inactiveb input_inactivef form_active_blank
    global form_background form_inactive_nogray
    
    if $on {
	$w itemconfigure $page -state normal
    } else {
	$w itemconfigure $page -state disabled
    }
}

proc form_paned {w ch_opts side tabdata} {
    if {$side == "h"} { set pside bottom } else { set pside left }
    PanedWindow $w -side $pside -pad 0
    set ret ""
    foreach ch $ch_opts {
	lappend ret [eval $w add $ch]
    }
    form_dotab $w $tabdata nwes
    return $ret
}

proc form_scrollwin {w width height tabdata {opts ""}} {
    set sw [eval ScrolledWindow \"$w\" $opts]
    set sf [ScrollableFrame $sw.f -width $width -height $height]
    $sw setwidget $sf
    set subf [$sf getframe]
    form_dotab $w $tabdata nwes
    return $subf
}

proc form_tree {w tabdata {opts ""}} {
    set sw [ScrolledWindow $w]
    form_dotab $w $tabdata nwes
    set tree $sw.tree
    Tree $tree -relief flat -borderwidth 0
    if {$opts != ""} { eval $tree configure $opts }
    $sw setwidget $tree
    return $tree
}

