1# Copyright 2011, 2012, 2013, 2014, 2016, 2017, 2019 Kevin Ryde 2 3# This file is part of X11-Protocol-Other. 4# 5# X11-Protocol-Other is free software; you can redistribute it and/or 6# modify it under the terms of the GNU General Public License as published 7# by the Free Software Foundation; either version 3, or (at your option) any 8# later version. 9# 10# X11-Protocol-Other is distributed in the hope that it will be useful, 11# but WITHOUT ANY WARRANTY; without even the implied warranty of 12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 13# Public License for more details. 14# 15# You should have received a copy of the GNU General Public License along 16# with X11-Protocol-Other. If not, see <http://www.gnu.org/licenses/>. 17 18 19BEGIN { require 5 } 20package X11::Protocol::ChooseWindow; 21use strict; 22use Carp; 23 24use vars '$VERSION', '$_instance'; 25$VERSION = 31; 26 27use X11::Protocol::WM; 28 29# uncomment this to run the ### lines 30# use Smart::Comments; 31 32 33# undocumented yet ... 34sub new { 35 my $class = shift; 36 return bless { want_client => 1, 37 @_ }, $class; 38} 39 40sub _X { 41 my ($self) = @_; 42 return ($self->{'X'} ||= do { 43 require X11::Protocol; 44 my $display = $self->{'display'}; 45 ### $display 46 X11::Protocol->new (defined $display ? ($display) : ()); 47 }); 48} 49 50sub choose { 51 my ($self, %options) = @_; 52 unless (ref $self) { 53 $self = $self->new; # X11::Protocol::ChooseWindow->choose() 54 } 55 local @{$self}{keys %options} = values %options; # hash slice 56 local $_instance = $self; 57 58 my $X = _X($self); 59 { 60 my $old_event_handler = $X->{'event_handler'}; 61 local $X->{'event_handler'} = sub { 62 $self->handle_event (@_); 63 goto $old_event_handler; 64 }; 65 66 $self->start; 67 do { 68 $X->handle_input; 69 } until ($self->is_done); 70 } 71 72 return $self->chosen_window; 73} 74 75sub chosen_window { 76 my ($self) = @_; 77 if ($self->{'want_client'}) { 78 return $self->client_window; 79 } else { 80 return $self->{'frame_window'}; 81 } 82} 83sub client_window { 84 my ($self) = @_; 85 if (! exists $self->{'client_window'}) { 86 my $frame_window = $self->{'frame_window'}; 87 ### frame_window: $frame_window.sprintf(' 0x%X',$frame_window) 88 $self->{'client_window'} 89 = (defined $frame_window && _num_none($frame_window) != 0 90 ? X11::Protocol::WM::frame_window_to_client(_X($self),$frame_window) 91 : undef); 92 ### client_window: $self->{'client_window'} 93 } 94 return $self->{'client_window'}; 95} 96 97# undocumented yet ... 98sub start { 99 my ($self) = @_; 100 101 $self->abort; 102 $self->{'frame_window'} = undef; 103 delete $self->{'client_window'}; 104 $self->{'button_released'} = 0; 105 my $X = _X($self); 106 107 my $want_free_cursor; 108 my $cursor = $self->{'cursor'}; 109 if (! defined $cursor) { 110 my $cursor_glyph = $self->{'cursor_glyph'}; 111 if (! defined $cursor_glyph) { 112 require X11::CursorFont; 113 my $cursor_name = $self->{'cursor_name'}; 114 if (! defined $cursor_name) { 115 $cursor_name = 'crosshair'; # default 116 } 117 $cursor_glyph = $X11::CursorFont::CURSOR_GLYPH{$cursor_name}; 118 if (! defined $cursor_glyph) { 119 croak "Unrecognised cursor_name: ",$cursor_name; 120 } 121 } 122 123 my $cursor_font = $X->new_rsrc; 124 $X->OpenFont ($cursor_font, 'cursor'); 125 126 $cursor = $X->new_rsrc; 127 $X->CreateGlyphCursor ($cursor, 128 $cursor_font, # font 129 $cursor_font, # mask font 130 $cursor_glyph, # glyph number 131 $cursor_glyph+1, # and its mask 132 0,0,0, # foreground, black 133 0xFFFF, 0xFFFF, 0xFFFF); # background, white 134 $want_free_cursor = 1; 135 $X->CloseFont ($cursor_font); 136 } 137 ### cursor: sprintf '%d %#X', $cursor, $cursor 138 139 my $root = $self->{'root'}; 140 if (! defined $root) { 141 if (defined (my $screen_number = $self->{'screen'})) { 142 $root = $X->{'screens'}->[$screen_number]->{'root'}; 143 } else { 144 $root = $X->{'root'}; 145 } 146 } 147 ### $root 148 149 # follow any __SWM_VROOT 150 $root = (X11::Protocol::WM::root_to_virtual_root($X,$root) || $root); 151 152 my $time = $self->{'time'} || $self->{'event'}->{'time'} || 'CurrentTime'; 153 ### $time 154 155 my $status = $X->GrabPointer 156 ($root, # window 157 0, # owner events 158 $X->pack_event_mask('ButtonPress','ButtonRelease'), 159 'Synchronous', # pointer mode 160 'Asynchronous', # keyboard mode 161 $root, # confine window 162 $cursor, # crosshair cursor 163 $time); 164 if ($status eq 'Success') { 165 $self->{'ungrab_time'} = $time; 166 } 167 if ($want_free_cursor) { 168 $X->FreeCursor ($cursor); 169 } 170 if ($status ne 'Success') { 171 croak "Cannot grab mouse pointer to choose a window: ",$status; 172 } 173 $X->AllowEvents ('SyncPointer', 'CurrentTime'); 174} 175 176# undocumented yet ... 177sub handle_event { 178 my ($self, %h) = @_; 179 ### ChooseWindow handle_event: %h 180 return if $self->is_done; 181 182 my $name = $h{'name'}; 183 my $X = _X($self); 184 185 if ($name eq 'ButtonPress') { 186 ### ButtonPress 187 $self->{'frame_window'} = $h{'child'}; 188 $self->{'choose_time'} = $h{'time'}; 189 $X->AllowEvents ('SyncPointer', 'CurrentTime'); 190 191 } elsif ($name eq 'ButtonRelease') { 192 ### ButtonRelease 193 # wait for button pressed to choose window, and then released so the 194 # release event doesn't go to the chosen window 195 if ($self->{'frame_window'}) { 196 # button press seen, and now release seen 197 $self->{'button_released'} = 1; 198 $self->{'ungrab_time'} = $h{'time'}; 199 $self->abort; # ungrab 200 } else { 201 $X->AllowEvents ('SyncPointer', 'CurrentTime'); 202 } 203 } 204} 205 206# undocumented yet ... 207sub is_done { 208 my ($self) = @_; 209 return (! defined $self->{'ungrab_time'} # aborted or never started 210 || ($self->{'frame_window'} && $self->{'button_released'})); 211} 212 213sub DESTROY { 214 my ($self) = @_; 215 my ($X, $ungrab_time); 216 if (defined ($X = $self->{'X'}) 217 && defined ($ungrab_time = delete $self->{'ungrab_time'})) { 218 # no errors if connection gone 219 eval { $X->UngrabPointer ($ungrab_time) }; 220 } 221} 222 223# undocumented yet ... 224sub abort { 225 my ($self, $time) = @_; 226 if (! ref $self) { 227 # class method X11::Protocol::ChooseWindow->abort() 228 $self = $_instance || return; # if not in a ->choose() 229 } 230 my ($X, $ungrab_time); 231 if (defined ($X = $self->{'X'}) 232 && defined ($ungrab_time = delete $self->{'ungrab_time'})) { 233 $X->UngrabPointer ($time || $ungrab_time); 234 } 235} 236 237sub _num_none { 238 my ($xid) = @_; 239 if (defined $xid && $xid eq "None") { 240 return 0; 241 } else { 242 return $xid; 243 } 244} 245 2461; 247__END__ 248 249 250# Not quite yet. 251 252# =head2 Chooser Object 253# 254# A chooser object can be created to choose in a state-driven style. 255# 256# =over 257# 258# =item C<$chooser = X11::Protocol::ChooseWindow-E<gt>new (key=E<gt>value,...)> 259# 260# Create and return a chooser object. The key/value parameters are the same 261# as for C<choose()> above. 262# 263# =item C<$window = $chooser-E<gt>choose (key=E<gt>value,...)> 264# 265# Run a window choose on C<$chooser>. Key/value parameters are as per the 266# C<choose()> class method above. They're apply to this choose, without 267# changing the C<$chooser> object. 268# 269# =item C<$boolean = $chooser-E<gt>start ()> 270# 271# Start a window choose. This means a mouse pointer grab, with cursor per the 272# options in C<$chooser>. 273# 274# =item C<$window = $chooser-E<gt>handle_event (@fields)> 275# 276# Handle an event in C<$chooser>. The C<@fields> arguments are the same as 277# from the C<X11::Protocol> event handler function. All events should be 278# shown to the chooser this way while it's active. Anything not relevant is 279# ignored. 280# 281# For a C<ButtonPress> or C<ButtonRelease> event an C<AllowEvents> request 282# is sent to get the next button event, in the usual way for an active 283# pointer grab. 284# 285# =item C<$boolean = $chooser-E<gt>is_done ()> 286# 287# Return true if choosing is finished, meaning C<$chooser-E<gt>handle_event()> 288# has seen button press and release events. 289# 290# =item C<$chooser-E<gt>abort> 291# 292# Stop a choose. 293# 294# =item C<$chooser-E<gt>chosen_window> 295# 296# Return the window chosen by the user, or C<undef> if aborted or not yet 297# chosen. This can be used after C<$chooser-E<gt>is_done()> is true (though 298# actually the chosen window is recorded a little earlier, on the button 299# press, where C<is_done()> is true only after the button release). 300# 301# =back 302 303# want_frame_window boolean, default false 304# 305# C<want_frame_window> means return the immediate root window child chosen, 306# which is generally the window manager's frame window. The default is to 307# seek the client toplevel window within the frame. When there's no window 308# manager or it doesn't use frame windows then the immediate child is the 309# client window already and C<want_frame_window> has no effect. 310 311 312 313 314 315=for stopwords Ryde ChooseWindow toplevel timestamp startup crosshair 316 317=head1 NAME 318 319X11::Protocol::ChooseWindow -- user click to choose window 320 321=for test_synopsis my ($X) 322 323=head1 SYNOPSIS 324 325 use X11::Protocol::ChooseWindow; 326 my $client_window = X11::Protocol::ChooseWindow->choose (X => $X); 327 328=head1 DESCRIPTION 329 330This spot of code lets the user click on a toplevel window to choose it, in 331a similar style to the C<xwininfo> or C<xkill> programs. 332 333=head2 Implementation 334 335The choose is implemented in a similar way to the C<xwininfo> etc programs. 336It consists of C<GrabPointer()> on the root window, wait for a 337C<ButtonPress> and C<ButtonRelease> from the user, get the frame window from 338the C<ButtonPress> event, then the client window under there from 339C<frame_window_to_client()> of C<X11::Protocol::WM>. 340 341C<KeyPress> events are not used and they go to the focus window in the usual 342way. This can be good in a command line program since it lets the user 343press C<^C> (C<SIGINT>) in an C<xterm> or similar. Perhaps in the future 344there could be an option to watch for C<Esc> to cancel or some such. 345 346A virtual root per C<root_to_virtual_root()> in C<X11::Protocol::WM> is used 347if present. This helps C<ChooseWindow> work with C<amiwm> and similar 348virtual root window managers. 349 350=head1 FUNCTIONS 351 352The following C<choose()> is in class method style with the intention of 353perhaps in the future having objects of type C<X11::Protocol::ChooseWindow> 354holding state and advanced by events supplied by an external main loop. 355 356=head2 Choosing 357 358=over 4 359 360=item C<$window = X11::Protocol::ChooseWindow-E<gt>choose (key=E<gt>value,...)> 361 362Read a user button press to choose a toplevel window. The key/value options 363are as follows, 364 365 X => X11::Protocol object 366 display => string ":0:0" etc 367 368 screen => integer, eg. 0 369 root => XID of root window 370 371 time => integer server timestamp 372 event => hashref of event initiating the choose 373 374 cursor => XID of cursor 375 cursor_glyph => integer glyph for cursor font 376 cursor_name => string name from cursor font 377 378C<X> or C<display> gives the server, or the default is to open the 379C<DISPLAY> environment variable. C<X> for an C<X11::Protocol> object is 380usual, but sometimes it can make sense to open a new connection just to 381choose. 382 383C<root> or C<screen> gives the root window to choose on, or the default is 384the current screen of C<$X>, which in turn defaults to the screen part of 385the display name. If there's a window manager virtual root then that's 386automatically used as necessary. 387 388C<time> or the time field in C<event> is a server timestamp for the 389C<GrabPointer()>. This guards against stealing a grab from another client 390if badly lagged. Omitted or C<undef> means C<CurrentTime>. In a command 391line program there might be no initiating event, making C<CurrentTime> all 392that's possible. 393 394C<cursor> etc is the mouse pointer cursor to show during the choose, as a 395visual indication to the user. The default is a "crosshair". 396C<cursor_name> or C<cursor_glyph> are from the usual cursor font. See 397L<X11::CursorFont> for available names. For example perhaps the "exchange" 398cursor to choose a window for some sort of swap or flip, 399 400 $window = X11::Protocol::ChooseWindow->choose 401 (X => $X, 402 cursor_name => "exchange"); 403 404A C<cursor> XID can be created by any client as usual. Don't forget to 405flush if creating a cursor from one connection, so it's ready for use from 406another. 407 408=back 409 410=head1 SEE ALSO 411 412L<X11::Protocol>, 413L<X11::Protocol::WM>, 414L<X11::CursorFont> 415 416L<xwininfo(1)>, L<xkill(1)>, and their F<dsimple.c> C<Select_Window()> code 417 418"Inter-Client Communication Conventions Manual" section "WM_STATE Property" 419for notes on using C<WM_STATE> to identify client windows. 420 421=head1 HOME PAGE 422 423L<http://user42.tuxfamily.org/x11-protocol-other/index.html> 424 425=head1 LICENSE 426 427Copyright 2010, 2011, 2012, 2013, 2014, 2016, 2017, 2019 Kevin Ryde 428 429X11-Protocol-Other is free software; you can redistribute it and/or modify 430it under the terms of the GNU General Public License as published by the 431Free Software Foundation; either version 3, or (at your option) any later 432version. 433 434X11-Protocol-Other is distributed in the hope that it will be useful, but 435WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 436or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for 437more details. 438 439You should have received a copy of the GNU General Public License along with 440X11-Protocol-Other. If not, see <http://www.gnu.org/licenses/>. 441 442=cut 443 444 445# Maybe: 446# 447# oopery 448# ->new (want_frame => 1) 449# ->choose 450# ->start 451# ->handle_input 452# ->is_done 453# ->chosen_frame 454# ->chosen_client 455# ->chosen_window 456 457# /z/usr/share/doc/x11proto-core-dev/x11protocol.txt.gz 458# /usr/share/doc/x11proto-dev/ 459 460 461