Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling

Gtk2 X11 GrabKey

by basiliscos (Pilgrim)
on Dec 14, 2013 at 14:43 UTC ( #1067146=perlquestion: print w/replies, xml ) Need Help??
basiliscos has asked for the wisdom of the Perl Monks concerning the following question:

Hello! I need to show my Gtk2 application, when some "global" hotkey is been pressed. I tried to do that way, but it doesn't work:
#!/usr/bin/env perl use 5.12.0; use strict; use warnings; use AnyEvent; use Carp; use Devel::Comments; use Gtk2 -init; use X11::Protocol; use X11::Keyboard; my $window = Gtk2::Window->new ('toplevel'); my $button = Gtk2::Button->new ('Quit'); $button->signal_connect (clicked => sub { Gtk2->main_quit }); $window->add ($button); $window->show_all; my $x = X11::Protocol->new; my $k = X11::Keyboard->new($x); my $mask = $x->pack_event_mask('KeyPress'); $x->ChangeWindowAttributes($x->root, event_mask => $mask); $x->event_handler(sub { say "z"; }); my $seq = $x->GrabKey($k->KeysymToKeycode("z"), 'AnyModifier', $x->root, 1, 'Asynchronous', 'Asy +nchronous'); Gtk2->main;
I need to get the global key press asynchronously; when I fetch them directly/synchronously, than it works:
$x->event_handler ('queue'); my %event = $x->next_event;
The problem with the last piece of code, that it blocks all my GUI. The guys in Internet offered an solution to use separate pthread in such a blocking manner, but it's OK for C, and not OK for perl. Thanks a lot for any suggestions!

Replies are listed 'Best First'.
Re: Gtk2 X11 GrabKey
by Rhandom (Curate) on Dec 14, 2013 at 22:11 UTC

    X11::Protocol often is just a simple network socket. You can access the deep underlying handle and wait for input via select - and it is pretty simple. I did that in File::KeePass::Agent in the module because I wanted to listen for global events as well as have a local gui running at the same time in the same process. Here is the relevant code snippet:

    sub _listen { my $self = shift; my $x = $self->x; $x->event_handler('queue'); # listen to both the x protocol events as well as our local term require IO::Select; my $in_fh = ...; # some other handle I'm looking at my $x_fh = $x->{'connection'}->fh; $x_fh->autoflush(1); $in_fh->autoflush(1); my $sel = IO::Select->new($x_fh, $in_fh); # handle events as they occur $self->_init_state(1); my $i; while (1) { my ($fh) = $sel->can_read(10); next if ! $fh; if ($fh == $in_fh) { $self->_handle_term_input($fh) || last; } else { $self->read_x_event; } } } sub read_x_event { my $self = shift; my $cb_map = shift || $self->{'global_cb_map'} || die "No global c +allbacks initialized\n"; my $x = $self->x; my %event = $x->next_event; return if ($event{'name'} || '') ne 'KeyRelease'; my $code = $event{'detail'}; my $mod = $event{'state'}; ... the rest of my code here }

    Once you have a select handle, you can can_read for input with a time out as part of the Gtk loop or any AnyEvent loop - but I'll leave that for you to setup :)

    my @a=qw(random brilliant braindead); print $a[rand(@a)];
Re: Gtk2 X11 GrabKey
by dcmertens (Beadle) on Dec 14, 2013 at 14:56 UTC

    My initial reaction: why not just use the Gtk interface for detecting a key press? Isn't there a way to add an event callback for a keypress in Gtk? I know how to do this in Prima and can't imagine Gtk doesn't have something similar.

    Then I re-read your post, and decided that when you said "I need to get the global key press asynchronously", that you want to get that keypress even if the user is actively using any application. Is that what you mean?

      ... using any application ...

      I think so, thats usually what they mean by "global hotkey" or "system wide hotkey"

      gtk apparently doesn't have a global hotkey capability built-in -- if the app/window doesn't have focus, it can't get events -- python/c/cpp folks apparently use libkeybinder (whatever that is)

      the OP issue appears to be that Gtk2->main; is blocking (or the other piece of code is blocking) ... so needs to poll, something along the lines of Re: AnyEvent + Wx, Gtk2/3 or Tk ?

        Thanks all!

        Unfortunately I don't see event-loop in X11::Protocol, i.e. polling capabilities. I don't wan't go to low-level capabilities, i.e. poll underlying socket for events. I'll try to use the libkeybinder, and tell the details here.

        PS. Mixed usage of Gtk2 events and X11 events seems to be leading to some messy:

        ... my $seq = $x->GrabKey( $k->KeysymToKeycode("z"), 'AnyModifier', $x->root, 0, 'Asynchronous', 'Asynchronous'); $x->event_handler('queue'); my %event = $x->next_event; ### %event my $t = AE::timer 0, 1, sub { my %event = $x->next_event; # %event }; Gtk2->main;
        It exists with:
        Protocol error: bad 2 (Value); Sequence Number 4 Opcode (33, 0) = GrabKey Bad value 183 (0xb7) at ./gtk-treeview-action line 31.
Re: Gtk2 X11 GrabKey
by zentara (Archbishop) on Dec 15, 2013 at 14:47 UTC
    Just for the sake of gtk2 posterity, I will post the example codes I've cobbled together, mostly from the gtk2-perl maillist archives.

    Anyways, on to the show as they say. Just run them and see the difference.


    #!/usr/bin/perl use warnings; use strict; my $password= 'q'; my $message="Type password to quit\n:"; my $noshow='stars'; # 1,0,or stars my $maxshownlength=30; my @startpos=(100,100); use Gtk2 -init; my $w = new Gtk2::Window('popup'); my $l = new Gtk2::Label($message); my $eb = new Gtk2::EventBox; my $gdkwin; my $grabstatus; my $typed=""; $w->add($eb); $eb->add($l); $w->add_events( [ qw(key_press_mask) ]); $w->signal_connect('key_press_event', \&do_keypress); $w->signal_connect('realize', sub { $w->window->move(@startpos); }); $w->signal_connect('map', sub { $gdkwin=$w->window; do_grab(); }); $w->show_all; Gtk2->main; sub do_grab() { $grabstatus= Gtk2::Gdk->keyboard_grab( $gdkwin, 1 ,Gtk2::Gdk::X11->get_server_time($gdkwin) ); if($grabstatus ne "success") { $l->set_text("keyboard grab failed"); } } sub do_ungrab() { Gtk2::Gdk->keyboard_ungrab(Gtk2::Gdk::X11->get_server_time($gdkwin)) +; } sub do_keypress(@) { my ($widg,$evt)=@_; my $kv = $evt->keyval; my $cs = Gtk2::Gdk->keyval_name($kv); if($cs =~ /Return|Enter/){ if($typed eq $password) { do_ungrab(); Gtk2->main_quit; }else{ $typed=""; } }elsif(length($cs) == 1 && $cs =~ /[[:print:]]/){ $typed .= $cs; } my $showtyped=$typed; if($noshow eq "stars"){ $showtyped =~ s/[^*]/*/g; } elsif($noshow){ $showtyped=""; } if(length($showtyped) > $maxshownlength){ $showtyped=substr($showtyped,0,$maxshownlength); } $l->set_text($message.$showtyped); }


    #!/usr/bin/perl use warnings; use strict; use Gtk2 -init; my $password= 'q'; my $message="Type password to quit"; my $typed=""; my $gdkwin; my $mw = new Gtk2::Window('popup'); $mw->set_position('center'); my $vbox = Gtk2::VBox->new(0,5); $mw->add($vbox); my $msg_w_markup = Gtk2::Label->new(); $msg_w_markup->set_justify('left'); $msg_w_markup->set_markup(" <span background = 'black' foreground= 'green' size ='30000'> <i>$mess +age</i></span>"); $vbox->pack_start($msg_w_markup,0,0,4); my $typed_w_markup = Gtk2::Label->new(); $typed_w_markup->set_justify('left'); $typed_w_markup->set_alignment(0, 0.5); $typed_w_markup->set_markup(" <span background = 'black' foreground= 'red' size ='30000'>$typed</spa +n>"); $vbox->pack_start($typed_w_markup,0,0,4); $mw->add_events( [ qw(key_press_mask) ]); $mw->signal_connect('key_press_event', \&do_keypress); #$mw->signal_connect('realize', sub { $mw->window->move(50,40); }); # must define gdkwin after it is mapped $mw->signal_connect('map', sub { $gdkwin = $mw->window ; do_grab(); }) +; $mw->show_all; Gtk2->main; sub do_grab() { my $grabstatus= Gtk2::Gdk->keyboard_grab( $gdkwin, 1 ,Gtk2::Gdk::X11->get_server_time($gdkwin) ); if($grabstatus ne "success") { $msg_w_markup->set_text("keyboard grab failed"); } } sub do_ungrab() { Gtk2::Gdk->keyboard_ungrab(Gtk2::Gdk::X11->get_server_time($gdkwin)) +; } sub do_keypress(@) { my ($widget,$event)=@_; my $kv = $event->keyval; my $kn = Gtk2::Gdk->keyval_name($kv); if($kn =~ /Return|Enter/){ if($typed eq $password) { do_ungrab(); Gtk2->main_quit; }else{ $typed=""; } }elsif(length($kn) == 1 && $kn =~ /[[:print:]]/){ $typed .= $kn; } my $showtyped=$typed; if(length($showtyped) > 30){ $showtyped=substr($showtyped,0,30); } $typed_w_markup->set_markup(" <span background = 'black' foreground= 'red' size ='30000'> <i>$sh +owtyped</i></span>"); }

    and finally


    #!/usr/bin/perl use warnings; use strict; use Glib qw/TRUE FALSE/; use Gtk2::Gdk::Keysyms; use Gtk2 '-init'; $|++; my $window = Gtk2::Window->new('toplevel'); $window->set_title('Z0'); $window ->signal_connect( 'destroy' => \&delete_event ); $window->set_border_width(10); $window->set_size_request(300,200); my $window1 = Gtk2::Window->new('toplevel'); $window1->set_title('Z1'); $window1->set_border_width(10); $window1->set_size_request(300,200); my $textbuffer1 = Gtk2::TextBuffer->new(); my $textview1 = Gtk2::TextView->new_with_buffer($textbuffer1); $window1->add($textview1); my $vbox = Gtk2::VBox->new( FALSE, 6 ); $window->add($vbox); $vbox->set_border_width(2); my $textbuffer = Gtk2::TextBuffer->new(); my $textview = Gtk2::TextView->new_with_buffer($textbuffer); $vbox->pack_start($textview,1,1,0); my $hbox= Gtk2::HBox->new( FALSE, 6 ); $vbox->pack_end($hbox,FALSE,FALSE,0); $hbox->set_border_width(2); my $button = Gtk2::Button->new_from_stock('gtk-quit'); $hbox->pack_end( $button, FALSE, FALSE, 0 ); $button->signal_connect( clicked => \&delete_event ); my $button1 = Gtk2::Button->new('Global Grab'); $hbox->pack_end( $button1, FALSE, FALSE, 0 ); $button1->signal_connect( clicked => sub{ # my $rc; # $rc = Gtk2::Gdk->pointer_grab($window->window,1,['button-press-mask +','button-release-mask','pointer-motion-mask'],undef,undef,Gtk2->get_ +current_event_time); # print "$rc\n"; # $rc = Gtk2::Gdk->keyboard_grab($window->window,0,Gtk2->get_current_ +event_time); # print "$rc\n"; $window->grab_focus; } ); $window->set_position('center'); $window->show_all(); $window1->show_all(); $window->signal_connect( 'key_release_event' => \&keyrelease ); $window->signal_connect (event => sub { my ($item, $event) = @_; warn "event ".$event->type."\n"; # print chr(07); #beep return 0; #return 1 prevents window from closing # return 0 lets the signal thru }); Gtk2->main; ##################################### sub delete_event { Gtk2->main_quit; return FALSE; } sub keyrelease { my ( $widget, $event ) = @_; print $event->keyval,"\n"; print chr(07); #beep if ( $event->keyval == $Gtk2::Gdk::Keysyms{q} ) { Gtk2->main_quit; } else { print "key was ", chr( $event->keyval ), "\n"; } }

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh
Re: Gtk2 X11 GrabKey
by Anonymous Monk on Dec 14, 2013 at 15:22 UTC

    but it's OK for C, and not OK for perl.

    Why not?

    You can always setup a timer (say 30ms) and check

Re: Gtk2 X11 GrabKey
by basiliscos (Pilgrim) on Dec 21, 2013 at 17:53 UTC
    libkeybinder seems to be what I exactly looked for. I have created simple perl bindings for it see at metacpan. This is my first XS module, so any comments are appreciated.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1067146]
Approved by Tanktalus
Front-paged by Tanktalus
LanX my favourite don't tell me the proof of concept is good enough for production anecdote
[ambrus]: ah, it's one of thos
[Eily]: what, there's a difference between proof of concept and production?
[LanX]: 20 years ago traders were complaining about the latency of the trading system...
[ambrus]: I'm currently in the process of rewriting my proof of concept programs. They sort of developped organically as I was experimenting, so now I've got an ugly mess of multiple programs and one-liners held together by nothing. I'll have to rewrite them to som
[ambrus]: ething that's both cleanly organized and mostly automated.
LanX in train, bad connection
[Corion]: ambrus: Yeah - we're in that situation too, except that there is no time to do the reorganizing :-/
[LanX]: ... so my boss started a project with the newest sun servers and invited the traders to come on weekend to test it... and they were so pleased, that they forced him to keep it in production...
[ambrus]: Corion: sure, this is the long-term plan. The short term is that I have to run this ungodly mess to get results from the new input data today.

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (15)
As of 2017-03-29 11:47 GMT
Find Nodes?
    Voting Booth?
    Should Pluto Get Its Planethood Back?

    Results (350 votes). Check out past polls.