
# 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

if {$is_win && [info exists env(LANG)] && ([string tolower $env(LANG)] == "jp")} {
    set use_win_menus 0
} else {
    set use_win_menus 1
}

proc make_main_window {{orient v}} {
    global tdv_default vwindow_fills_screen use_embed
    global bigfont full_size env guibase_dir busy_cur
    global mainwindow_menubar no_pack_main tdv_viewer
    global title_font is_win

    if ![info exists title_font] form_fonts

    set busy_cur [list @$guibase_dir/busy.cur orange]

    set full_size 0
    if $is_win {
        set gg "200 150"
    } else {
        set gg "0 50"
    }
    if [info exists env(ICEPAK_DOT_GEOMETRY)] {
	set gg $env(ICEPAK_DOT_GEOMETRY)
    }
    set w1 [expr [winfo screenwidth .] - [lindex $gg 0]]
    set h1 [expr [winfo screenheight .] - [lindex $gg 1]]
    if [info exists vwindow_fills_screen] {
	frame .v
	pack .v -fill both -expand 1
    } else {
	if {[info exist use_embed] && ($use_embed != "")} {
	   top_window .v 0 "" "" "" 0 1 Toplevel "" 1 $use_embed

           update idletasks
           wm withdraw .
	} else {
	   top_window .v 0 "" "" "" 0 1
	}

	if {[info commands right_after_create_dotv] != ""} {
	    right_after_create_dotv
	}

	top_geometry .v ${w1}x${h1}+0+0
    }

    if {[info commands setup_graphics_window] != ""} {
	# If this routine is available it had better create a window
	# called .v.view
	setup_graphics_window
    } else {
	frame .v.view -width 500 -height 500 -background black
    }
    label .v.banner -background black -foreground red -font $bigfont

    frame .v.top

    if ![info exists mainwindow_menubar] {
	set mainwindow_menubar 0
	foreach i {ICEM ICEPAK AIRPAK ORCA TDM STARLT} {
	    if {[info exists env(${i}_USE_MENUBAR)] && $env(${i}_USE_MENUBAR)} {
		set mainwindow_menubar 1
	    }
	}
    }

    if $mainwindow_menubar {
	make_main_window_menubar .v.top
    } else {
	make_main_window_regular .v.top $orient
    }
    if $mainwindow_menubar {
	grid .v.top -row 0 -column 0 -columnspan 2 -sticky ew
	grid rowconfigure .v 0 -weight 1
	grid rowconfigure .v 1 -weight 10000
	grid columnconfigure .v 0 -weight 10000
	grid columnconfigure .v 1 -weight 1
	if [catch {pack info $tdv_default}] {
	    grid $tdv_default -row 1 -column 0 -sticky news
	}

    } elseif !$no_pack_main {
	if {$orient == "h"} {
	    pack .v.top -side left -fill y
	    if [catch {pack info $tdv_default}] {
		pack $tdv_default -side right -fill both -expand 1
	    }
	} else {
	    pack .v.top -side top -fill x
	    if [catch {pack info $tdv_default}] {
		pack $tdv_default -side top -fill both -expand 1
	    }
	}
    }
    set_title ""
    if [info exists vwindow_fills_screen] {
	wm geometry . ${w1}x${h1}+0+0
	global va_win
	if ![info exists va_win(do_not_show_main)] { 
	wm deiconify .
	}
        if {$is_win && ![info exists env(ICEPAK_DOT_GEOMETRY)]} {
            wm state . zoomed
        }
	update
    }
    wm protocol . WM_DELETE_WINDOW {exit 0}
    if [winfo exists .startup] { destroy .startup }
}

