Flashing a GUI button using Perl & Ttk on a Mac

Question

Using Perl v5.28, Tkx.pm v1.10 with ActiveState Tcl/TTk v8.6.9 ('aqua' style), on macOS v10.13.6. The demo below works as desired, enabling the calling of a given subroutine using either a GUI button push using the mouse, or using keyboard input with a 'normal' text character.

The one additional feature I would like to have is the visual feedback of the graphical button being pressed (flashing) when the keyboard alternative activation is used. I found what looks like a Tcl solution using the event generate command, and a reference on using the Perl Tkx::event_generate() virtual event method call. I even found the equivalent Perl Tkx::after(100) function call to create the suggested delay. But I can't wrap my head around how to put this all together to achieve the desired effect. Any help would be appreciated, with the understanding that, like some other TTk features, this might not work on the Mac.

CODE

#!/usr/bin/env perl
# -*- cperl -*-

use warnings;
use strict;
use Tkx; $Tkx::TRACE = 1;
my $mw = Tkx::widget->new(".");
$mw->g_wm_geometry('200x200+100+100');

my $l = $mw->new_ttk__label
  (
    -text => ("Button Test Ttk v" . Tkx::info("patchlevel"))
  );

sub greeting { print(STDERR "--> [ Hello, world ] pressed\n") }

my $b = $mw->new_ttk__button
  (
         -text => "Hello, world",
    -underline => 0,
      -command => sub { greeting() }
  );

$mw->g_bind('<h>', sub { $b->invoke() });
$mw->g_bind('<H>', sub { $b->invoke() });
$l->g_pack();
$b->g_pack();
Tkx::MainLoop();

print(STDERR "Program exit...\n");

RUN LOG

Tkx-1-0.0s-demo-12: wm geometry . 200x200+100+100
Tkx-2-0.0s-demo-14: info patchlevel
Tkx-3-0.0s-demo-14: winfo children .
Tkx-4-0.0s-demo-14: ttk::label .l -text {Button Test Ttk v8.6.9}
Tkx-5-0.0s-demo-26: winfo children .
Tkx-6-0.0s-demo-26: ttk::button .b -text {Hello, world} -underline 0 -command perl::callback
Tkx-7-0.0s-demo-28: bind . <h> perl::callback
Tkx-8-0.0s-demo-29: bind . <H> perl::callback
Tkx-9-0.0s-demo-30: pack .l
Tkx-10-0.0s-demo-31: pack .b
--> [ Hello, world ] pressed
Tkx-11-6.4s-demo-28: .b invoke
--> [ Hello, world ] pressed
Tkx-12-7.9s-demo-29: .b invoke
--> [ Hello, world ] pressed
Program exit...

Answer 1

Here is an example (tested on Ubuntu 21.04). By calling g_event_generate("<ButtonPress-1>") on the button, invoke() will be automatically called on the button:

use feature qw(say);
use strict;
use warnings;
use Tkx;
my $mw = Tkx::widget->new(".");
$mw->g_wm_geometry('200x200+100+100');

my $l = $mw->new_ttk__label(
    -text => ("Button Test Ttk v" . Tkx::info("patchlevel"))
);

sub greeting { say "--> [ Hello, world ] pressed"; }

my $b = $mw->new_ttk__button(
    -text      => "Hello, world",
    -underline => 0,
    -command   => sub { greeting() }
);
sub generate_button_click_event {
    $b->g_event_generate("<ButtonPress-1>");
    Tkx::after(
        200, sub {
            $b->g_event_generate("<ButtonRelease-1>");
        }
    );
}

$mw->g_bind('<h>', sub { generate_button_click_event() });
$mw->g_bind('<H>', sub { generate_button_click_event() });
$l->g_pack();
$b->g_pack();
Tkx::MainLoop();
say "Program exit...";