package Tk::Browser;
use Tk;
use Tk::Font;
use base 'Tk::ROText';
use Cwd qw(abs_path);
use strict;
use warnings;
Construct Tk::Widget 'Browser';
sub insertHTML
{
my ($self, $pos, $html) = @_;
my @insert;
$self->configure(-selectforeground => 'white', -selectbackground => 'black', -background => 'white');
$html =~ s/<br>/\n/gi;
$html =~ s/<body bgcolor=/<font back=/gi;
my (@items) = grep { $_ ne "" } split /(<.*?>)/, $html;
my $data = {};
my $font = {-family => 'times'};
$self->begin($font);
for(@items)
{
if(!/^</)
{
s/&/&/gi;
s/>/>/gi;
s/</</gi;
s/"/\"/gi;
push @insert, $_, [keys %{$data->{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}->{'<b>'} = 1;
$self->tagConfigure('<b>', -font => $self->Font(%{$font})->Pattern);
}
sub b_end
{
my ($self, $tag, $data, $font) = @_;
$font->{-weight} = 'normal';
delete $data->{tags}->{'<b>'};
}
sub i_begin
{
my ($self, $tag, $data, $font) = @_;
$font->{-slant} = 'italic';
$data->{tags}->{'<i>'} = 1;
$self->tagConfigure('<i>', -font => $self->Font(%{$font})->Pattern);
}
sub i_end
{
my ($self, $tag, $data, $font) = @_;
$font->{-slant} = 'roman';
delete $data->{tags}->{'<i>'};
}
sub u_begin
{
my ($self, $tag, $data, $font) = @_;
$data->{tags}->{'<u>'} = 1;
$self->tagConfigure('<u>', -underline => 1, -font => $self->Font(%{$font})->Pattern);
}
sub u_end
{
my ($self, $tag, $data, $font) = @_;
delete $data->{tags}->{'<u>'};
}
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, '<ButtonPress-1>', [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, '<Enter>', [sub {
shift->configure(-cursor => 'hand2');
}, $self]);
$self->tagBind($tag, '<Leave>', [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;