# sj.mui.tcl --
#
#	"Spec Java" Menu UI file. It was generated by menued and has since
#	been hand-edited. DON'T generate this file again from sj.mui
#
# Copyright (c) 1997 Sun Microsystems, Inc. All rights reserved.
#
# SCCS: @(#) sj.mui.tcl 1.26 97/08/13 13:25:04


proc sj_mui {root args} {
    global spec tcl_platform tk_patchLevel

    # This treats '.' as a special case.
    if {$root == "."} {
	set base ""
    } else {
	set base $root
    }

    set toproot [winfo toplevel $root]
    if {$toproot == "."} {
	set topbase ""
    } else {
	set topbase $toproot
    }

    # See if this version of Tk supports native menu:
    if [catch {. cget -menu}] {
	set nativeMenu 0
    } else {
	set nativeMenu 1
    }

    if {!$nativeMenu || $tcl_platform(platform) == "unix"} {
	option add *menu*background #c0c0c0 99
    }

    if {$tcl_platform(platform) == "macintosh" &&
	    [patchLevel_compare $tk_patchLevel 8.0b1] > 0} {
	set useAppleMenu 1
    } else {
	set useAppleMenu 0
    }

    proc menued_menu_accel {key args} {
	global tcl_platform
	set shift [regexp {[sS]hift} $args]
	set control [regexp {[cC]ontrol} $args]
	set meta [regexp {[mM]eta} $args]
	set alt [regexp {[aA]lt} $args]
	switch $tcl_platform(platform) {
	    unix {
		set space "    "
		array set mods {
		    prefix "<" suffix ">"  shift0 "" shift1 "Shift-"
		    control0 "" control1 "^-"  meta0 "" meta1 "Meta-"
		    alt0 "" alt1 "Alt-"
		}
	    }
	    macintosh {
		set space ""
		set key [string toupper $key]
		array set mods {
		    prefix "" suffix ""  shift0 "" shift1 "Shift-"
		    control0 "" control1 "Command-"  meta0 "" meta1 "\240"
		    alt0 "" alt1 "Option-"
		}
	    }
	    windows {
		set space "    "
		array set mods {
		    prefix "" suffix ""  shift0 "" shift1 "Shft+" 
		    control0 "" control1 "Ctrl+"  meta0 "" meta1 "Meta+"
		    alt0 "" alt1 "Alt+"
		}
	    }
	    default {
		return "$space$key"
	    }
	}
	return "$space$mods(prefix)$mods(shift$shift)$mods(control$control)$mods(meta$meta)$mods(alt$alt)$key$mods(suffix)"
    }

    if {!$nativeMenu} {
        array set menupaths "
	    menubutton#1 ${base}.menubutton#1
	    menubutton#2 ${base}.menubutton#2
	    menubutton#3 ${base}.menubutton#3
	    menubutton#4 ${base}.menubutton#4
	    menubutton#5 ${base}.menubutton#5
	"

        menubutton ${base}.menubutton#1 
        $menupaths(menubutton#1) config \
	    -menu $menupaths(menubutton#1).1m -text File -underline 0 
        pack $menupaths(menubutton#1) -side left
        menubutton ${base}.menubutton#2 
        $menupaths(menubutton#2) config \
	    -cursor arrow -menu $menupaths(menubutton#2).2m \
	    -text Edit -underline 0 
        pack $menupaths(menubutton#2) -side left
        menubutton ${base}.menubutton#3 
        $menupaths(menubutton#3) config -cursor arrow \
	    -menu $menupaths(menubutton#3).3m -text Commands -underline 0 
        pack $menupaths(menubutton#3) -side left
        menubutton ${base}.menubutton#4 
        $menupaths(menubutton#4) config \
	    -menu $menupaths(menubutton#4).4m -text Preferences -underline 0 
        pack $menupaths(menubutton#4) -side left
        menubutton ${base}.menubutton#5 
        $menupaths(menubutton#5) config \
	    -menu $menupaths(menubutton#5).5m -text Help -underline 0 
        pack $menupaths(menubutton#5) -side right
	${base} config -bg [$menupaths(menubutton#1) cget -bg]
    } else {
	catch {
	    # This frame widget was created in spectcl.ui.tcl. It's used for
	    # pre-8.0 versions of Tk.
	    destroy ${topbase}.menu
	}
	$toproot config -menu ${topbase}.menu
        array set menupaths "
	    menubutton#1 ${topbase}.menu
	    menubutton#2 ${topbase}.menu
	    menubutton#3 ${topbase}.menu
	    menubutton#4 ${topbase}.menu
	    menubutton#5 ${topbase}.menu
	"
        menu ${topbase}.menu 
        ${topbase}.menu add cascade -menu $menupaths(menubutton#1).1m \
	    -label File -underline 0
        ${topbase}.menu add cascade -menu $menupaths(menubutton#2).2m \
	    -label Edit -underline 0
        ${topbase}.menu add cascade -menu $menupaths(menubutton#3).3m \
	    -label Commands -underline 0
        ${topbase}.menu add cascade -menu $menupaths(menubutton#4).4m \
	    -label Preferences -underline 0

	global tcl_platform

	if {$useAppleMenu} {
	    ${topbase}.menu add cascade -menu $topbase.menu.apple
	    ${topbase}.menu add cascade -menu $topbase.menu.help
	} else {
	    ${topbase}.menu add cascade -menu $menupaths(menubutton#5).5m \
		-label Help -underline 0 
	}
	if {$tcl_platform(platform) == "windows"} {
	    frame .divider -relief sunken -bd 1 -height 2 \
		-highlightthickness 0 -bg #e0e0e0
	    grid .divider -row 1 -column 1 -columnspan 4 -sticky news
	}
    }
    menu $menupaths(menubutton#1).1m -tearoff 0  

    $menupaths(menubutton#1).1m add command \
	-accelerator [menued_menu_accel n control] \
	-command mainmenu_new -label New -under 0
    bind all <Control-n> mainmenu_new

    $menupaths(menubutton#1).1m add command \
	-accelerator [menued_menu_accel o control] \
	-command mainmenu_open -label Open... -under 0
    bind all <Control-o> mainmenu_open

    $menupaths(menubutton#1).1m add command \
	-accelerator [menued_menu_accel s control] \
	-command mainmenu_save -label Save -under 0
    bind all <Control-s> mainmenu_save

    $menupaths(menubutton#1).1m add command \
	-command mainmenu_save_as -label {Save As...} -under 5

    $menupaths(menubutton#1).1m add separator 

    $menupaths(menubutton#1).1m add command \
	-accelerator [menued_menu_accel q control] \
	-command mainmenu_quit -label Quit -under 0

    bind all <Control-q> mainmenu_quit

    menu $menupaths(menubutton#2).2m -tearoff 0  

    $menupaths(menubutton#2).2m add command -command mainmenu_edit_code \
	-label {Edit Code} -under 5

    $menupaths(menubutton#2).2m add command -command mainmenu_edit_menus \
	-label {Edit Menus...} -under 5

    $menupaths(menubutton#2).2m add command -command mainmenu_edit_label \
	-label {Edit Text Property} -accelerator [menued_menu_accel F2] \
	-state disabled -under 5

    $menupaths(menubutton#2).2m add command \
	-accelerator [menued_menu_accel w control] \
	-command mainmenu_widget_options \
	-label {Widget Properties...}  -under 0
    bind all <Control-w> mainmenu_widget_options

    $menupaths(menubutton#2).2m add command -state disabled \
        -command mainmenu_rowcol_properties \
	-label {Row & Column Properties...} -under 0

    $menupaths(menubutton#2).2m add cascade \
	-label {Default Properties} \
	-menu $menupaths(menubutton#2).2m.generic -under 0

    set spec(m:genericMenu) [menu $menupaths(menubutton#2).2m.generic \
	-tearoff 0 ]
    
    $menupaths(menubutton#2).2m add separator  

    $menupaths(menubutton#2).2m add command \
	-accelerator [menued_menu_accel Delete] \
	-command mainmenu_delete -label Delete -under 2

    $menupaths(menubutton#2).2m add command \
	-accelerator [menued_menu_accel Insert] \
	-command mainmenu_insert -label Insert -under 0


    $menupaths(menubutton#2).2m add command \
	-accelerator [menued_menu_accel x control] \
	-command mainmenu_cut -label Cut -under 2

    $menupaths(menubutton#2).2m add command \
	-accelerator [menued_menu_accel c control] \
	-command mainmenu_copy -label Copy -under 3

    $menupaths(menubutton#2).2m add command \
	-accelerator [menued_menu_accel v control] \
	-command mainmenu_paste -label Paste -under 0

    menu $menupaths(menubutton#3).3m -tearoff 0  \

    $menupaths(menubutton#3).3m add command \
	-command mainmenu_build -label {Build} -under 0

    $menupaths(menubutton#3).3m add command \
	-accelerator [menued_menu_accel t control] \
	-command mainmenu_build_test -label {Build and Test} -under 10
    bind all <Control-t> mainmenu_build_test


    global specCommon
    if {$tcl_platform(platform) == "macintosh"} {
	if {$specCommon(lang) == "tcl"} {
	    $menupaths(menubutton#3).3m add command \
	        -command mainmenu_build_macapp -label {Build Application...} \
		-under 4
	}
    }

    $menupaths(menubutton#3).3m add command \
	-accelerator [menued_menu_accel k control] \
	-command mainmenu_kill_test -label {Stop Test} \
	-state disabled -under 0

    bind all <Control-k> mainmenu_kill_test

    $menupaths(menubutton#3).3m add command \
	-command mainmenu_load_project_into_frame \
	-label {Load Project into Frame...} \
	-state disabled -under 0

    $menupaths(menubutton#3).3m add command \
	-command mainmenu_attach_scrollbars \
	-label {Attach Scrollbars} -under 0

    $menupaths(menubutton#3).3m add command \
	-accelerator [menued_menu_accel r control] \
	-command mainmenu_reapply_toolbar \
	-label {Reapply the Toolbar} -under 0

    bind all <Control-r> mainmenu_reapply_toolbar

    $menupaths(menubutton#3).3m add cascade \
	-command mainmenu_navigate -label Navigate \
	-menu $menupaths(menubutton#3).3m.6m -under 0

    $menupaths(menubutton#3).3m add command \
	-command mainmenu_showconsole -label {Show Console} -under 5

    $menupaths(menubutton#3).3m add command \
	-command mainmenu_hideconsole -label {Hide Console} -under 0

    menu $menupaths(menubutton#3).3m.6m -tearoff 0  

    $menupaths(menubutton#3).3m.6m add command \
	-accelerator [menued_menu_accel Right shift] \
	-command mainmenu_next_widget -label {Next Widget} -under 0

    $menupaths(menubutton#3).3m.6m add command \
	-accelerator [menued_menu_accel Left shift] \
	-command mainmenu_previous_widget \
	-label {Previous Widget} -under 0

    $menupaths(menubutton#3).3m.6m add command \
	-accelerator [menued_menu_accel Up] \
	-command mainmenu_leave_subgrid -label {Select Parent} -under 11 \
	-state disabled

    $menupaths(menubutton#3).3m.6m add command \
	-accelerator [menued_menu_accel Down] \
	-command mainmenu_enter_subgrid -label {Select 1st Child} -under 8 \
	-state disabled

    menu $menupaths(menubutton#4).4m -tearoff 0 

    $menupaths(menubutton#4).4m add command \
	-command mainmenu_options -label Options... -under 0

    $menupaths(menubutton#4).4m add separator 

    $menupaths(menubutton#4).4m add command \
	-command mainmenu_save_options -label {Save Options} -under 0

    if {$useAppleMenu} {
	# Native .apple and .help menu should work for Tk > 8.0b1
	#
	set apple [menu $topbase.menu.apple -tearoff 0]
	set help  [menu $topbase.menu.help  -tearoff 0]

	$apple add command -command mainmenu_about \
	    -label "About SpecTcl..."

	$help add command \
	    -accelerator [menued_menu_accel F1] \
	    -command mainmenu_help -label "Help Contents" -under 0

	$help add command \
	    -command mainmenu_getting_started -label {Getting Started} -under 0
    } else {
	menu $menupaths(menubutton#5).5m -tearoff 0 

	$menupaths(menubutton#5).5m add command \
	    -accelerator [menued_menu_accel F1] \
	    -command mainmenu_help -label "Help Contents" -under 0

	$menupaths(menubutton#5).5m add command \
	    -command mainmenu_getting_started -label {Getting Started} -under 0

	$menupaths(menubutton#5).5m add separator 

	$menupaths(menubutton#5).5m add command -command mainmenu_about \
	    -label About -under 0
    }

    bind all <Help> mainmenu_help
    bind all <F1>   mainmenu_help

    rename menued_menu_accel {}

    bind . <Insert>      {check_key_context %W mainmenu_insert}
    bind . <Delete>      {check_key_context %W mainmenu_keydelete}
    bind . <Control-x>   {check_key_context %W mainmenu_cut}
    bind . <Control-c>   {check_key_context %W mainmenu_copy}
    bind . <Control-v>   {check_key_context %W mainmenu_paste}
    bind . <Shift-Right> {check_key_context %W mainmenu_next_widget}
    bind . <Shift-Left>  {check_key_context %W mainmenu_previous_widget}
    bind . <Down>        {check_key_context %W mainmenu_enter_subgrid}
    bind . <Up>          {check_key_context %W mainmenu_leave_subgrid}
    bind . <Escape>      {check_key_context %W unselect_all}
    bind . <F2>          {mainmenu_edit_label}
}

# check_key_context --
#
#	Evalute a keyboard accelerators only if the event did not not
#	occur in certain contexts (inside entry, text or listbox
#	widgets).
#
# Arguments:
#	win	the widget inside which the event has occured
#	cmd	the command to execute
#
# Result:
#	None.

proc check_key_context {win cmd} {
    case [winfo class $win] {
	{Entry Listbox Text} {
	    return
	}
    }
    eval $cmd
}

# patchLevel_compare
#
#	Compares the order of two Tcl style "patclLevel" values. E.g
#	8.0b1 or 7.6p3 or 7.5
#
# Return value
#	-1	p1 < p2
#	 0	p1 = p2
#	 1	p1 > p2

proc patchLevel_compare {p1 p2} {
    # x1 and x2 can be "a", "b", "x", or "p"
    set x1 x
    set x2 x

    # y1 and y2 can be any non-negative integer
    set y1 0
    set y2 0

    set idx(a)  0
    set idx(b)  1
    set idx(x) 2
    set idx(p)  3

    if ![regexp {(^[0-9]+[.][0-9]+)([abp])([0-9]+)$} $p1 dummy ver1 x1 y1] {
	if ![regexp {(^[0-9]+[.][0-9]+)$} $p1 dummy ver1] {
	    error "$p1 is not a valid patchlevel number"
	}
    }

    if ![regexp {(^[0-9]+[.][0-9]+)([abp])([0-9]+)$} $p2 dummy ver2 x2 y2] {
	if ![regexp {(^[0-9]+[.][0-9]+)$} $p2 dummy ver2] {
	    error "$p2 is not a valid patchlevel number"
	}
    }

    if {$ver1 < $ver2} {
	return -1
    } elseif {$ver1 > $ver2} {
	return  1
    } elseif {$idx($x1) < $idx($x2)} {
	return -1
    } elseif {$idx($x1) > $idx($x2)} {
	return  1
    } elseif {$y1 < $y2} {
	return -1
    } elseif {$y1 > $y2} {
	return  1
    } else {
	return  0
    }
}