proc make_main_window_regular {vt {orient v}} {
    global current_phase tool_phases tool_extra
    global tool_phase_info
    global bigfont
    global has_blt extra_position
    global small_screen_hack num_panel_spaces
    global env

    if ![info exists num_panel_spaces] { set num_panel_spaces 6 }

    make_main_window_logo $vt 1

    set two 2
    if $small_screen_hack { set two 0 }

    frame $vt.panel1 -borderwidth 2 -relief flat
    frame $vt.panel2 -borderwidth 2 -relief sunken
    frame $vt.extras -borderwidth 2 -relief raised

    button $vt.extras.help \
	-text [form_label_text $vt.extras.help Help] \
	-borderwidth 2 -relief raised -command "help_main_topic" -width 5

    make_orient_button $vt.extras.orient

    global no_tool_extra_msgs
    if [info exist no_tool_extra_msgs] {
       set pre_buts {help orient}
    } else {
       set pre_buts {help orient msgs}
       button $vt.extras.msgs -text "" -command message_window_visible \
            -anchor w
    }
    if {[make_opt_button $vt.extras.opts] != ""} {
	lappend pre_buts opts
    }
    
    if ![info exists extra_position(help)] {
	set extra_position(help)   2,1
    }
    if ![info exists extra_position(orient)] {
	set extra_position(orient) 2,2
    }
    if ![info exists extra_position(view)] {
	set extra_position(view)   3,1
    }
    if ![info exists extra_position(opts)] {
        set extra_position(opts)   3,2
    }
    if ![info exists extra_position(msgs)] {
	set extra_position(msgs)   4,1
    }
    if ![info exists extra_position(full)] {
	set extra_position(full)   9,2
    }
    
    if ![info exists tool_extra(1)] {
	menubutton $vt.extras.view \
	    -text [form_label_text $vt.extras.view View] \
	    -borderwidth 2 -relief raised -width 5
	if {[info commands setup_display_menu_func] == ""} {
	    setup_display_menu $vt.extras.view
	} else {
	    setup_display_menu_func $vt.extras.view
	}
	if $has_blt {
	    blt_table $vt.extras $vt.extras.view \
		$extra_position(view) -padx $two -pady $two -fill both
	} else {
	    set rc [split $extra_position(view) ,]
	    grid $vt.extras.view -row [lindex $rc 0] -column [lindex $rc 1]\
		-padx $two -pady $two -sticky nsew
	}
    }
    foreach i $pre_buts {
	if ![info exists extra_position($i)] continue
	if $has_blt {
	    blt_table $vt.extras $vt.extras.$i $extra_position($i) \
		-padx $two -pady $two -fill both
	} else {
	    set rc [split $extra_position($i) ,]
	    grid $vt.extras.$i -row [lindex $rc 0] -column [lindex $rc 1]\
		-padx $two -pady $two -sticky nsew
	}
	    
    }
    
    if {$orient == "h"} {
       if {[llength $tool_phases] > 1} {
          pack $vt.logo  $vt.panel1 $vt.panel2 -side top \
                  -fill both -padx $two -pady $two
       } else {
          pack $vt.logo $vt.panel2 -side top \
                  -fill both -padx $two -pady $two
       }
       pack $vt.extras -side bottom -fill both -padx $two -pady $two

    } else {
       pack $vt.logo -side left -fill both -padx $two -pady $two
       pack $vt.extras -side right -fill both -padx $two -pady $two
       if {[llength $tool_phases] > 1} {
          pack $vt.panel1 -side top -fill both -padx $two
       }
       pack $vt.panel2 -side top -fill both -expand 1 -padx $two -pady $two \
            -anchor n
   }
    
    foreach i [lsort -integer [array names tool_extra]] {
	set ex $tool_extra($i)
	if {$ex == ""} continue
	set x [expr {($i + 1) % 2 + 1}]
	set y [expr {(7 + $i) / 2}]
	if ![info exists extra_position(extra$i)] {
	    set extra_position(extra$i) $y,$x
	}
	
	set but $vt.extras.extra$i
	set txt [form_label_text $but [lindex $ex 1]]
	switch [lindex $ex 0] {
	    blank {
		label $but
	    }
	    button {
		button $but -borderwidth 2 -relief raised \
		    -text $txt -command [lindex $ex 2]
	    }
	    menubutton {
		set menu $but.m
		menubutton $but -text $txt \
			-borderwidth 2 -relief raised -menu $menu -width 5
		menu $menu
		foreach xx [lrange $ex 2 end] {
		    eval $menu add $xx
		}
	    }
	}
	
	if $has_blt {
	    blt_table $vt.extras $vt.extras.extra$i \
	    $extra_position(extra$i) -padx $two -pady $two -fill both
	} else {
	    set rc [split $extra_position(extra$i) ,]
	    grid $vt.extras.extra$i -row [lindex $rc 0] \
		-column [lindex $rc 1] -padx $two -pady $two -sticky nsew
	}
    }

    if $small_screen_hack {
	foreach r {1 2 3 4} {
	    grid rowconfigure $vt.extras $r -minsize 10 -weight 1
	}
    }
    
    set maxr 0
    foreach ph $tool_phases {
	if {$ph == ""} continue
	foreach b $tool_phase_info([lindex $ph 1]) {
	    if {[lindex $b 0] == "ignore"} continue
	    set r [lindex [split [lindex $b 3] ,] 0]
	    if {$r > $maxr} { set maxr $r }
	}
    }
    if {$maxr == 0} { set maxr 1 }
	
    set pad 2
    if $small_screen_hack { set pad 0 }
    
    set i 1
    set maxwidth 1
    set realmaxwidth [expr [winfo width $vt.panel2] / $maxr - 5]
    foreach ph $tool_phases {
	if {$ph == ""} { incr i; continue }
	set name [lindex $ph 1]
	set label [form_label_text $vt.panel1.$name [lindex $ph 0]]
	radiobutton $vt.panel1.$name -text $label \
	    -variable current_phase -value $name -anchor w -command set_phase \
	    -width 1
	if $has_blt {
	    blt_table $vt.panel1 $vt.panel1.$name 0,$i -fill both
	} else {
	    grid $vt.panel1.$name -row 0 -column $i -sticky nsew -padx $pad
	}

	set panel $vt.panel2.$name
	make_phase_panel $name $maxr $realmaxwidth $panel $orient
	
	if !$has_blt {
	    set ww [winfo reqwidth $vt.panel1.$name]
	    if {$ww > $maxwidth} { set maxwidth $ww }
	}
	incr i
    }
    #if {$maxwidth > $realmaxwidth} { set maxwidth $realmaxwidth }
    if $has_blt {
	blt_table_column $vt.panel1 configure 0 -width 0
	for {set c 1} {$c <= $num_panel_spaces} {incr c} {
	    blt_table_column $vt.panel1 configure $c -width {1 200 1}
	}
    } else {
	set nsp [llength $tool_phases]
	if {$nsp < $num_panel_spaces} { set nsp $num_panel_spaces }
	set width [expr {[winfo width $vt.panel1] / $nsp}]
	grid columnconfigure $vt.panel1 0 -minsize 0 -weight 0
	for {set c 1} {$c <= $nsp} {incr c} {
	    grid columnconfigure $vt.panel1 $c -minsize $width -weight 1
	}
    }
}

