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