
# This code creates the ICEM CFD Manager.
#
# Copyright (c) 1993 - 1996 Pacific Marketing and Consulting, Inc,
#       and ICEM Systems, GmbH.  All rights reserved.
# Author:  Wayne A. Christopher, wayne@icemcfd.com

# A utility routine to do dialog boxes.
#
# This function takes a list of options and prompts the user to fill in
# the blanks.  Each option is of the form
#   {name options}
# options can be: -type type -title title -opt options -active predicates
#                 -group group -help helpstring
# name is the name of a variable in the calling frame, must be unique
# type can be one of choice, string, or path
# title is a string to be put to the left of the choices
# in the case of choice, option is a list of {name val} pairs
# predicates is an expression that, when evaluated in the upper context,
#   will say whether this option should be presented or not
# if group is 1, then this option will be attached to the one above
# helpstring is a help string

proc dialog {w title mess entries} {
    
    # Make sure we are the only dialog open.
    global dialog_status
    set dialog_status 0
    
    catch {top_destroy $w}
    
    set nmess "$mess\n"
    
    top_window $w 1 $title
    message $w.mess -text $nmess -aspect 400
    frame $w.ents -relief ridge -borderwidth 2
    frame $w.buts
    catch {wm transient $w [winfo toplevel .v]}

    set bback [$w cget -background]

    pack $w.mess -side top -fill both
    pack $w.ents -side top -fill both -padx 4 -pady 4
    pack $w.buts -side top -fill both
    
    button $w.buts.done -text Done -command "set dialog_status 1" \
	-relief raised -borderwidth 2
    button $w.buts.cancel -text Cancel -command "set dialog_status 0" \
	-relief raised -borderwidth 2
    
    pack $w.buts.done -side left -padx 4 -pady 4 -fill both -expand 1
    pack $w.buts.cancel -side left -padx 4 -pady 4 -fill both -expand 1

    #help_define $w $helpmess
    
    set maxlabwidth 0
    
    global dialog_active_names dialog_active_exprs
    global dialog_active_on_commands dialog_active_off_commands
    catch {unset dialog_active_exprs}
    catch {unset dialog_active_on_commands}
    catch {unset dialog_active_off_commands}
    set dialog_active_names {}
    
    set to_repl {}
    set vars_to_trace {}

    foreach ent $entries {
	set name [lindex $ent 0]
	set type unknown
	set title ""
	set options {}
	set active 1
	set group ""
	set help "No help is available for this option"
	
	set nopt [llength $ent]
	for {set i 1} {$i < $nopt} {incr i} {
	    set opt [lindex $ent $i]
	    incr i
	    if {$i == $nopt} {error "Mismatched -opt val pair"}
	    set val [lindex $ent $i]
	    
	    switch -- $opt {
		-type   {set type $val}
		-title  {set title $val; append title ":  "}
		-opt    {set options $val}
		-active {set active $val}
		-group  {set group $val}
		-help   {set help $val}
		default {error "Unknown option $opt"}
	    }
	}

	switch $type {
	    choice - unknown {
		set type choice
		if {$options == {}} {set options {{Yes 1} {No 0}}}
		if [catch {uplevel set $name} defvalue] {
		    set defvalue [lindex [lindex $options 0] 1]
		}
	    }
	    string {
		if {$options != {}} {error "Options not allowed for string"}
		if [catch {uplevel set $name} defvalue] {set defvalue ""}
	    }
	    path {
		if {$options != {}} {error "Options not allowed for path"}
		if [catch {uplevel set $name} defvalue] {set defvalue [pwd]/}
	    }
	    default {error "Bad type $type for $name"}
	}
	set type_used($name) $type
	
	global [lindex [split dialog_var_$name \(] 0]
	set dialog_var_$name $defvalue
	
	if {$type == "choice"} {
	    lappend vars_to_trace variable dialog_var_$name
	}
	
	if {[info exists lastgroup] && (($group == "") || ($group != $lastgroup))} {
	    frame $w.ents.above__$name -relief flat -borderwidth 0
	    pack append $w.ents $w.ents.above__$name {top fill}
	}
	
	# *** this must be fixed -- name might not be a valid window name
	frame $w.ents.$name
	pack $w.ents.$name -side top -fill both
	
	# These are the commands to turn on and off this entry.
	set on_command ""
	set off_command ""

	# Always make a title box.
	label $w.ents.$name.label -text $title -relief flat -borderwidth 0 -anchor e
	if {$help != ""} { bubble_define $w.ents.$name.label $help }
	pack append $w.ents.$name $w.ents.$name.label {left fill}
	set width [winfo reqwidth $w.ents.$name.label]
	if {$width > $maxlabwidth} {set maxlabwidth $width}
	append on_command  "; $w.ents.$name.label configure -foreground black"
	append off_command "; $w.ents.$name.label configure -foreground gray"
	lappend titles $w.ents.$name.label

	switch $type {
	    choice {
		set which -1
		set num 0
		foreach opt $options {
		    set n [lindex $opt 0]
		    set v [lindex $opt 1]
		    radiobutton $w.ents.$name.$num -text $n -value $v \
			-variable dialog_var_$name -background $bback
		    if {$help != ""} { bubble_define $w.ents.$name.$num $help }
		    pack $w.ents.$name.$num -side left
		    # {left fill expand}
		    if {$v == $defvalue} {set which $num}
		    set scol [lindex [$w.ents.$name.$num configure -selectcolor] 4]
		    append on_command  "; $w.ents.$name.$num configure -state normal \
                            -selectcolor $scol"
		    append off_command "; $w.ents.$name.$num configure -state disabled \
                            -selectcolor gray"
		    incr num
		}
		lappend to_repl $name
		# if {$which == -1} {error "Value for $name ($defvalue) not a choice"}
	    }
	    string {
		entry $w.ents.$name.ent -relief sunken -borderwidth 2 -background white \
		    -width [string length $defvalue]
		$w.ents.$name.ent insert end $defvalue
		bind $w.ents.$name.ent <Return> "set dialog_status 1"
		pack append $w.ents.$name $w.ents.$name.ent {left fill expand}
		append on_command  "; $w.ents.$name.ent configure -state normal \
			-foreground black"
		append off_command "; $w.ents.$name.ent configure -state disabled \
			-foreground gray"
		if {$help != ""} { bubble_define $w.ents.$name.ent $help }
	    }
	    path {
		entry $w.ents.$name.ent -relief sunken -borderwidth 2 -background white \
		    -width [string length $defvalue]
		$w.ents.$name.ent insert end $defvalue
		pack append $w.ents.$name $w.ents.$name.ent {left fill expand}
		pathentry on $w.ents.$name.ent
		append on_command  "; $w.ents.$name.ent configure -state normal \
			-foreground black"
		append off_command "; $w.ents.$name.ent configure -state disabled \
			-foreground gray"
		if {$help != ""} { bubble_define $w.ents.$name.ent $help }
	    }
	}
	
	if {$active != 1} {
	    lappend dialog_active_names $name
	    set dialog_active_exprs($name) $active
	    set dialog_active_on_commands($name) $on_command
	    set dialog_active_off_commands($name) $off_command
	}
	
	# This must be done after all the subwindows are created.
	# help_define $w.ents.$name $help
	
	set lastgroup $group
    }
    
    # This is really wierd.  How many characters correspond to a given width
    # in pixels?
    label $w.fruitcake -width 1
    set nc 1
    while {[winfo reqwidth $w.fruitcake] < $maxlabwidth} {
	incr nc
	$w.fruitcake configure -width [expr {$nc + 1}]
    }
    destroy $w.fruitcake
    
    #puts stdout "maxlabwidth is $maxlabwidth, $nc chars"
    foreach t $titles {
	$t configure -width [expr {$nc + 2}]
    }
    
    # Now rewrite all the active predicates.  This is kind of wierd.
    foreach n $dialog_active_names {
	set dialog_active_exprs($n) \
	    [dialog_rewrite $dialog_active_exprs($n) $to_repl dialog_var_]
    }
    foreach v $vars_to_trace {
	trace variable $v w "dialog_check_active; list"
    }
    
    dialog_check_active
    
    if {[string match SunOS* [cmd_uname_a]] } {
        top_geometry $w +300+250
    } else {
        top_geometry $w +300+300
    }
    form_auto_raise $w
    wm protocol $w WM_DELETE_WINDOW "set dialog_status 0"
    tkwait variable dialog_status
    foreach v $vars_to_trace {
	trace vdelete $v w "dialog_check_active; list"
    }
    
    if {!$dialog_status} {top_destroy $w; return 0}
    
    foreach ent $entries {
	set name [lindex $ent 0]
	upvar 1 $name lname
	switch $type_used($name) {
	    choice {
		set lname [set dialog_var_$name]
	    }
	    string - path {
		set lname [$w.ents.$name.ent get]
	    }
	}
    }
    
    top_destroy $w
    return 1
}

proc dialog_rewrite {expr replace prefix} {
    # Go through the expression and replace every variable reference in the
    # replace list with one that begins with prefix.  We may as well do this
    # inefficiently.  We assume that variables have only the chars [a-zA-Z0-9_:].
    
    set ret ""
    set len [string length $expr]
    set gotvar 0
    for {set i 0} {$i <= $len} {incr i} {
	set c [string index $expr $i]
	if $gotvar {
	    if [string match {[a-zA-Z0-9_:]} $c] {
		append varname $c
	    } else {
		incr i -1
		foreach r $replace {
		    if {$r == $varname} {
			set varname "$prefix$varname"
			break
		    }
		}
		append ret "\$$varname"
		set gotvar 0
	    }
	} else {
	    if {$c == "\$"} {
		set gotvar 1
		set varname ""
	    } else {
		append ret $c
	    }
	}
    }

    #puts "called dialog_rewrite $expr $replace $prefix, res is $ret"

    return $ret
}

proc dialog_check_active {} {
    global dialog_active_names dialog_active_exprs
    global dialog_active_on_commands dialog_active_off_commands

    foreach n $dialog_active_names {
	if [catch {uplevel #0 expr \{$dialog_active_exprs($n)\}} val] {
	    puts stderr "Error: bad expression $dialog_active_exprs($n)"
	    return
	}
	
	if $val {
	    eval $dialog_active_on_commands($n)
	} else {
	    eval $dialog_active_off_commands($n)
	}
    }
}