proc make_main_window_menubar {vt} {
    global tool_phases tool_extra tool_phase_info tcl_console
    global bigfont extra_position small_screen_hack env toolbar_groups
    global form_background no_main_window_logo mainwindow_menu_pad
    global is_win use_win_menus interrupt_frame
    
    set form_background [$vt cget -background]

    if ![info exists no_main_window_logo] {
	make_main_window_logo $vt 0
    }

    # it would be nice to have the toolbar be a text widget so it could be
    # multi lines and have items automatically flow from one to the other.
    # But we don't have a way to say "make the text widget big enough to
    # contain everything in it" yet.
    #text $tbar -relief flat -borderwidth 0 -height 1

    if [info exists mainwindow_menu_pad] {
	set pad $mainwindow_menu_pad
    } else {
	set pad 2
    }
    if [winfo exists $vt.logo] {
	pack $vt.logo -side left -fill both -padx $pad -pady $pad
    }

    frame $vt.topright -borderwidth 1 -relief raised
    set interrupt_frame $vt.topright
    pack $vt.topright -side right -fill both -expand 1

    if {$is_win && $use_win_menus} {
	set mbar [menu $vt.panel1 -type menubar -relief raised -borderwidth 1]
	. configure -menu $mbar
    } else {
	set mbar $vt.panel1
	frame $mbar -borderwidth 1 -relief raised
        pack $mbar -side top -fill both -padx $pad
    }

    set tbar $vt.panel2
    frame $tbar -relief flat
    pack $tbar -side top -fill x -expand 1 -padx $pad -pady $pad \
	-anchor n

    if ![info exists tcl_console] { set tcl_console 0 }
    tcl_console_update
    
    if {[info command app_last_minute_extra_commands] != ""} {
	app_last_minute_extra_commands
    }

    command_create_menus $mbar

    toolbar_setup $tbar
    command_create_toolbars

    command_create_hotkeys
}

proc make_opt_button {b} {
    global opt_buttons tool_id

    if [info exists opt_buttons] {
       set opts $b.m
       menubutton $b \
           -text [form_label_text $b Options] \
           -borderwidth 2 -relief raised -menu $opts -width 5 -pady 2

       menu $opts
       foreach k $opt_buttons {
          switch [lindex $k 0] {
             cascade {
                add_cascade $opts $k
             }
             ignore {
             }
             default {
                eval $opts add $k
             }
          }
       }

       return $opts
    }
    return ""
}

proc make_orient_button {b} {
    global orient_buttons tool_id
    
    set orient $b.m
    menubutton $b \
	-text [form_label_text $b Orient] \
	-borderwidth 2 -relief raised -menu $orient -width 5 -pady 2

    menu $orient
    
    if {![info exists orient_buttons] || \
	    ([lindex $orient_buttons 0] == "usual")} {
	if {[info procs orient_home_command] != ""} {
	    $orient add command -label "Home" -command orient_home_command
	} else {
	    $orient add command -label "Home" -command "command {orient +z} 0"
	}
	if {$tool_id == "hexa"} {
	    $orient add command -label "Region zoom" -command \
			"orient_command zoom"
	    $orient add command -label "Scale to fit" -command \
			"orient_command automax"
	}
	#$orient add command -label "Scale to fit"
	$orient add command -label "Positive X" -command "orient_command +x"
	$orient add command -label "Negative X" -command "orient_command -x"
	$orient add command -label "Positive Y" -command "orient_command +y"
 	$orient add command -label "Negative Y" -command "orient_command -y"
	$orient add command -label "Positive Z" -command "orient_command +z"
	$orient add command -label "Negative Z" -command "orient_command -z"
	if { $tool_id == "hexa" } {
	    $orient add command -label "Isometric" -command \
				"orient_command iso"
	}
    }
    if [info exists orient_buttons] {
	foreach b $orient_buttons {
	    if {$b != "usual"} { eval $orient add $b }
	}
    }
}

