1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
#!/usr/bin/perl -w
# Copyright 2011 Kevin Ryde
# This file is part of X11-Protocol-Other.
#
# X11-Protocol-Other is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 3, or (at your option) any
# later version.
#
# X11-Protocol-Other is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with X11-Protocol-Other. If not, see <http://www.gnu.org/licenses/>.
# Usage: perl xfixes-selection.pl
#
# This is an example of using XFixesSelectSelectionInput() to listen for
# changes to selection ownership.
#
# With just the core protocol this sort of thing has to be done by polling
# GetSelectionOwner() periodically. If you're the selection owner you're
# notified of its loss with an event, but third parties like a cut-buffer
# display have to poll.
#
# The key part is merely $X->XFixesSelectSelectionInput() and the
# XFixesSelectionNotify events. The window creation and GetProperty()
# nonsense are only to retrieve the selection contents. If you're
# interested in selection changes then you probably want to fetch the
# selection contents at some point.
#
# The window supplied to XFixesSelectSelectionInput() doesn't have to be a
# client window. It seems to work to give $X->root. Is it's purpose in the
# protocol to let clients dispatch events to a widget? Or have multiple
# independent parts of a program listening or some such?
#
# The only selection data type supported here is "STRING". A real program
# might ask for "TEXT" to read either STRING or COMPOUND_TEXT. The ICCCM
# spec lists a lot of possible types, but how many are usefully generated by
# programs is another matter.
#
use strict;
use X11::Protocol;
use X11::AtomConstants;
# uncomment this to run the ### lines
#use Smart::Comments;
my $X = X11::Protocol->new;
if (! $X->init_extension('XFIXES')) {
print "XFIXES extension not available on the server\n";
exit 1;
}
my $receiver_window = $X->new_rsrc;
$X->CreateWindow ($receiver_window,
$X->root, # parent
'InputOutput', # class
0, # depth, from parent
'CopyFromParent', # visual
0,0, # x,y
1,1, # width,height
0, # border
event_mask => $X->pack_event_mask('PropertyChange'));
$X->XFixesSelectSelectionInput ($receiver_window, $X->atom('PRIMARY'), 0x07);
my %converts_in_progress;
$X->{'event_handler'} = sub {
my (%h) = @_;
### event_handler: \%h
if ($h{'name'} eq 'XFixesSelectionNotify') {
my $subtype = $h{'subtype'};
my $owner = $h{'owner'};
my $selection_atom = $h{'selection'}; # eg. "PRIMARY"
if ($owner ne 'None') { $owner = sprintf('0x%X',$owner); }
printf("%s %s, owner now %s\n",
$X->atom_name($selection_atom),
$subtype,
$owner);
# ask for selection value
if ($subtype eq 'SetSelectionOwner') {
$X->ConvertSelection ($selection_atom, # atom
$X->atom('STRING'), # type
$selection_atom, # destination
$receiver_window, # destination
$h{'time'});
$converts_in_progress{$selection_atom} = 1;
}
} elsif ($h{'name'} eq 'PropertyNotify'
&& $h{'state'} eq 'NewValue'
# only the selection property receives, not other property changes
&& $converts_in_progress{$h{'atom'}}) {
# selection value received
my ($value, $type, $format, $bytes_after)
= $X->GetProperty ($receiver_window,
$h{'atom'}, # property
'AnyPropertyType', # type
0, # offset
60/4, # length limit, in 4-byte chunks
1); # delete, now have received
### $value
print " value: \"",
$value,
($bytes_after ? " ..." : ""), # if longer than requested size
"\"\n";
}
};
for (;;) {
$X->handle_input;
}
exit 0;
|
