
# This code creates the user interface for the mesh editor.
#
# Copyright (c) 1997 Pacific Marketing and Consulting, Inc,
#       and ICEM Systems, GmbH.  All rights reserved.
# Author:  Wayne A. Christopher, wayne@icemcfd.com
#

proc command_define {longname shortname icon cmd bubble helpurl whenactive \
			 {dragoff_cmd ""}} {
    global command
    
    if [info exists command(longname,$longname)] {
	puts "Warning: command \"$longname\" already exists"
    } else {
	lappend command(all-commands) $longname
    }
    
    if {$icon == "no_icon"} { set icon "" }
    if {$helpurl == "no_help"} { set helpurl "" }
    if {$whenactive == "always"} { set whenactive "" }
    
    set command(longname,$longname) $longname
    set command(shortname,$longname) $shortname
    set command(icon,$longname) $icon
    set command(cmd,$longname) $cmd
    set command(dragoff_cmd,$longname) $dragoff_cmd
    set command(bubble,$longname) $bubble
    set command(url,$longname) $helpurl
    set command(in_menus,$longname) ""
    
    if {[lindex $whenactive 0] == "only_if"} {
	if [uplevel expr [lrange $whenactive 1 end]] {
	    set whenactive ""
	} else {
	    set whenactive not_present
	}
    }
    set command(whenactive,$longname) $whenactive
}

proc command_delete {longname} {
    global command
    foreach key [array names command] {
	regsub {^[^,]*,} $key "" cname
	if {$cname == $longname} {
	    unset command($key)
	}
    }
    set command(all-commands) [ldelete $command(all-commands) $longname]
}

proc command_check_exists {longname} {
    global command
    return [info exists command(longname,$longname)]
}

proc command_set_text {longname longlabel shortlabel bubble helpurl} {
    global command toolbar form_label_text
    
    # Dont' bother to check this
#    if ![info exists command(longname,$longname)] {
#	error "No such command \"$longname\" exists"
#    }
    
    if {$longlabel != ""}  {
	set command(longname,$longname) $longlabel
	set form_label_text($longname) $longlabel ;# for convenience
    }
    if {$shortlabel != ""} { set command(shortname,$longname) $shortlabel }
    if {$bubble != ""}     { set command(bubble,$longname) $bubble }
    if {$helpurl != ""}    { set command(url,$longname) $helpurl }
    
    if [info exists command(in_menus,$longname)] {
	foreach place $command(in_menus,$longname) {
	    set m [lindex $place 0]
	    set p [lindex $place 1]
	    set s [lindex $place 2]
	    if $s {
		set label $command(shortname,$longname)
	    } else {
		set label $command(longname,$longname)
	    }
	    
	    $m entryconfigure $p -label $label
	    
	    if {$command(bubble,$longname) != ""} {
		bubble_define $m,$label $command(bubble,$longname)
	    }
	    if {$command(url,$longname) != ""} {
		set url $command(url,$longname)
		help_define $m $label [lindex $url 0] [lindex $url 1]
	    }
	}
    }
    if [info exists toolbar] {
	toolbar_update_text $command(cmd,$longname) \
	    $command(bubble,$longname) \
	    $command(url,$longname)
    }
}

proc command_set_icon {args} {
    global command
    foreach {longname icon} $args {
	if ![info exists command(icon,$longname)] {
	    puts "Warning: no command $longname exists"
	}
	set command(icon,$longname) $icon
    }
}

proc command_set_tree_icon {args} {
    global tree
    foreach {n f} $args { set tree(icon_file,$n) $f }
}

proc command_make_toolbar {longname rownum entries {at_end 1}} {
    global command
    
    if ![info exists command(toolbar-longname,$longname)] {
	if $at_end {
	    lappend command(all-toolbars) $longname
	} else {
	    set command(all-toolbars) [concat [list $longname] $command(all-toolbars)]
	}
    }
    set command(toolbar-longname,$longname) $longname
    set command(toolbar-rownum,$longname) $rownum
    set command(toolbar-entries,$longname) $entries
    
    if [info exists command(already_created_toolbars)] {
	command_create_one_toolbar $longname
    }
    
    # If there are cascades, make them now but don't map them.
    foreach ent $entries {
	if {[lindex $ent 0] == "menu"} {
	    command_make_toolbar [lindex $ent 1] -$rownum [lrange $ent 2 end]
	}
    }
}