proc make_main_window_logo {vt fullsize} {
    global tool_logotext tool_logotext_tiny
    global tool_logo tool_logo_small tool_logo_tiny
    global tool_logo_relief tool_logo_small small_screen_hack
    global tool_logo_make_real_small
     global is_win use_win_menus

    if ![info exists tool_logo_relief] { set tool_logo_relief ridge }

    if [info exists tool_logo_make_real_small] {
	frame $vt.logo -borderwidth 0 -relief flat
	label $vt.logo.1 -borderwidth 0 -relief flat -anchor c
    } else {
	frame $vt.logo -borderwidth 2 -relief \
	    [expr {$fullsize ? "raised" : "ridge"}]
	label $vt.logo.1 -borderwidth 2 -relief $tool_logo_relief -anchor c
    }
    if {[expr $small_screen_hack || ($is_win && $use_win_menus)] &&
        [info exists tool_logo_small]} {
	set logo $tool_logo_small
    } elseif {!$fullsize && [info exists tool_logo_tiny]} {
	set logo $tool_logo_tiny
    } else {
	set logo $tool_logo
    }
    switch [llength $logo] {
	1 {
	    set im [image create photo -file [lindex $logo 0]]
	    $vt.logo.1 configure -image $im
	}
	4 {
	    set im [image create bitmap -file [lindex $logo 0] \
			-foreground [lindex $logo 1] \
			-maskfile [lindex $logo 2] \
			-background [lindex $logo 3]]
	    $vt.logo.1 configure -image $im
	}
    }
    if $fullsize {
	pack $vt.logo.1 -side top -fill none -padx 2 -pady 2 -anchor c
        if [info exists tool_logotext] {
	    frame $vt.logo.2
	    label $vt.logo.2.t -text $tool_logotext -anchor c
	    pack $vt.logo.2 -side top -fill x -pady 0
	    pack $vt.logo.2.t -side top -fill both
	}
    } else {
	if ![info exists tool_logotext_tiny] {
	    set tool_logotext_tiny "ANSYS ICEM CFD"
	}
	label $vt.logo.2 -text $tool_logotext_tiny -anchor c
	if [info exists tool_logo_make_real_small] {
	    pack $vt.logo.1 $vt.logo.2 -side left
	} else {
	    pack $vt.logo.1 $vt.logo.2 -side left -padx 2 -pady 2
	}
    }
}

if {[info commands orient_command] == ""} {
    proc orient_command {dir} {
	if { $dir == "zoom" } {
		command "region_zoom"
	} else {
		command "orient $dir" 0
	}
    }
}

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

proc define_strings {win sub bubble label helpurl} {
    global form_label_text language_text_form_override
    
    set key $win
    if {$sub != ""} {
	set key $win,$sub
    }
    if {$bubble != ""} {
	bubble_define $key $bubble
    }
    if {$language_text_form_override && ($label != "")} {
	set form_label_text($key) $label
    }
    if {$helpurl != ""} {
	help_define $win $sub [lindex $helpurl 0] [lindex $helpurl 1]
    }
}

proc make_language_text {{file1 ""}} {
    global put_lang bubble_help form_label_text language_text_file
    global language_text_encoding
    
    if {$file1 == ""} { 
	set file1 $language_text_file
	if [file exists $file1] { cmd_rename $file1 $file1.bak }
    }
    catch {unset put_lang}
    set fp [open $file1 w]
    if {$language_text_encoding != ""} {
	fconfigure $fp -encoding $language_text_encoding
    }
    make_language_text1 $fp .
 
    puts $fp "\n# Below here are definitions for windows which don't exist ----------------\n"

    #close $fp
    #set fp [open $file2 w]

    foreach k [concat [array names bubble_help] \
		   [array names form_label_text]] {
	if ![info exists put_lang($k)] {
	    set kk [split $k ,]
	    make_language_text2 $fp [lindex $kk 0] \
		[join [lrange $kk 1 end] ,] "" 1
	}
    }
    close $fp
    puts " done."
}

proc make_language_text1 {fp w} {
    switch [winfo class $w] {
	Button - Checkbutton - Radiobutton {
	    make_language_text2 $fp $w "" [$w cget -text] 1
	}
	Label {
	    # do nothing
	    # possibly:
	    make_language_text2 $fp $w "" [$w cget -text] 0
	}
	Entry - Frame {
	    # do nothing
	    # possibly:
	    # make_language_text2 $fp $w "" ""
	}
	Menubutton {
	    if [string match *_units* $w] return
	    make_language_text2 $fp $w "" [$w cget -text] 1
	    set m [$w cget -menu]
	    if {$m != ""} {
		set ne [$m index end]
		if {$ne != "none"} {
		    for {set i 0} {$i <= $ne} {incr i} {
			if ![catch {$m entrycget $i -label} lab] {
			    make_language_text2 $fp $m $lab $lab 1
			}
		    }
		}
	    }
	}
	Toplevel {
	    make_language_text2 $fp $w "" "" 0
	}
    }
    foreach s [winfo children $w] { make_language_text1 $fp $s }
}

proc make_language_text2 {fp key1 key2 def_text do_bub} {
    global bubble_help form_label_text put_lang
    
    set key $key1; if {$key2 != ""} { append key ,$key2 }
    
    set bub "*** $def_text ***"
    set lab ""
    set url ""
    if !$do_bub { set lab $def_text }
    if [info exists bubble_help($key)] {
	set bub [string trim $bubble_help($key)]
    }
    if [info exists form_label_text($key)] {
	set lab $form_label_text($key)
    }
    if [info exists help_info($key)] { set url $help_info($key) }
    if $do_bub {
	puts $fp "\ndefine_strings $key1 \"$key2\" \{\n    $bub\n\} \
		\{$lab\} \{$url\}"
    } else {
	puts $fp "\ndefine_strings $key1 \"$key2\" \"\" \{$lab\} \{$url\}"
    }
    puts -nonewline . ; flush stdout
    
    set put_lang($key) 1
}

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

