Subject: | Tk::Button: Request to actually bind alt-key in -underline option |
Please make <Alt-<letter>> binding actually work when -underline option specified in Tk::Button.
I wrote this patch many many years ago, but it still seems to work with the latest version of Tk (v1:804.033-1). It is a simple patch which I have to re-add myself on each new Tk installation:
Thanks for your consideration.
Jim Turner
Subject: | Button.diff |
14a15,20
> #
> # WARNING: MODIFIED 7/3/97 BY JIM TURNER (JWT) OF LOCKHEED MARTIN TO CAUSE
> # UNDERLINED-CHARACTERS IN BUTTONS TO BE BOUND TO THE BUTTON'S TOP-LEVEL
> # WIDGET AS "<ALT-key>" SO THAT ALT-SEQUENCE ACTUALLY INVOKES BUTTON!
> # ALSO MAKE -TEXT OPTION SUPPORT "~" (ie. "te~xt" same as -underline=>2)!
> #
38a45,78
> }
>
> sub InitObject #ADDED 7/3/97 BY JWT TO CREATE ALT-KEY BINDINGS IN TOPLEVEL
> { #FOR UNDERLINED CHARACTERS IN BUTTONS!
> my ($w,$args) = @_;
>
> my ($ul);
>
> $w->SUPER::InitObject($args);
>
> my ($mytext) = $args->{'-text'};
>
> if (defined($mytext)) #ONLY BOTHER IF -TEXT OPTION DEFINED!
> {
> if (defined($args->{'-underline'})) #USE -UNDERLINE VALUE.
> {
> $ul = $args->{'-underline'};
> $ul = undef if ($ul < 0 || $ul > length($mytext));
> }
> else #NO -UNDERLINE, SEE IF THERE'S A "~" IN -TEXT!
> {
> $ul = ($mytext =~ s/^(.*)~(.+)$/$1$2/) ? length($1): undef;
> if (defined($ul)) #THERE IS A "~" SET UNDERLINE TO NEXT CHAR.
> {
> $args->{'-underline'} = $ul;
> $args->{'-text'} = $mytext; #STRIP "~" FROM -TEXT.
> }
> }
> if (defined($ul)) #BIND ALT-CHAR TO INVOKE BUTTON IF UNDERLINE OR "~".
> {
> $ul = substr($mytext,$ul,1); #CONVERT CHAR. POSN TO ACTUAL CHAR.
> $w->toplevel->bind("<Alt-\l$ul>", [$w => "Invoke"]);
> }
> }