@ -15,11 +15,20 @@ Construct Tk::Widget 'Browser';
my % fonts ;
my % fonts ;
$ fonts { $ _ } = 1 for hook ( "tk_getmain" ) - > fontFamilies ;
$ fonts { $ _ } = 1 for hook ( "tk_getmain" ) - > fontFamilies ;
sub Populate
{
my ( $ self , $ args ) = @ _ ;
$ self - > SUPER:: Populate ( $ args ) ;
}
sub insertHTML
sub insertHTML
{
{
my ( $ self , $ pos , $ html ) = @ _ ;
my ( $ self , $ pos , $ html ) = @ _ ;
my @ insert ;
my @ insert ;
$ self - > tagConfigure ( 'BSEL' , - background = > '#c0c0c0' ) ;
$ self - > tagRaise ( 'sel' , 'BSEL' ) ;
$ html =~ s/<br>/\n/gi ;
$ html =~ s/<br>/\n/gi ;
$ html =~ s/<body bgcolor=/<font back=/gi ;
$ html =~ s/<body bgcolor=/<font back=/gi ;
@ -72,6 +81,7 @@ sub b_begin
$ font - > { - weight } = 'bold' ;
$ font - > { - weight } = 'bold' ;
$ data - > { tags } - > { '<b>' } = 1 ;
$ data - > { tags } - > { '<b>' } = 1 ;
$ self - > tagConfigure ( '<b>' , - font = > $ self - > Font ( % { $ font } ) - > Pattern ) ;
$ self - > tagConfigure ( '<b>' , - font = > $ self - > Font ( % { $ font } ) - > Pattern ) ;
$ self - > tagRaise ( sel = > '<b>' ) ;
}
}
sub b_end
sub b_end
@ -88,6 +98,7 @@ sub i_begin
$ font - > { - slant } = 'italic' ;
$ font - > { - slant } = 'italic' ;
$ data - > { tags } - > { '<i>' } = 1 ;
$ data - > { tags } - > { '<i>' } = 1 ;
$ self - > tagConfigure ( '<i>' , - font = > $ self - > Font ( % { $ font } ) - > Pattern ) ;
$ self - > tagConfigure ( '<i>' , - font = > $ self - > Font ( % { $ font } ) - > Pattern ) ;
$ self - > tagRaise ( sel = > '<i>' ) ;
}
}
sub i_end
sub i_end
@ -104,6 +115,7 @@ sub u_begin
$ data - > { tags } - > { '<u>' } = 1 ;
$ data - > { tags } - > { '<u>' } = 1 ;
$ self - > tagConfigure ( '<u>' , - underline = > 1 , - font = > $ self - > Font ( % { $ font } ) - > Pattern ) ;
$ self - > tagConfigure ( '<u>' , - underline = > 1 , - font = > $ self - > Font ( % { $ font } ) - > Pattern ) ;
$ self - > tagRaise ( sel = > '<u>' ) ;
}
}
sub u_end
sub u_end
@ -123,6 +135,7 @@ sub a_begin
$ data - > { tags } - > { $ tag } = 1 ;
$ data - > { tags } - > { $ tag } = 1 ;
$ self - > tagConfigure ( $ tag , - foreground = > "blue" , - underline = > 1 , - font = > $ self - > Font ( % { $ font } ) - > Pattern ) ;
$ self - > tagConfigure ( $ tag , - foreground = > "blue" , - underline = > 1 , - font = > $ self - > Font ( % { $ font } ) - > Pattern ) ;
$ self - > tagRaise ( sel = > $ tag ) ;
$ self - > tagBind ( $ tag , '<ButtonPress-1>' , [ sub {
$ self - > tagBind ( $ tag , '<ButtonPress-1>' , [ sub {
my $ cmd ;
my $ cmd ;
@ -202,6 +215,7 @@ sub font_begin
$ data - > { tags } - > { $ tag } = 1 ;
$ data - > { tags } - > { $ tag } = 1 ;
$ self - > tagConfigure ( $ tag , % opts , - font = > $ self - > Font ( % { $ font } ) - > Pattern ) ;
$ self - > tagConfigure ( $ tag , % opts , - font = > $ self - > Font ( % { $ font } ) - > Pattern ) ;
$ self - > tagRaise ( sel = > $ tag ) ;
push @ { $ data - > { fonttags } } , $ tag ;
push @ { $ data - > { fonttags } } , $ tag ;
}
}