proc command_make_toolbar_space {rownum} {
    global command
    
    lappend command(all-toolbars) "__space__ $rownum"
    
    if [info exists command(already_created_toolbars)] {
	toolbar_addspace $rownum
    }
}

proc command_create_toolbars {} {
    global command
    
    if ![info exists command(all-toolbars)] return
    set command(already_created_toolbars) 1
    
    foreach longname $command(all-toolbars) {
	if {[lindex $longname 0] == "__space__"} {
	    toolbar_addspace [lindex $longname 1]
	} else {
	    command_create_one_toolbar $longname
	}
    }
}

proc command_create_one_toolbar {longname} {
    global command
    
    set rownum $command(toolbar-rownum,$longname)
    set ents ""
    foreach cmdlist $command(toolbar-entries,$longname) {
	set ents1 ""
	if {$cmdlist == ""} {
	    
	} elseif {[lindex $cmdlist 0] == "cascade"} {
	    set ents1 [list [lindex $cmdlist 1]]
	    foreach cmd [lrange $cmdlist 2 end] {
		lappend ents1 [command_create_toolbars_ent $cmd]
	    }
	    
	} elseif {[lindex $cmdlist 0] == "multiple"} {
	    set ents1 [list multiple [command_create_toolbars_ent \
					  [lindex $cmdlist 1]] \
			   [command_create_toolbars_ent \
				[lindex $cmdlist 2]]]
	    
	} elseif {[lindex $cmdlist 0] == "menu"} {
	    set ents1 [list menu [lindex $cmdlist 1]]
	    foreach cmd [lrange $cmdlist 2 end] {
		lappend ents1 [command_create_toolbars_ent $cmd]
	    }
	} else {
	    lappend ents1 [command_create_toolbars_ent $cmdlist]
	}
	
	lappend ents $ents1
    }
    toolbar_addgroup $longname $rownum $ents ""
}

proc command_create_toolbars_ent {cmd} {
    global command
    
    if ![info exists command(longname,$cmd)] {
	puts "Command \"$cmd\" referenced in toolbar doesn't exist"
	return ""
    }
    set bub [command_get_bubble $cmd]
    return [list $command(shortname,$cmd) \
		$command(icon,$cmd) \
		$command(cmd,$cmd) \
		$command(whenactive,$cmd) \
		$bub $command(url,$cmd) \
		$command(dragoff_cmd,$cmd)]
}

proc command_get_bubble {name} {
    global command
    
    set bub $command(longname,$name)
    if [info exists command(hotkey,$name)] {
	append bub "\nKey = $command(hotkey,$name)"
    } elseif [info exists command(hotkey_tdv,$name)] {
	append bub "\nKey = $command(hotkey_tdv,$name)"
    }
    set txt [string trim $command(bubble,$name)]
    if {$txt != ""} { append bub "\n$txt" }
    return $bub
}

proc command_make_menu {longname active side entries args} {
    global command
    
    if ![info exists command(menu-longname,$longname)] {
	lappend command(all-menus) $longname
    }
    
    if {$active == "always"} { set active "" }
    
    set tearoff 1
    set key ""
    foreach a $args {
	switch [lindex $a 0] {
	    notearoff { set tearoff 0 }
	    keyboard { set key [lindex $a 1] }
	    default { error "unknown option $a" }
	}
    }
    
    set command(menu-longname,$longname) $longname
    set command(menu-active,$longname) $active
    set command(menu-side,$longname) $side
    set command(menu-entries,$longname) $entries
    set command(menu-tearoff,$longname) $tearoff
    set command(menu-keyboard,$longname) $key
    
    if [info exists command(already_created_menus)] {
	command_create_one_menu $longname ""
    }
}