proc set_title {string} {
    global tdv_default
    global whoami version tdv_title_string batch_mode toplevel
    
    if $batch_mode return
    
    if {$string == ""} { set string $whoami }
    
    if $toplevel(single) {
	top_title . $string
    } else {
	top_title .v $string
    }
    if ![catch {$tdv_default get -gsys}] {
	# This is a tdv_viewer
	foreach v [array names tdv_title_string] {
	    set tdv_title_string($v) $string
	    tdv_toggle_title $v
	}
    }
}

proc withdraw_toplevels {main dir} {
    global withdrawn_toplevels withdraw_only_windows toplevel

    if $toplevel(single) { error "can't withdraw toplevels" }
    
    if $dir {
	if [info exists withdrawn_toplevels] {
	    foreach w $withdrawn_toplevels {
		catch {top_deiconify $w}
	    }
	    unset withdrawn_toplevels
	}
    } else {
	set withdrawn_toplevels ""
	if [info exists withdraw_only_windows] {
	    set wins $withdraw_only_windows
	} else {
	    set wins [winfo children .]
	}
	foreach w $wins {
	    if {[winfo ismapped $w] && ($w != $main)} {
		top_withdraw $w
		lappend withdrawn_toplevels $w
	    }
	}
    }
}

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

proc make_phase_panel {name maxr realmaxwidth panel {orient v}} {
    global tool_phase_info current_phase help_base help_info has_blt
    global previous_phase tool_phase_command phase_keys small_screen_hack
    global num_panel_spaces

    frame $panel
    
    set prevcol 1
    set maxwidth 1
    foreach b $tool_phase_info($name) {
	set type [lindex $b 1]
	if {$type == "bottom_area" } {
	    set startr [lindex $b 2]
	    set numr [lindex $b 3]
	    set var [lindex $b 4]
	    set opts [lindex $b 5]
	    foreach opt $opts {
		set subp $panel.$opt
		make_phase_panel $name,$opt $maxr $realmaxwidth $subp
	    }
	    global $var
	    set cmd "trace_subphase_panel $panel $var $startr $numr"
	    trace variable $var w "$cmd; list"
	    if [info exists $var] { eval $cmd }
	    continue
	}
	
	set but [lindex $b 0]
	set text [form_label_text $but [lindex $b 2]]
	set geo [lindex $b 3]
	switch $type {
	    button {
		set cmd [lindex $b 4]
		if {[lindex $b 5] != ""} {
		    lappend phase_keys($name) [list [lindex $b 5] $cmd]
		    append text " ([lindex $b 5])"
		}
		button $panel.$but -text $text -command $cmd \
		    -borderwidth 2 -relief raised -width 1
		#bubble_define $panel.$but [lindex $b 6]
		phase_trace_active $panel.$but [lindex $b 7]
		eval $panel.$but configure [lindex $b 8]
	    }
	    label {
		label $panel.$but -text $text -width 0
	    }
	    radiobutton {
		radiobutton $panel.$but -text $text \
			-variable [lindex $b 4] -value [lindex $b 5] \
			-anchor w -command [lindex $b 6] -width 1
		#bubble_define $panel.$but [lindex $b 7]
		phase_trace_active $panel.$but [lindex $b 8]
		if {[lindex $b 9] != ""} {
		    eval $panel.$but configure [lindex $b 9]
		}
	    }
	    checkbutton {
		checkbutton $panel.$but -text $text -anchor w \
			-variable [lindex $b 4] -command [lindex $b 5] -width 1
		#bubble_define $panel.$but [lindex $b 6]
		phase_trace_active $panel.$but [lindex $b 7]
	    }
	    menu {
		set m $panel.$but.m
		menubutton $panel.$but -text $text -anchor c -indicatoron 1 \
		    -relief raised -borderwidth 2  -menu $m -width 1
		menu $m
		set stuff [lindex $b 4]
		if {[lindex $stuff 0] == "variable"} {
		    phase_trace_menu $m [lindex $stuff 1] \
			[lrange $stuff 2 end]
		} else {
		    foreach c $stuff {
			switch [lindex $c 0] {
			    cascade {
				add_cascade $m $c
			    }
			    ignore {
			    }
			    default {
				eval $m add $c
			    }
			}
		    }
		}
		#bubble_define $panel.$but [lindex $b 5]
		phase_trace_active $panel.$but [lindex $b 6]
	    }
	}
	set geo1 [lindex $geo 0]
	set geo2 [lrange $geo 1 end]
	set grow [lindex [split $geo1 ,] 0]
	set gcol [lindex [split $geo1 ,] 1]
	if !$gcol { set gcol [expr $prevcol + 1] }
	set prevcol $gcol
	
	set pad 2
	if $small_screen_hack { set pad 0 }

        if {$orient == "h"} {
           set grow [expr $gcol -1]
           set gcol 0
        }
	
	if $has_blt {
	    eval blt_table $panel $panel.$but $grow,$gcol $geo2 \
		-padx $pad -pady $pad -fill both
	} else {
	    set cspan 1
	    if {[lindex $geo2 0] == "-columnspan"} {
		set cspan [lindex $geo2 1]
	    }
	    grid $panel.$but -row $grow -column $gcol \
		-padx $pad -pady $pad -sticky nsew -columnspan $cspan
	    #set ww [winfo reqwidth $panel.$but]
	    #if {$ww > $maxwidth} { set maxwidth $ww }
	}
	
	if {[info exists help_base] && ![info exists help_info($panel.$but)]} {
	    help_define $panel.$but "" $help_base ${name}_$but
	}
    }

    if {$maxr <= 1} { set hh 35 } else { set hh 30 }
    if $small_screen_hack { set hh 16 }
    if $has_blt {
	for {set r 0} {$r <= $maxr} {incr r} {
	    blt_table_row $panel configure $r -height $hh
	}
	blt_table_column $panel configure 0 -width 0
	for {set c 1} {$c <= $num_panel_spaces} {incr c} {
	    blt_table_column $panel configure $c -width {1 200 1}
	}
	#if {$maxwidth > $realmaxwidth} { set maxwidth $realmaxwidth }
    } else {
        if {$orient == "h"} {
           for {set r 0} {$r < $maxr} {incr r} {
              grid columnconfigure $panel $r -minsize 96 -weight 1
           }
        #  #grid rowconfigure $panel 0 -minsize 0 -weight 0
        #  set width [expr {[winfo height $panel] / $num_panel_spaces}]
        #  for {set c 1} {$c <= $num_panel_spaces} {incr c} {
        #     grid rowconfigure $panel $c -minsize 32 -weight 1
        #  }
        } else {
           for {set r 0} {$r <= $maxr} {incr r} {
              grid rowconfigure $panel $r -minsize $hh -weight 0
           }
           grid columnconfigure $panel 0 -minsize 0 -weight 0
           set width [expr {[winfo width $panel] / $num_panel_spaces}]
           for {set c 1} {$c <= $num_panel_spaces} {incr c} {
              grid columnconfigure $panel $c -minsize 1 -weight 1
           }
        }
    }
}

