Skip Menu |

This queue is for tickets about the Tk CPAN distribution.

Report information
The Basics
Id: 104352
Status: rejected
Priority: 0/
Queue: Tk

People
Owner: Nobody in particular
Requestors: turnerjw784 [...] yahoo.com
Cc:
AdminCc:

Bug Information
Severity: Wishlist
Broken in: (no value)
Fixed in: (no value)



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"]); > } > }
On 2015-05-11 11:54:09, TURNERJW wrote: Show quoted text
> 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: >
Hi Jim, Tk is quite mature and I don't think it's good to make such a change in a core widget. It's probably better to create a separate derived widget which does the additional underline magic. Such a derived widget should also do the right thing if a button is changed afterwards using $button->configure(-text => ..., -underline => ...) And an interesting question: what if $b->configure(-underline => -1) was called? Should the binding be removed in this case? Alternatively you can consider to use the CPAN module https://metacpan.org/pod/Tk::autobind which would create the Alt binding just by calling $button->autobind after creation. If you want to fix all buttons in your application at once, then calling something like $mw->Walk(sub { my $w = shift; if ($w->isa('Tk::Button')) { $w->autobind } }); just before entering MainLoop could work (untested) (Maybe such a convenience function would be a nice additional feature for the Tk::autobind module?) If you really want to use your patch, then it's probably better to monkey-patch it within your application instead of changing the Tk code. Just put the following into your application: { use Tk::Button; package Tk::Button; sub InitObject { ... your code ... } } Regards, Slaven