proc command_add_to_menu {longname ents} {
    global command
    foreach ent $ents {
	lappend command(menu-entries,$longname) $ent
    }
    if [info exists command(already_created_menus)] {
	set but $command(existing_menu,$longname)
	foreach ent $ents {
	    command_put_menu_entry $but.m $ent end [list $longname]
	}
    }
}

proc command_reset_menu {longname ents} {
    global command
    
    set command(menu-entries,$longname) $ents
    
    if {[info exists command(already_created_menus)] && [info exists command(existing_menu,$longname)]} {
	set but $command(existing_menu,$longname)
	$but.m delete 0 end
	foreach ent $ents {
	    command_put_menu_entry $but.m $ent end [list $longname]
	}
    }
}

proc command_get_menu_entries {longname} {
    global command
    if [info exists command(menu-entries,$longname)] {
	return $command(menu-entries,$longname)
    } else {
	return ""
    }
}

proc command_create_menus {mbar} {
    global command
    
    if ![info exists command(all-menus)] return
    set command(already_created_menus) 1
    set command(menubar_frame) $mbar
    form_fonts
    
    set ind 0
    foreach longname $command(all-menus) {
	set but $mbar.m$ind
	command_create_one_menu $longname $but
	incr ind
    }
}

proc command_create_one_menu {longname but} {
    global command no_menu_tearoff is_win use_win_menus

    if {$but == ""} {
	if [info exists command(existing_menu,$longname)] {
	    set but $command(existing_menu,$longname)
	} else {
	    for {set i 0} {![winfo exists $command(menubar_frame).m$i]} \
		{incr i} {}
	    set but $command(menubar_frame).m$i
	}
    }
    set command(existing_menu,$longname) $but
    set active $command(menu-active,$longname)
    set side $command(menu-side,$longname)
    set keyboard $command(menu-keyboard,$longname)
    set tearoff $command(menu-tearoff,$longname)
    if [info exists no_menu_tearoff] { set tearoff 0 }

    if {[lindex $side 1] == "button"} {
	if ![info exists command(longname,$longname)] {
	    puts "Command \"$longname\" referenced in menu doesn't exist"
	    return
	}
	set cmd $command(cmd,$longname)
	set act $command(whenactive,$longname)
	set name $command(shortname,$longname)
	set bubble [command_get_bubble $longname]
	set url [string trim $command(url,$longname)]

	if ![winfo exists $but] {
	    button $but -borderwidth 1 -relief raised
	    pack $but -side [lindex $side 0]
	}
	$but configure -text $name -command $cmd

	if {$bubble != ""} {
	    bubble_define $but $bubble
	}
	if {$url != ""} {
	    help_define $but "" [lindex $url 0] [lindex $url 1]
	}
	if {$act != ""} {
	    form_doactive $but button $act
	}

    } else {
	if {$active == "not_present"} continue
	if {$active == "always"} { set active "" }

	set ul -1
	if {$keyboard != ""} {
	    set ul [string first [string tolower $keyboard] \
			[string tolower $longname]]
	}

	set m $but.m
	if ![winfo exists $but] {
	    menubutton $but -menu $m -bg [$command(menubar_frame) cget -bg] \
		-relief flat -borderwidth 2 -padx 2 -underline $ul
#	    bind $but <Enter> "$but configure -relief raised"
#	    bind $but <Leave> "$but configure -relief flat"
	    menu $m -tearoff $tearoff -tearoffcommand tearoff_record
	    pack $but -side [lindex $side 0] -padx 4 -fill both
            if {$is_win && $use_win_menus} {
                [winfo parent $but] add cascade -menu $m -underline $ul \
                    -label [command_language_name $longname 0]
            }
	} else {
	    $m delete 0 end
	}
	$but configure -text [command_language_name $longname 0]

	set ents $command(menu-entries,$longname)
	if {$ents == ""} {
	    $but configure -state disabled
	} else {
	    set ind2 0
	    foreach ent $command(menu-entries,$longname) {
		command_put_menu_entry $m $ent $ind2 [list $longname]
		incr ind2
	    }
	}

	if {$active != ""} {
	    form_doactive $but menubutton $active
	}
	if {[lindex $side 1] == "set_path"} {
	    uplevel \#0 set [lindex $side 2] $m
	    $but configure -state normal
	}
    }
}