proc make_phase_menu {mbar title name info} {
    set mbut $mbar.$name
    set m $mbut.m
    menubutton $mbut -text $title -menu $m
    menu $m -tearoff 1
    
    set itemnum 1
    foreach b $info {
	set type [lindex $b 1]
	if {$type == "bottom_area" } { error "whoa dude" }
	
	set but [lindex $b 0]
	set text [form_label_text $but [lindex $b 2]]
	set geo [lindex $b 3]
	switch $type {
	    button {
		set cmd [lindex $b 4]
		if {[lindex $b 5] != ""} {
		    lappend phase_keys($name) [list [lindex $b 5] $cmd]
		    append text " ([lindex $b 5])"
		}
		$m add command -label $text -command $cmd
		phase_trace_active $m/$itemnum [lindex $b 7]
	    }
	    radiobutton {
		$m add radiobutton -label $text \
		    -variable [lindex $b 4] -value [lindex $b 5] \
		    -command [lindex $b 6]
		phase_trace_active $m/$itemnum [lindex $b 8]
	    }
	    checkbutton {
		$m add checkbutton -label $text \
		    -variable [lindex $b 4] -command [lindex $b 5]
		phase_trace_active $m/$itemnum [lindex $b 7]
	    }
	    menu {
		set stuff [lindex $b 4]
		if {[lindex $stuff 0] == "variable"} {
		    set cc [add_cascade $m [list xx $text ""]]
		    phase_trace_menu $cc [lindex $stuff 1] \
			[lrange $stuff 2 end]
		} else {
		    add_cascade $m [list xx $text $stuff]
		}
		phase_trace_active $m/$itemnum [lindex $b 6]
	    }
	}
	incr itemnum
    }
    return $mbut
}
 
proc phase_enable {on {w .v.top}} {
    global phase_status
    if ![winfo ismapped $w] return
    foreach ch [winfo children $w] { phase_enable $on $ch }
    if $on {
	if [info exists phase_status($w)] {
	    $w configure -state $phase_status($w)
	    unset phase_status($w)
	}
    } else {
	if {![info exists phase_status($w)] && 
	    ![catch {$w cget -state} stat]} {
	    set phase_status($w) $stat
	    $w configure -state disabled
	}
    }
}

proc add_cascade {menu_win stuff} {
    
    # first find unique name for cascaded menu
    
    set i 0
    while 1 {
	set next_m $menu_win.cas_$i
	if ![winfo exists $next_m] break
	incr i
    }
    
    # puts "stuff = $stuff"
    $menu_win add cascade -label "[lindex $stuff 1]" -menu $next_m
    menu $next_m -tearoff 0
    
    set cas_list [lindex $stuff 2]
    foreach me $cas_list {
	switch [lindex $me 0] {
	    cascade {
		add_cascade $next_m $me
	    }
	    ignore {
	    }
	    default {
		eval $next_m add $me
	    }
	}
    }
    return $next_m
}

