# ----------------------------------------------------------------------------#  Command MainFrame::getmenu# ----------------------------------------------------------------------------proc MainFrame::getmenu { path menuid } {    variable _widget    if { [info exists _widget($path,menuid,$menuid)] } {        return $_widget($path,menuid,$menuid)    }    return ""}# -----------------------------------------------------------------------------#  Command MainFrame::setmenustate# -----------------------------------------------------------------------------proc MainFrame::setmenustate { path tag state } {    variable _widget    #    if { [info exists _widget($path,tags,$tag)] } {    #        foreach {menu entry} $_widget($path,tags,$tag) {    #            $menu entryconfigure $entry -state $state    #        }    #    }    # We need a more sophisticated state system.    # The original model was this:  each menu item has a list of tags;    # whenever any one of those tags changed state, the menu item did too.    # This makes it hard to have items that are enabled only when both tagA and    # tagB are.  The new model therefore only sets the menustate to enabled    # when ALL of its tags are enabled.    # First see if this is a real tag    if { [info exists _widget($path,tagstate,$tag)] } {	if { ![string equal $state "disabled"] } {	    set _widget($path,tagstate,$tag) 1	} else {	    set _widget($path,tagstate,$tag) 0	}	foreach {menu entry} $_widget($path,tags,$tag) {	    set expression "1"	    foreach menutag $_widget($path,menutags,[list $menu $entry]) {		append expression " && $_widget($path,tagstate,$menutag)"	    }	    if { [expr $expression] } {		set state normal	    } else {		set state disabled	    }	    $menu entryconfigure $entry -state $state	}    }    return}# -----------------------------------------------------------------------------#  Command MainFrame::menuonly# ----------------------d------------------------------------------------------proc MainFrame::menuonly { path } {    variable _widget    catch {pack forget $path.sep}    catch {pack forget $path.botf.sep}    catch {pack forget $path.frame}}# ----------------------------------------------------------------------------#  Command MainFrame::showtoolbar# ----------------------------------------------------------------------------proc MainFrame::showtoolbar { path index bool } {    variable _widget    set toolframe $path.topf.f$index    if { [winfo exists $toolframe] } {        if { !$bool && [llength [grid info $toolframe]] } {            grid forget $toolframe            $path.topf configure -height 1        } elseif { $bool && ![llength [grid info $toolframe]] } {            grid $toolframe -column 0 -row $index -sticky ew        }    }}# ----------------------------------------------------------------------------#  Command MainFrame::showstatusbar# ----------------------------------------------------------------------------proc MainFrame::showstatusbar { path name } {    set status $path.status    if { [string equal $name "none"] } {        pack forget $status    } else {        pack $status -fill x        switch -- $name {            status {                catch {pack forget $status.prg}            }            progression {                pack $status.prg -in $status.prgf            }        }    }}# ----------------------------------------------------------------------------#  Command MainFrame::_destroy# ----------------------------------------------------------------------------proc MainFrame::_destroy { path } {    variable _widget    Widget::destroy $path    catch {destroy [$_widget($path,top) cget -menu]}    $_widget($path,top) configure -menu {}    # Unset all of the state vars associated with this main frame.    foreach index [array names _widget $path,*] {	unset _widget($index)    }}# ----------------------------------------------------------------------------#  Command MainFrame::_create_menubar# ----------------------------------------------------------------------------proc MainFrame::_create_menubar { path descmenu } {    variable _widget    global    tcl_platform    set bg      [Widget::getoption $path -background]    set top     $_widget($path,top)    foreach {v x} {mbfnt -menubarfont mefnt -menuentryfont} {	if {[string length [Widget::getoption $path $x]]} {	    set $v [list -font [Widget::getoption $path $x]]	} else {	    set $v ""	}    }    if {$tcl_platform(platform) == "unix"} {	lappend mbfnt -borderwidth 1    }    set menubar [eval [list menu $top.menubar -tearoff 0 \	    -background $bg] $mbfnt]    $top configure -menu $menubar    set count 0    foreach {name tags menuid tearoff entries} $descmenu {        set opt  [_parse_name $name]        if { [string length $menuid] && ![info exists _widget($path,menuid,$menuid)] } {            # menu has identifier	    # we use it for its pathname, to enable special menu entries	    # (help, system, ...)	    set menu $menubar.$menuid        } else {	    set menu $menubar.menu$count	}        eval [list $menubar add cascade] $opt [list -menu $menu]        eval [list menu $menu -tearoff $tearoff -background $bg] $mefnt        foreach tag $tags {            lappend _widget($path,tags,$tag) $menubar $count	    # ericm@scriptics:  Add a tagstate tracker	    if { ![info exists _widget($path,tagstate,$tag)] } {		set _widget($path,tagstate,$tag) 1	    }        }	# ericm@scriptics.com:  Add mapping from menu items to tags	set _widget($path,menutags,[list $menubar $count]) $tags	            if { [string length $menuid] } {            # menu has identifier            set _widget($path,menuid,$menuid) $menu        }        _create_entries $path $menu $bg $entries        incr count    }}# ----------------------------------------------------------------------------#  Command MainFrame::_create_entries# ----------------------------------------------------------------------------proc MainFrame::_create_entries { path menu bg entries } {    variable _widget    set count      [$menu cget -tearoff]    set registered 0    foreach entry $entries {        set len  [llength $entry]        set type [lindex $entry 0]        if { [string equal $type "separator"] } {            $menu add separator            incr count            continue        }        # entry name and tags        set opt  [_parse_name [lindex $entry 1]]        set tags [lindex $entry 2]        foreach tag $tags {            lappend _widget($path,tags,$tag) $menu $count	    # ericm@scriptics:  Add a tagstate tracker	    if { ![info exists _widget($path,tagstate,$tag)] } {		set _widget($path,tagstate,$tag) 1	    }        }	# ericm@scriptics.com:  Add mapping from menu items to tags	set _widget($path,menutags,[list $menu $count]) $tags        if { [string equal $type "cascad"] } {            set menuid  [lindex $entry 3]            set tearoff [lindex $entry 4]            set submenu $menu.menu$count            eval [list $menu add cascade] $opt [list -menu $submenu]            menu $submenu -tearoff $tearoff -background $bg            if { [string length $menuid] } {                # menu has identifier                set _widget($path,menuid,$menuid) $submenu            }            _create_entries $path $submenu $bg [lindex $entry 5]            incr count            continue        }        # entry help description        set desc [lindex $entry 3]        if { [string length $desc] } {            if { !$registered } {                DynamicHelp::register $menu menu [Widget::getoption $path -textvariable]                set registered 1            }            DynamicHelp::register $menu menuentry $count $desc        }        # entry accelerator        set accel [_parse_accelerator [lindex $entry 4]]        if { [llength $accel] } {            lappend opt -accelerator [lindex $accel 0]            bind $_widget($path,top) [lindex $accel 1] [list $menu invoke $count]        }        # user options        set useropt [lrange $entry 5 end]        if { [string equal $type "command"] ||              [string equal $type "radiobutton"] ||             [string equal $type "checkbutton"] } {            eval [list $menu add $type] $opt $useropt        } else {            return -code error "invalid menu type \"$type\""        }        incr count    }}# ----------------------------------------------------------------------------#  Command MainFrame::_parse_name# ----------------------------------------------------------------------------proc MainFrame::_parse_name { menuname } {    set idx [string first "&" $menuname]    if { $idx == -1 } {        return [list -label $menuname]    } else {        set beg [string range $menuname 0 [expr {$idx-1}]]        set end [string range $menuname [expr {$idx+1}] end]        append beg $end        return [list -label $beg -underline $idx]    }}# MainFrame::_parse_accelerator --##	Given a key combo description, construct an appropriate human readable#	string (for display on as a menu accelerator) and the corresponding#	bind event.## Arguments:#	desc	a list with the following format:#			?sequence? key#		sequence may be None, Ctrl, Alt, or CtrlAlt#		key may be any key## Results:#	{accel event}	a list containing the accelerator string and the eventproc MainFrame::_parse_accelerator { desc } {    if { [llength $desc] == 1 } {	set seq None	set key [string tolower [lindex $desc 0]]	# If the key is an F key (ie, F1, F2, etc), it has to be capitalized	if {[regexp {f1?[0-9]} $key]} {	    set key [string toupper $key]	}    } elseif { [llength $desc] == 2 } {        set seq [lindex $desc 0]        set key [string tolower [lindex $desc 1]]	# If the key is an F key (ie, F1, F2, etc), it has to be capitalized	if {[regexp {f1?[0-9]} $key]} {	    set key [string toupper $key]	}    } else {	return {}    }    switch -- $seq {	None {	    set accel "[string toupper $key]"	    set event "<Key-$key>"	}	Ctrl {	    set accel "Ctrl+[string toupper $key]"	    set event "<Control-Key-$key>"	}	Alt {	    set accel "Alt+[string toupper $key]"	    set event "<Alt-Key-$key>"	}	CtrlAlt {	    set accel "Ctrl+Alt+[string toupper $key]"	    set event "<Control-Alt-Key-$key>"	}	default {	    return -code error "invalid accelerator code $seq"	}    }    return [list $accel $event]}