proc command_put_menu_entry {m ent ind in_cascade} {
    global command no_menu_tearoff
    
    if {[lindex $ent 0] == "disabled"} return
    
    if {$ent == "separator"} {
	$m add separator
	return
    }
    set name [lindex $ent 0]
    set entact [lindex $ent 1]
    set type [lindex $ent 2]
    
    switch $type {
	cascade {
	    set sub [lindex $ent 3]
	    if [string match \$* $sub] {
		upvar \#0 [string range $sub 1 end] lvar
		set sub $lvar
	    }
	    
	    if {$sub == ""} {
		set state disabled
	    } else {
		set state normal
	    }
	    
	    set keyboard [lindex $ent 4]
	    set ul -1
	    if {$keyboard != ""} {
		set ul [string first [string tolower $keyboard] \
			    [string tolower $name]]
	    }
	    
	    set tearoff [expr ![info exists no_menu_tearoff]]
	    
	    set sm $m.m$ind
	    menu $sm -tearoff $tearoff -tearoffcommand tearoff_record
	    set label [command_language_name $name \
			   [expr [llength $in_cascade] > 0]]
	    $m add cascade -label $label -menu $sm -state $state -underline $ul
	    set ind2 0
	    foreach s $sub {
		command_put_menu_entry $sm $s $ind2 \
		    [concat $in_cascade [list $name]]
		incr ind2
	    }
	    
	    if {$entact != ""} {
		form_doactive $m menu_item $entact [$m index end]
	    }
	}
	variable_cascade {
	    set var [lindex $ent 3]
	    set vsub [lindex $ent 4]
	    set first_sm ""
	    foreach sub $vsub {
		set sval [lindex $sub 0]
		set slab [lindex $sub 1]
		set ssub [lindex $sub 2]
		
		set sm $m.m$ind$sval
		if {$first_sm == ""} { set first_sm $sm }
		menu $sm -tearoff 1 -tearoffcommand tearoff_record
		set command(variable_cascade_name,$m.m$ind$sval) $slab
		set ind2 0
		foreach s $ssub {
		    command_put_menu_entry $sm $s $ind2 \
			[concat $in_cascade [list $slab $name]]
		    incr ind2
		}
	    }
	    if {$vsub == ""} {
		set state disabled
	    } else {
		set state normal
	    }
	    
	    set keyboard [lindex $ent 5]
	    set ul -1
	    if {$keyboard != ""} {
		set ul [string first [string tolower $keyboard] \
			    [string tolower $name]]
	    }
	    
	    set label [command_language_name $name \
			   [expr [llength $in_cascade] > 0]]
	    $m add cascade -label $label -state $state -underline $ul
	    set command(variable_cascade_index,$m.m$ind) [$m index end]
	    
	    # All this is to make sure that the active data for the 
	    # cascade, and the variable stuff, don't cancel each other out.
	    
	    set upd ""
	    if {$entact != ""} {
		form_doactive $m menu_item $entact [$m index end]
		set upd "[list form_setstate $m menu_item [$m index end]];"
	    }
	    
	    global [lindex [split $var \(] 0]
	    trace variable $var w "[list command_update_variable_cascade $m $m.m$ind $var]; $upd list"
	    set $var [set $var]
	    
	}
	default {
	    if ![info exists command(longname,$name)] {
		puts "Command \"$name\" referenced in menu doesn't exist"
		return
	    }
	    
	    set act $command(whenactive,$name)
	    if {$act == "not_present"} return
	    
	    set cmd $command(cmd,$name)
	    set bubble [command_get_bubble $name]
	    set url [string trim $command(url,$name)]
	    
	    set is_short [expr [llength $in_cascade] > 1]
	    set label [command_language_name $name $is_short]
	    
	    set keyboard [lindex $ent 3]
	    set ul -1
	    if {$keyboard != ""} {
		set ul [string first [string tolower $keyboard] \
			    [string tolower $name]]
	    }
	    
	    switch [lindex $cmd 0] {
		radiobutton {
		    $m add radiobutton -label $label -underline $ul \
			-variable [lindex $cmd 1] \
			-value [lindex $cmd 2] -command [lindex $cmd 3]
		}
		checkbutton {
		    if [info exists command(hotkey_tdv,$name)] {
			$m add checkbutton -label $label -underline $ul \
			    -variable [lindex $cmd 1] \
			    -command [lindex $cmd 2] \
			    -accelerator $command(hotkey_tdv,$name)
		    } else {
			$m add checkbutton -label $label -underline $ul \
			    -variable [lindex $cmd 1] \
			    -command [lindex $cmd 2]
		    }
		}
		cascade_func {
		    set sm $m.m$ind
		    menu $sm -tearoff 0 -postcommand "[lindex $cmd 1] $sm"
		    $m add cascade -label $label -menu $sm -underline $ul
		}
		default {
		    if [info exists command(hotkey,$name)] {
			$m add command -label $label -command $cmd \
			    -underline $ul -accelerator $command(hotkey,$name)
		    } elseif [info exists command(hotkey_tdv,$name)] {
			$m add command -label $label -command $cmd \
			    -underline $ul -accelerator $command(hotkey_tdv,$name)
		    } else {
			$m add command -label $label -command $cmd \
			    -underline $ul
		    }
		}
	    }
	    
	    lappend command(in_menus,$name) [list $m [$m index end] $is_short]
	    
	    if {$act != ""} {
		form_doactive $m menu_item $act [$m index end]
	    }
	    
	    if {$bubble != ""} {
		bubble_define $m,$label $bubble
	    }
	    if {$url != ""} {
		help_define $m $label [lindex $url 0] [lindex $url 1]
	    }
	}
    }
}

proc command_language_name {name short} {
    global command
    
    if {$short && [info exists command(shortname,$name)]} {
	return $command(shortname,$name)
    } elseif [info exists command(longname,$name)] {
	return $command(longname,$name)
    } else {
	return $name
    }
}

proc command_update_variable_cascade {menu prefix var} {
    global command
    
    set val [uplevel \#0 set $var]
    set m $prefix$val
    if ![winfo exists $m] {
	trace vdelete $var w "[list command_update_variable_cascade $menu $prefix $var]; list"
	return
    }
    if ![$m index end] {
	# This menu is empty so turn off the cascade entry in the parent
	set state disabled
    } else {
	set state normal
    }
    set ind $command(variable_cascade_index,$prefix)
    set name $command(variable_cascade_name,$m)
    if {$name == ""} { set name [$menu entrycget $ind -label] }
    
    $menu entryconfigure $ind -menu $m -label $name -state $state
}

proc command_set_hotkeys {keys} {
    global command
    
    foreach {k c} $keys {
	set command(hotkey,$c) $k
    }
    set command(hotkeys) $keys
    
    if [info exists command(already_created_hotkeys)] {
	command_create_hotkeys
    }
}

proc command_set_hotkeys_tdv {keys} {
    global command
    
    foreach {k c} $keys {
	set command(hotkey_tdv,$c) $k
    }
}

proc command_create_hotkeys {} {
    global command
    
    if [info exists command(hotkeys)] {
	foreach {k c} $command(hotkeys) {
	    if {$c == ""} {
		tdv_set_key_command $k ""
	    } else {
		set cmd $command(cmd,$c)
		set bubble $command(bubble,$c)
		if {[string trim $bubble] == ""} { set bubble $c }
		tdv_set_key_command $k $cmd $bubble
	    }
	}
    }
    set command(already_created_hotkeys) 1
}

proc command_get_menu {name} {
    global command
    if [info exists command(existing_menu,$name)] {
	return $command(existing_menu,$name).m
    } else {
	return ""
    }
}

# This is a convenience type thing

proc command_cycle_variable {var vals cmd} {
    upvar \#0 $var lvar
    set p [lsearch $vals $lvar]
    if {$p < 0} {
	error "$var value is $lvar : not one of $vals"
    }
    set p [expr ($p + 1) % [llength $vals]]
    set lvar [lindex $vals $p]
    if {$cmd != ""} { uplevel \#0 $cmd }
}