proc phase_trace_active {win var} {
    if {$var != ""} {
	set vv [lindex $var 0]
	global [lindex [split $vv \(] 0]
	trace variable $vv w [list phase_trace_active_proc $win $var]
	set v2 [lindex [lindex $var 1] 1]
	if {$v2 != ""} {
	    global [lindex [split $v2 \(] 0]
	    trace variable $v2 w [list phase_trace_active_proc $win $var]
	}
    }
}

proc phase_trace_active_proc {win var args} {
    global menu_background menu_activebackground
    set v1 [lindex $var 0]
    set on [uplevel \#0 set $v1]
    if [string match */* $win] {
	set menu [lindex [split $win /] 0]
	set num [lindex [split $win /] 1]
	if $on {
	    $menu entryconfigure $num -state normal
	} else {
	    $menu entryconfigure $num -state disabled
	}
    } else {
	if [scan $on %d onv] {
	    if $onv {
		$win configure -state normal
	    } else {
		$win configure -state disabled
	    }
	}
	
	if {[lindex $var 1] != ""} {
	    set p1 [lindex [lindex $var 1] 0]
	    set p2 [lindex [lindex $var 1] 1]
	    global $p2; set p3 [set $p2]
	    $win configure -background $menu_background($p1,$p3) \
		-activebackground $menu_activebackground($p1,$p3)
	}
    }
}

proc phase_trace_menu {win var menus} {
    global phase_menus_for_button
    
    if {$var != ""} {
	set phase_menus_for_button($win) $menus
	uplevel \#0 trace variable $var w \
	    \"phase_trace_menu_proc $win $var\; list\"
	phase_trace_menu_proc $win $var
    }
}

proc phase_trace_menu_proc {win var} {
    global phase_menus_for_button menu_background menu_activebackground
    
    set v [uplevel \#0 set $var]
    $win delete 0 end
    foreach mm $phase_menus_for_button($win) {
	if {[lindex $mm 0] == $v} {
	    foreach m [lindex $mm 1] {
		switch [lindex $m 0] {
		    cascade {
			add_cascade $win $m
		    }
		    ignore {
		    }
		    default {
			eval $win add $m
		    }
		}
	    }
	    if {[lindex $mm 2] != ""} {
		[winfo parent $win] configure \
		    -background $menu_background([lindex $mm 2],$v) \
		    -activebackground $menu_activebackground([lindex $mm 2],$v)
	    }
	}
    }
}

proc set_phase {{ph ""}} {
    global tdv_default
    global phase_buttons tool_phase_info current_phase
    global previous_phase tool_phase_command phase_keys
    global mainwindow_menubar error_if_dirty
    
    if $mainwindow_menubar return
    
    if {$ph != ""} { set current_phase $ph }

    if [info exists previous_phase] {
	pack unpack .v.top.panel2.$previous_phase	
	if [info exists phase_keys($previous_phase)] {
	    foreach k $phase_keys($previous_phase) {
		bind $tdv_default [lindex $k 0] ""
	    }
	}
    } else {
	# Compiler bug
	set previous_phase ""
    }
    pack .v.top.panel2.$current_phase -side top -fill both -expand 1
    
    form_cancel_class ""
    
    if [info exists tool_phase_command($previous_phase)] {
	if [info exists error_if_dirty] {
	    eval $tool_phase_command($previous_phase) 0
	} else {
	    if [catch {eval $tool_phase_command($previous_phase) 0} res] {
		puts "ERROR: set_phase 1: $res"
	    }
	}
    }
    if [info exists tool_phase_command($current_phase)] {
	if [info exists error_if_dirty] {
	    eval $tool_phase_command($current_phase) 1
	} else {
	    if [catch {eval $tool_phase_command($current_phase) 1} res] {
		puts "ERROR: set_phase 2: $res"
	    }
	}
    }
    
    set previous_phase $current_phase
    
    if [info exists phase_keys($current_phase)] {
	foreach k $phase_keys($current_phase) {
	    bind $tdv_default [lindex $k 0] [lindex $k 1]
	}
    }
}

proc trace_subphase_panel {parent var row nr} {
    global current_subphase_panel num_panel_spaces
    
    if [info exists current_subphase_panel($parent)] {
	grid forget $current_subphase_panel($parent)
	unset current_subphase_panel($parent)
    }
    set val [uplevel \#0 set $var]
    if ![winfo exists $parent.$val] return
    
    grid $parent.$val -row $row -rowspan $nr -column 1 \
	-columnspan $num_panel_spaces -sticky nsew
    set current_subphase_panel($parent) $parent.$val
}

proc full_size_window {} {
    global full_size recorded_small_geo
    
    # Here we kind of assume that the user never moves the .v window.  ***
    if $full_size {
	set ww [winfo rootx .v]
	set hh [winfo rooty .v]
	set maxw [expr {[winfo screenwidth .v] - 2 * $ww}]
	set maxh [expr {[winfo screenheight .v] - $ww -$hh}]
	set recorded_small_geo [winfo width .v]x[winfo height .v]+0+0
	top_geometry .v ${maxw}x${maxh}+0+0
	raise .v
    } else {
	top_geometry .v $recorded_small_geo
    }
}

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

if {[info commands adjust_window_geometry] == ""} {
    
proc adjust_window_geometry {} {
    global display_type sun_flag sun_y_hack sun_x_hack messages_visible
    global is_win tcl_version toplevel edit_window_goes_on_bottom
    global regular_m_height regular_e_width
    
    set has_e [expr {[winfo exists .e] && 
		     ![info exists edit_window_goes_on_bottom]}]
    
    if {![winfo exists .m] || ![winfo exists .v]} return

    set sun_flag 0
    set sun_x_hack 0
    set sun_y_hack 0
    
    if {($is_win && ($tcl_version >= 8.0)) || $toplevel(single)} {
	if $has_e { top_deiconify .e }
	top_deiconify .m
	update idletasks
	if $has_e { top_geometry .e -0+0 }
	top_geometry .m +0-0
    } else {
	if $has_e { 
	    top_geometry .e -0+0
	    top_deiconify .e
	}
	top_geometry .m +0-0
	top_deiconify .m
	update idletasks
    }
    
    if [winfo exists .v.top.extras.msgs] {
	set messages_visible small
	.v.top.extras.msgs configure -text "Msg+"
    }
    
    update idletasks
    set vx [winfo x .m]
    set h1 [winfo y .m]
    if $has_e { 
	set vy [winfo y .e]
	set w1 [winfo x .e]
    } else {
	set vy 0
	#set w1 [winfo width .]
        set w1 [winfo screenwidth .]
    }
    
    if $toplevel(single) {
	incr h1 -4
	if [info exists regular_m_height] {
	    set vh [expr [winfo height .] - $regular_m_height]
	} else {
	    set regular_m_height [expr [winfo height .] - $h1]
            if [winfo exist .m__frame] {
               incr regular_m_height [expr int(1.5 * [.m__frame cget -bd])]
            }
            if [winfo exist .v__frame] {
               incr regular_m_height [.v__frame cget -bd]
            }
            set vh [expr [winfo height .] - $regular_m_height]
	}
	if [info exists edit_window_goes_on_bottom] {
	    set vw [winfo width .]
	} elseif [info exists regular_e_width] {
	    set vw [expr [winfo width .] - $regular_e_width]
	} else {
            if $has_e {
               incr w1 -4
	       set vw $w1
               set regular_e_width [expr [winfo width .] - $w1]
            } else {
               set vw [winfo width .]
               set regular_e_width 0
               if [winfo exist .v__frame] {
                  set regular_e_width [.v__frame cget -bd]
               }
               set vw [expr [winfo width .] - $regular_e_width]
            }
	}
        set minw 50
        set minh 50
    } else {
	set vw [expr {$w1 - $vx * 3 + 1 - $sun_x_hack * 2}]
	set vh [expr {$h1 - $vy * 2 - $vx + 1}]

        set minw [expr [winfo screenwidth .] / 2]
        set minh [expr [winfo screenheight .] / 2]
    }
    if {$vw < $minw} { set vw $minw }
    if {$vh < $minh} { set vh $minh }
    
    top_geometry .v ${vw}x${vh}+0+0
	global va_win
	if ![info exists va_win(do_not_show_main)] { 
    top_deiconify .v
	}
    update idletasks
    
    if [info exists edit_window_goes_on_bottom] {
	set ex [expr [winfo x .m] + [winfo width .m] + 6]
	set ey [winfo y .m]
	set ew [expr [winfo width .] - [winfo width .m] - 6]
	set eh [winfo height .m]
	top_geometry .e ${ew}x${eh}+${ex}+${ey}
	top_deiconify .e
	update idletasks
    }
}

}

proc top_adjust_window_geometry {} { adjust_window_geometry }

proc readjust_edit_geometry {} {
    global sun_x_hack

    # This is a big pain.
    update
    #top_withdraw .e; wm geometry .e -$sun_x_hack+0; wm deiconify .e
    catch {top_geometry .e -$sun_x_hack+0}
}

proc sun_geometry {w geo} {
    global sun_flag sun_y_hack sun_x_hack
    
    regexp {([+-][0-9]*)([+-][0-9]*)} $geo dummy x y
    if $sun_flag {
	top_geometry $w $x$y
	update
	# This is truly demented but it seems to work.
	if {$x == "-0"} { set x --$sun_x_hack }
	if {$y == "-0"} { set y --$sun_y_hack }
    }
    top_geometry $w $x$y
}

proc list_all_windows {w} {
    switch [winfo class $w] {
	Button - Checkbutton - Radiobutton - Menubutton - Entry {
	    puts $w
	}
    }
    foreach s [winfo children $w] { list_all_windows $s }
}

# what can be smallscreen, mediumscreen, largescreen

proc change_all_fonts {what} {
    global normalfont
    
    set ofont $normalfont
    compute_sizes $what
    set nfont $normalfont
    
    if {$ofont != $nfont} {
	change_all_fonts_windows . $ofont $nfont
    }
}

proc change_all_fonts_windows {w ofont nfont} {
    catch {
	if {[$w cget -font] == $ofont} { $w configure -font $nfont }
    }
    foreach c [winfo children $w] {
	change_all_fonts_windows $c $ofont $nfont
    }
}
