File: init-cb.pl

package info (click to toggle)
libgtk-perl 0.7009-12
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 3,956 kB
  • ctags: 2,260
  • sloc: perl: 13,998; xml: 9,919; ansic: 2,894; makefile: 64; cpp: 45
file content (33 lines) | stat: -rwxr-xr-x 678 bytes parent folder | download | duplicates (4) 
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
 
#!/usr/bin/perl -w

#TITLE: init/quit callbacks
#REQUIRES: Gtk
use strict;
use Gtk;

my $count = 0;
my $oscount = 0;

Gtk->init_add(sub {print STDERR "Init callback: ", @_, "\n"}, 1);

init Gtk;
#Gtk->quit_add(1, sub {print "Quit callback: ", @_, "\n"}, "burp");
Gtk->quit_add(1, \&quit_loop, "burp");
print STDERR "Quitting main loop in 1 sec\n";
Gtk->timeout_add(1000, \&main_quit);
Gtk->idle_add(sub {++$count; return 1});
Gtk->idle_add(sub {++$oscount; return 0});
Gtk->main;

print STDERR "Idle runs: $count\n";
print STDERR "One-shot idle runs: $oscount\n";

Gtk->exit(0);

sub quit_loop {
	print STDERR "Quit callback: ", @_,  "\n";
}

sub main_quit {
	Gtk->main_quit;
}