package Tk::Browser;
use Tk;
use Tk::Font;
use Tk::Balloon;
use base 'Tk::ROText';
use Cwd qw(abs_path);
use Milkbone;
use strict;
use warnings;
Construct Tk::Widget 'Browser';
my %fonts;
$fonts{$_} = 1 for hook("tk_getmain")->fontFamilies;
sub Populate
{
my ($self, $args) = @_;
$self->SUPER::Populate($args);
}
sub insertHTML
{
my ($self, $pos, $html) = @_;
my @insert;
print $html;
$self->tagConfigure('BSEL', -background => '#c0c0c0');
$self->tagRaise('sel', 'BSEL');
$html =~ s/
/\n/gi;
$html =~ s/)/, $html;
my $data = {};
my $font = {-family => '{adobe arial}', -size => 11};
$self->begin($font);
for(@items)
{
if(!/^/gi;
s/</{tags}}];
}
else
{
my ($tagname) = /^<\/?(\w*)/;
my $func = /^<\// ? lc $tagname . "_end" :
lc $tagname . "_begin";
$_ =~ s/^<\///;
$self->$func($_, $data, $font);
}
}
$self->end;
$self->insert($pos, @insert);
}
sub begin
{
my ($self, $font) = @_;
$self->configure(-font => $self->Font(%{$font})->Pattern);
}
sub end
{
my ($self) = @_;
}
sub b_begin
{
my ($self, $tag, $data, $font) = @_;
$font->{-weight} = 'bold';
$data->{tags}->{''} = 1;
$self->tagConfigure('', -font => $self->Font(%{$font})->Pattern);
$self->tagRaise(sel => '');
}
sub b_end
{
my ($self, $tag, $data, $font) = @_;
$font->{-weight} = 'normal';
delete $data->{tags}->{''};
}
sub i_begin
{
my ($self, $tag, $data, $font) = @_;
$font->{-slant} = 'italic';
$data->{tags}->{''} = 1;
$self->tagConfigure('', -font => $self->Font(%{$font})->Pattern);
$self->tagRaise(sel => '');
}
sub i_end
{
my ($self, $tag, $data, $font) = @_;
$font->{-slant} = 'roman';
delete $data->{tags}->{''};
}
sub u_begin
{
my ($self, $tag, $data, $font) = @_;
$data->{tags}->{''} = 1;
$self->tagConfigure('', -underline => 1, -font => $self->Font(%{$font})->Pattern);
$self->tagRaise(sel => '');
}
sub u_end
{
my ($self, $tag, $data, $font) = @_;
delete $data->{tags}->{''};
}
sub balloon_handle {
my ($self) = @_;
my ($x, $y) = (
$self->pointerx - $self->rootx,
$self->pointery - $self->rooty);
my $index = $self->index("\@$x,$y");
my @tags = $self->tagNames($index);
for(@tags) {
print;
next unless /^{msg} = $1;
return "$x, $y";
}
return 0;
}
sub a_begin
{
# this assumes that no one will nest anchor tags
#( a silly thing to do anyway )
my ($self, $tag, $data, $font) = @_;
unless(defined($self->{balloon}))
{
$self->{msg} = "test";
$self->{balloon} = $self->parent->Balloon;
$self->{balloon}->attach($self,
-msg => \$self->{msg},
-balloonposition => 'mouse',
-postcommand => [\&balloon_handle,$self],
#-motioncommand => sub { print "erer"; 1; }
);
}
my ($href) = ($tag =~ m/href=\"(.*?)\"/i);
$data->{tags}->{$tag} = 1;
$self->tagConfigure($tag, -foreground => "blue", -underline => 1, -font => $self->Font(%{$font})->Pattern);
$self->tagRaise(sel => $tag);
$self->tagBind($tag, '', [sub {
my $cmd;
$cmd = defined(option("Browser")) ? option("Browser") : "\"c:\\program files\\internet explorer\\iexplore.exe\"" if $^O =~ m/Win32/;
$cmd = defined(option("Browser")) ? option("Browser") : "opera" if $^O !~ m/Win32/;
if($^O !~ m/Win32/)
{
exec("$cmd $_[1]") unless fork;
}
else
{
eval 'use Win32::Process; use Win32; ' .
'my ($obj, $cmd);' .
'$cmd = ' . "'" . 'C:\Progra~1\Intern~1\iexplore.exe' . "';" .
'Win32::Process::Create($obj, "$cmd", "$cmd $_[1]", 0, 32, abs_path) or '.
'die "eerr" . Win32::FormatMessage( Win32::GetLastError() );';
warn "$@ $!" if $@;
}
}, $href]);
$self->tagBind($tag, '', [sub {
shift->configure(-cursor => 'hand2');
}, $self]);
$self->tagBind($tag, '', [sub {
shift->configure(-cursor => 'xterm');
}, $self]);
push @{$data->{atags}}, $tag;
}
sub a_end
{
my ($self, $tag, $data, $font) = @_;
$font->{-underline} = 0;
delete $data->{tags}->{pop @{$data->{atags}}};
}
sub font_begin
{
my ($self, $tag, $data, $font) = @_;
my ($family) = ($tag =~ m/face=\"(.*?)\"/i);
my ($color) = ($tag =~ m/color=\"(.*?)\"/i);
my ($size) = ($tag =~ m/size=\"?([^> ]*)\"?/i);
my ($back) = ($tag =~ m/back=\"(.*?)\"/i);
$size ||= 2;
my $realsize;
# Begin klugey OS hacks
$realsize = int((8, 10, 12, 14, 18, 24, 38) [int($size) + 1]) + 2 if $size and $^O =~ /Win32/;
$realsize = int((8, 10, 12, 14, 18, 24, 38) [int($size) + 1]) if $size and $^O !~ /Win32/;
$font->{-size} = $realsize if $size;
if($family) {
if(exists $fonts{$family}) {
$font->{-family} = $family;
}
else {
$font->{-family} = "{adobe arial}";
}
}
$back = "" if defined($back) and $back eq "white" or
$back =~ /ffffff/i;
my %opts;
$opts{-foreground} = $color if $color;
$opts{-background} = $back if $back;
$data->{tags}->{$tag} = 1;
$self->tagConfigure($tag, %opts, -font => $self->Font(%{$font})->Pattern);
$self->tagRaise(sel => $tag);
push @{$data->{fonttags}}, $tag;
}
sub font_end
{
my ($self, $tag, $data, $font) = @_;
delete $data->{tags}->{pop @{$data->{fonttags}}};
}
sub body_end
{
my ($self, $tag, $data, $font) = @_;
}
sub AUTOLOAD
{
}
1;