1 |
=head1 NAME |
2 |
|
3 |
Browser::Plugin - embed perl into a webbrowser using tcl/tk. |
4 |
|
5 |
=head1 SYNOPSIS |
6 |
|
7 |
<embed type="application/x-mperl-tk" /> |
8 |
|
9 |
=head1 DESCRIPTION |
10 |
|
11 |
sorry... |
12 |
|
13 |
=over 4 |
14 |
|
15 |
=cut |
16 |
|
17 |
package Browser::Plugin::Tk; |
18 |
|
19 |
use base Browser::Plugin; |
20 |
|
21 |
use Tk (); |
22 |
|
23 |
$VERSION = 0.01; |
24 |
|
25 |
sub mainloop { |
26 |
my $self = shift; |
27 |
|
28 |
for(;;) { |
29 |
if (Tk::MainWindow->Count) { |
30 |
Tk::MainLoop; |
31 |
} else { |
32 |
$self->server_event; |
33 |
} |
34 |
} |
35 |
} |
36 |
|
37 |
sub new { |
38 |
my $class = shift; |
39 |
my $self = $class->SUPER::new(@_); |
40 |
|
41 |
$self; |
42 |
} |
43 |
|
44 |
sub window_new { |
45 |
my $self = shift; |
46 |
my $wi = $_[0]; |
47 |
$self->SUPER::window_new(@_); |
48 |
print "BP1: @_\n"; |
49 |
|
50 |
return if $self->{win}; |
51 |
|
52 |
# "fix" idea by the famous Slaven Rezic of Pearl. |
53 |
local $SIG{ABRT} = sub { die "ABRT" }; |
54 |
|
55 |
my $w = $self->{win} = eval { |
56 |
new Tk::MainWindow ( |
57 |
-use => $wi->{id}, |
58 |
-borderwidth => 0, |
59 |
-relief =>'sunken', |
60 |
#-width => $wi->{width}, |
61 |
#-height => $wi->{height}, |
62 |
); |
63 |
}; |
64 |
|
65 |
if ($w) { |
66 |
$w->fileevent($self->server_fh, 'readable', [$self, 'server_event']); |
67 |
|
68 |
$w->Label(-text => "Test")->pack; |
69 |
print "mainwindow now is $w\n"; |
70 |
} else { |
71 |
print "no window yet\n"; |
72 |
return (); |
73 |
} |
74 |
|
75 |
return $w; |
76 |
} |
77 |
|
78 |
sub window_delete { |
79 |
my $self = shift; |
80 |
$self->SUPER::window_delete(@_); |
81 |
|
82 |
delete $self->{win}; |
83 |
} |
84 |
|
85 |
sub DESTROY { |
86 |
warn "DESTROY"; |
87 |
} |
88 |
|
89 |
1; |
90 |
|
91 |
=back |
92 |
|
93 |
=head1 BUGS |
94 |
|
95 |
=head1 SEE ALSO |
96 |
|
97 |
L<PApp>. |
98 |
|
99 |
=head1 AUTHOR |
100 |
|
101 |
Marc Lehmann <pcg@goof.com> |
102 |
http://www.goof.com/pcg/marc/ |
103 |
|
104 |
=cut |
105 |
|