🚀 go-pugleaf

$@"!1vLn!w%=%K!<$G$9!#(J

In article <NKATO.97Aug31134817@is17e1s08.jaist.ac.jp>
	nkato@jaist.ac.jp (Kato Naotaka) writes:

>bind .m.b1 <Enter> "tk_popup .m.b1.m $x $y"
>bind .m.b1 <Leave> ".m.b1.m unpost"  <- $@$3$l$rDj5A$9$k$H8f;XE&$N$H$*$j(J
>                                        $@F0:n$,$*$+$7$/$J$j$^$9!#(J
>                                        unpost$@$O%X%k%W%U%!%$%k$K$J$+$C$?$h$&$J(J?
>
>bind .m.b2 <Enter> "tk_popup .m.b2.m $x $y"
>bind .m.b2 <Leave> ""    <-$@;CDjA<CV$G$3$&$7$F$"$j$^$9!#(J


unpost $@$O!"(Jmenu $@%3%^%s%I$N%*%W%7%g%s$G$9$N$G!"(Jmenu $@$N%^%K%e%"%k$K(J
$@:\$C$F$$$^$9!#(Junpost $@$NH?BP$O!"MF0W$KA[A|$,IU$/$h$&$K(J post $@$G$9!#(J

$@$=$l$h$j$b!"(Jtk_mbPost, tk_mbUnpost $@$H$$$C$?%3%^%s%I$r;H$C$?$[$&$,(J
$@4JC1$+$bCN$l$^$;$s!#(J

    bind .m.b1 <Enter> "tk_mbPost .m.b1"   ;# $@0z$-?t$,(J menubutton $@$J$N$KCm0U(J
    bind .m.b2 <Enter> "tk_mbPost .m.b2"

$@$H$$$&=q$-J}$G!"=jK>$NF0:n$K6a$$$b$N$,F@$i$l$k$H;W$$$^$9!#(J

# Leave $@$KBP$7$F(J tk_mbUnpost $@$r(J bind $@$7$F$7$^$&$H!"(Jmenubutton $@$+$i(J
  $@30$K=P$?$@$1$G(J unpost $@$7$F$7$^$&$N$G!"(Jmenu $@$N9`L\$K$5$o$l$J$$$N$G$O(J...

$@0J2<$K(J tk_mbPost, tk_mbUnpost $@$r:\$;$^$9!#$=$NJU$KE>$,$C$F$$$?$b$N$K(J
$@:#2s$N;EMM$K9g$o$;$F<j$r2C$($^$7$?!#(J


proc tk_mbPost w {

    global tk_priv tk_strictMotif
    if {[lindex [$w config -state] 4] == "disabled"} {
        return
    }
    set top [winfo toplevel $w]
    if {[lindex [$top config -cursor] 4] == "watch"} {
        return
    }
    if [info exists tk_priv(posted)] {
        if {$w == $tk_priv(posted)} {
#           grab -global $tk_priv(grab)
            return
        }
    } else {
        set tk_priv(posted) ""
    }
    if [info exists tk_priv($w.menu)] {
        bind $w <Any-ButtonPress-1> tk_mbUnpost
        set menu $tk_priv($w.menu)
        set tk_priv(focus) [focus]
        focus $w
    } else {
# 	bind $w <Any-ButtonPress-1> tk_mbUnpost
	set menu [lindex [$w config -menu] 4]
    }
    if {$menu == ""} {
        return
    }
    if ![string match $w* $menu] {
        error "can't post $menu:  it isn't a descendant of $w (this is a new requirement in Tk versions 3.0 and later)"
    }
    set cur $tk_priv(posted)
    if {$cur != ""} tk_mbUnpost
    set tk_priv(relief) [lindex [$w config -relief] 4]
    $w config -relief raised
    set tk_priv(posted) $w
    if {![info exists tk_priv(focus)] || $tk_priv(focus) == ""} {
        set tk_priv(focus) [focus]
    }
    set tk_priv(activeBg) [lindex [$menu config -activebackground] 4]
    set tk_priv(activeFg) [lindex [$menu config -activeforeground] 4]
    if $tk_strictMotif {
        $menu config -activebackground [lindex [$menu config -background] 4]
        $menu config -activeforeground [lindex [$menu config -foreground] 4]
    }
    $menu activate none
    focus $menu
    bind $menu <Leave> tk_mbUnpost
    $menu post [winfo rootx $w] [expr [winfo rooty $w]+[winfo height $w]]
    if [catch {set grab $tk_priv(menuBarFor[winfo toplevel $w])}] {
        set grab $w
    } else {
        if [lsearch $tk_priv(menusFor$grab) $w]<0 {
            set grab $w
        }
    }
    set tk_priv(cursor) [lindex [$grab config -cursor] 4]
    $grab config -cursor arrow
    set tk_priv(grab) $grab
#   grab -global $grab
}

proc tk_mbUnpost {} {

    global tk_priv
    if [info exists tk_priv(posted)] {
        set w $tk_priv(posted)
    } else {
	set w ""
    }
    if {$w != ""} {
        catch {
            if [info exists tk_priv($w.menu)] {
                set menu $tk_priv($w.menu)
                bind $w <Any-ButtonPress-1> {}
            } else {set menu [lindex [$w config -menu] 4]}
            $menu unpost
            $menu config -activebackground $tk_priv(activeBg)
            $menu config -activeforeground $tk_priv(activeFg)
            $w config -relief $tk_priv(relief)
        }
        catch {$tk_priv(grab) config -cursor $tk_priv(cursor)}
        catch {focus $tk_priv(focus)}
        grab release $tk_priv(grab)
        set tk_priv(grab) ""
        set tk_priv(focus) ""
        set tk_priv(posted) {}
    }
}

# $@Nc(J

pack [frame .m]
menubutton .m.b1 -text "FILE" -menu .m.b1.m
menu .m.b1.m
m.b1.m add command -label "NEW" -command {puts new}
m.b1.m add separator
m.b1.m add command -label "QUIT" -command {destroy .}

menubutton .m.b2 -text "EVAL" -menu .m.b2.m
menu .m.b2.m
pack .m.b1 .m.b2 -side left
m.b2.m add command -label "GRAPH" -command {puts graph}
bind .m.b1 <Enter> {tk_mbPost .m.b1}
bind .m.b2 <Enter> {tk_mbPost .m.b2}

--
Toru "devil-may-care" Shiono          Sony Corporation, JAPAN