package Tk::Browser;
use Tk;
use Tk::Font;
use base 'Tk::ROText';
use strict;
use warnings;
Construct Tk::Widget 'Browser';
sub insertHTML
{
my ($self, $pos, $html) = @_;
my @insert;
$self->configure(-selectforeground => 'white', -selectbackground => 'black');
$html =~ s/
/\n/gi;
$html =~ s/)/, $html;
my $data = {};
my $font = {-family => 'times'};
$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);
}
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);
}
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);
}
sub u_end
{
my ($self, $tag, $data, $font) = @_;
delete $data->{tags}->{''};
}
sub a_begin
{
# this assumes that no one will nest anchor tags ( a silly thing to do anyway )
my ($self, $tag, $data, $font) = @_;
my ($href) = ($tag =~ m/href=\"(.*?)\"/i);
$data->{tags}->{$tag} = 1;
$self->tagConfigure($tag, -foreground => "blue", -underline => 1, -font => $self->Font(%{$font})->Pattern);
$self->tagBind($tag, '', [sub {
my $cmd;
$cmd = option("Browser") or "\"c:\\program files\\internet explorer\\iexplore.exe\"" if $^O =~ m/Win32/;
$cmd = option("Browser") or "opera" if $^O !~ m/Win32/;
if($^O !~ m/Win32/)
{
exec("$cmd $_[1]") unless fork;
}
else
{
system("$cmd $_[1]");
}
}, $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->{-family} = $family if $family;
$font->{-size} = $realsize if $size;
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);
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;