#!/usr/bin/perl -w
# vim: set ft=perl :
use Gtk2::TestHelper tests => 115,
at_least_version => [2, 2, 0, "GtkClipboard didn't exist in 2.0.x"];
# $Id$
my $clipboard;
SKIP: {
skip "GdkDisplay is new in 2.2", 1
unless Gtk2->CHECK_VERSION (2, 2, 0);
my $display = Gtk2::Gdk::Display->get_default;
$clipboard = Gtk2::Clipboard->get_for_display (
$display,
Gtk2::Gdk->SELECTION_CLIPBOARD);
isa_ok ($clipboard, 'Gtk2::Clipboard');
is ($clipboard->get_display, $display);
}
$clipboard = Gtk2::Clipboard->get (Gtk2::Gdk->SELECTION_PRIMARY);
isa_ok ($clipboard, 'Gtk2::Clipboard');
my $expect = '0123456789abcdef';
$clipboard->set_text ($expect);
my $text = $clipboard->wait_for_text;
is ($text, $expect);
is ($clipboard->wait_is_text_available, 1);
$clipboard->request_text (sub {
# print "hello from the callback\n" . Dumper(\@_);
is ($_[0], $clipboard);
is ($_[1], $expect);
is ($_[2], 'user data!');
}, 'user data!');
$clipboard->request_contents (Gtk2::Gdk->SELECTION_TYPE_STRING, sub {
#print "hello from the callback\n" . Dumper(\@_);
is ($_[0], $clipboard);
isa_ok ($_[1], 'Gtk2::SelectionData');
is ($_[2], 'user data!');
is ($_[1]->get_text, $expect);
}, 'user data!');
SKIP: {
skip 'request_targets and wait_for_targets are new in 2.4', 4
unless Gtk2->CHECK_VERSION (2, 4, 0);
$clipboard->request_targets (sub {
is ($_[0], $clipboard);
isa_ok ($_[1], "ARRAY");
isa_ok ($_[1][0], "Gtk2::Gdk::Atom");
is ($_[2], "bla");
}, "bla");
}
SKIP: {
skip 'new/now-working targets stuff', 2
unless Gtk2->CHECK_VERSION (2, 6, 0);
is ($clipboard->wait_is_target_available (Gtk2::Gdk::Atom->intern ('TEXT')), TRUE);
isa_ok (($clipboard->wait_for_targets)[0], 'Gtk2::Gdk::Atom');
}
SKIP: {
skip "new image stuff", 5
# Some of this was broken in 2.6.0
unless Gtk2->CHECK_VERSION (2, 6, 1);
my $pixbuf = Gtk2::Gdk::Pixbuf->new ("rgb", FALSE, 8, 23, 42);
$clipboard->set_image ($pixbuf);
is ($clipboard->wait_is_image_available, TRUE);
isa_ok ($clipboard->wait_for_image, "Gtk2::Gdk::Pixbuf");
$clipboard->request_image (sub {
is ($_[0], $clipboard);
isa_ok ($_[1], "Gtk2::Gdk::Pixbuf");
is ($_[2], "bla");
}, "bla");
}
SKIP: {
skip "new stuff in 2.10", 7
unless Gtk2->CHECK_VERSION (2, 10, 0);
my $test_text = 'test test test';
my $buffer = Gtk2::TextBuffer->new;
$buffer->insert ($buffer->get_start_iter, 'bla!');
$buffer->register_deserialize_format (
'text/rdf',
sub { warn "here"; $_[1]->insert ($_[2], 'bla!'); });
$clipboard->set_with_data (
sub {
my ($clipboard, $selection_data, $info, $data) = @_;
$selection_data->set (Gtk2::Gdk::Atom->new ('text/rdf'),
8, $data);
},
sub {},
$test_text,
{target=>'text/rdf'});
$clipboard->request_rich_text ($buffer, sub {
# print "hello from the callback\n" . Dumper(\@_);
is ($_[0], $clipboard);
is ($_[1]->name, 'text/rdf');
is ($_[2], $test_text);
is ($_[3], undef);
});
ok ($clipboard->wait_is_rich_text_available ($buffer));
my ($data, $atom) = $clipboard->wait_for_rich_text ($buffer);
is ($data, $test_text);
is ($atom->name, 'text/rdf');
}
SKIP: {
skip 'new uris stuff', 5
unless Gtk2->CHECK_VERSION (2, 14, 0);
my @uris = ('file:///foo/bar', 'file:///bar/foo');
$clipboard->set_with_data (
sub {
my ($clipboard, $selection_data, $info, $data) = @_;
$selection_data->set_uris (@$data);
},
sub {},
\@uris,
{target=>'text/uri-list'});
is ($clipboard->wait_is_uris_available, TRUE);
is_deeply ($clipboard->wait_for_uris, \@uris);
$clipboard->request_uris (sub {
my ($tmp_clipboard, $tmp_uris, $data) = @_;
is ($tmp_clipboard, $clipboard);
is_deeply ($tmp_uris, \@uris);
is ($data, undef);
});
}
run_main;
#print "----------------------------------\n";
$expect = 'whee';
my $get_func_call_count = 0;
sub get_func {
return if ++$get_func_call_count == 3;
my ($cb, $sd, $info, $user_data_or_owner) = @_;
is ($cb, $clipboard);
isa_ok ($sd, 'Gtk2::SelectionData');
is ($info, 0);
ok (defined $user_data_or_owner);
# Tests for Gtk2::SelectionData:
$sd->set (Gtk2::Gdk->TARGET_STRING, 8, 'bla blub');
is ($sd->get_selection ()->name, 'PRIMARY');
ok (defined $sd->get_target ()->name);
is ($sd->get_data_type ()->name, 'STRING');
is ($sd->get_format (), 8);
is ($sd->get_data (), 'bla blub');
is ($sd->get_length (), 8);
# Deprecated but provided for backwards compatibility
ok ($sd->selection () == $sd->get_selection ());
ok ($sd->target () == $sd->get_target ());
ok ($sd->type () == $sd->get_data_type ());
ok ($sd->format () == $sd->get_format ());
ok ($sd->data () eq $sd->get_data ());
ok ($sd->length () == $sd->get_length ());
SKIP: {
skip 'GdkDisplay is new in 2.2', 2
unless Gtk2->CHECK_VERSION (2, 2, 0);
isa_ok ($sd->get_display (), 'Gtk2::Gdk::Display');
# Deprecated but provided for backwards compatibility
ok ($sd->display () == $sd->get_display ());
}
# FIXME: always empty and false?
# warn $sd->get_targets;
# warn $sd->targets_include_text;
$sd->set_text ($expect);
is ($sd->get_text, $expect);
is ($sd->data, $expect);
is ($sd->length, length ($expect));
SKIP: {
skip '2.6 stuff', 7
unless Gtk2->CHECK_VERSION (2, 6, 0);
# This won't work with a STRING selection, but I don't know
# what else to use, so we just check that both operations fail.
my $pixbuf = Gtk2::Gdk::Pixbuf->new ('rgb', FALSE, 8, 23, 42);
is ($sd->set_pixbuf ($pixbuf), FALSE);
is ($sd->get_pixbuf, undef);
# Same here.
is ($sd->set_uris, FALSE);
is_deeply ([$sd->get_uris], []);
is ($sd->set_uris (qw(a b c)), FALSE);
is_deeply ([$sd->get_uris], []);
is ($sd->targets_include_image (TRUE), FALSE);
}
SKIP: {
skip '2.10 stuff', 2
unless Gtk2->CHECK_VERSION (2, 10, 0);
is ($sd->targets_include_uri, FALSE);
my $buffer = Gtk2::TextBuffer->new;
$buffer->register_deserialize_format (
'text/rdf',
sub { warn "here"; $sd->insert ($info, 'bla!'); });
is ($sd->targets_include_rich_text ($buffer), FALSE);
}
}
sub clear_func {
is (shift, $clipboard);
ok (shift);
}
sub received_func {
is ($_[0], $clipboard);
isa_ok ($_[1], 'Gtk2::SelectionData');
is ($_[2], 'user data!');
is ($_[1]->get_text, $expect);
}
# set the selection multiple times to make sure we don't crash on
# replacing all the GPerlCallbacks.
$clipboard->set_with_data (\&get_func, \&clear_func, 'user data, yo',
{target=>'TEXT'}, {target=>'STRING'}, {target=>'COMPOUND_TEXT'},
);
ok(1);
$clipboard->set_with_data (\&get_func, \&clear_func, 'user data, yo',
{target=>'TEXT'}, {target=>'STRING'}, {target=>'COMPOUND_TEXT'},
);
ok(1);
$clipboard->set_with_data (\&get_func, \&clear_func, 'user data, yo',
{target=>'TEXT'}, {target=>'STRING'}, {target=>'COMPOUND_TEXT'},
);
ok(1);
$clipboard->request_contents (Gtk2::Gdk->SELECTION_TYPE_STRING,
\&received_func, 'user data!');
run_main;
my $widget = Gtk2::Window->new;
$clipboard->set_with_owner (\&get_func, \&clear_func, $widget,
{target=>'TEXT'}, {target=>'STRING'}, {target=>'COMPOUND_TEXT'},
);
is ($clipboard->get_owner, $widget);
$clipboard->request_contents (Gtk2::Gdk->SELECTION_TYPE_STRING,
\&received_func, 'user data!');
run_main;
SKIP: {
skip "new 2.6 stuff", 0
unless Gtk2->CHECK_VERSION (2, 6, 0);
$clipboard->set_can_store ({target=>'STRING'}, {target=>'TEXT'});
$clipboard->set_can_store;
$clipboard->store;
}
$clipboard->clear;
__END__
Copyright (C) 2003-2006 by the gtk2-perl team (see the file AUTHORS for the
full list). See LICENSE for more information.