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
|
#!/usr/bin/perl -w
use strict;
use Gtk2::TestHelper
tests => 23,
at_least_version => [2, 2, 0, "GdkDisplay is new in 2.2"];
# $Header: /cvsroot/gtk2-perl/gtk2-perl-xs/Gtk2/t/GdkDisplay.t,v 1.12 2006/08/07 18:36:02 kaffeetisch Exp $
my $display = Gtk2::Gdk::Display -> open($ENV{DISPLAY});
isa_ok($display, "Gtk2::Gdk::Display");
ok(defined($display -> get_name()));
$display = Gtk2::Gdk::Display -> get_default();
isa_ok($display, "Gtk2::Gdk::Display");
like($display -> get_n_screens(), qr/^\d+$/);
isa_ok($display -> get_screen(0), "Gtk2::Gdk::Screen");
isa_ok($display -> get_default_screen(), "Gtk2::Gdk::Screen");
$display -> pointer_ungrab(0);
$display -> keyboard_ungrab(0);
ok(!$display -> pointer_is_grabbed());
# $display -> beep();
$display -> sync();
isa_ok(($display -> list_devices())[0], "Gtk2::Gdk::Device");
$display -> put_event(Gtk2::Gdk::Event -> new("button-press"));
isa_ok($display -> peek_event(), "Gtk2::Gdk::Event");
isa_ok($display -> get_event(), "Gtk2::Gdk::Event");
$display -> set_double_click_time(20);
my ($screen, $x, $y, $mask) = $display -> get_pointer();
isa_ok($screen, "Gtk2::Gdk::Screen");
like($x, qr/^\d+$/);
like($y, qr/^\d+$/);
isa_ok($mask, "Gtk2::Gdk::ModifierType");
# warn $display -> get_window_at_pointer();
SKIP: {
skip("stuff new in 2.4", 6)
unless Gtk2 -> CHECK_VERSION(2, 4, 0);
$display -> flush();
$display -> set_double_click_distance(5);
ok(defined($display -> supports_cursor_color()));
ok(defined($display -> supports_cursor_alpha()));
like($display -> get_default_cursor_size(), qr/^\d+$/);
my ($width, $height) = $display -> get_maximal_cursor_size();
like($width, qr/^\d+$/);
like($height, qr/^\d+$/);
isa_ok($display -> get_default_group(), "Gtk2::Gdk::Window");
}
SKIP: {
skip("new 2.6 stuff", 1)
unless Gtk2 -> CHECK_VERSION(2, 6, 0);
if ($display -> supports_selection_notification()) {
is($display -> request_selection_notification(Gtk2::Gdk::Atom -> intern("text/plain")), TRUE);
} else {
ok(1);
}
if ($display -> supports_clipboard_persistence()) {
my $window = Gtk2::Window -> new();
$window -> realize();
$display -> store_clipboard($window -> window, 0,
Gtk2::Gdk::Atom -> intern("text/plain"),
Gtk2::Gdk::Atom -> intern("image/png"));
$display -> store_clipboard($window -> window, 0);
}
}
SKIP: {
skip("new 2.8 stuff", 0)
unless Gtk2 -> CHECK_VERSION(2, 8, 0);
$display -> warp_pointer($screen, 100, 100);
}
SKIP: {
skip("new 2.10 stuff", 2)
unless Gtk2->CHECK_VERSION(2, 10, 0);
ok (defined $display->supports_shapes);
ok (defined $display->supports_input_shapes);
}
# FIXME: currently segfaults for me. see #85715.
# $display -> close();
__END__
Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the
full list). See LICENSE for more information.
|
