view release on metacpan or  search on metacpan

lib/Tk/HyperText.pm  view on Meta::CPAN

package Tk::HyperText;

##########################################################
# Look to the end of this file for the POD documentation #
##########################################################

use strict;
use warnings;
use base qw(Tk::Derived Tk::ROText);
use Tk::PNG;
use Tk::JPEG;
use Tk::BrowseEntry;
use Tk::Listbox;
use Tk::Text;
use HTML::TokeParser;
use URI::Escape;
use HTML::Entities::Numbered ();

our $VERSION = '0.13';

my %fontCache = ();

Construct Tk::Widget 'HyperText';

sub Populate
{
	my ($cw,$args) = @_;

	# Strip out the custom arguments for this widget.
	my $opts = {
		-attributes => {
			-anchor => {
				-normal  => '#0000FF',
				-hover   => '#FF0000',
				-active  => '#FF0000',
				-visited => '#990099',
			},
			-font => {
				-family => 'Times',
				-mono   => 'Courier',
				-size   => 'medium',
				-bold   => 0, # Bold
				-italic => 0, # Italic
				-under  => 0, # Underline
				-over   => 0, # Overstrike
			},
			-style => {
				-margins => 0,
				-color   => '#000000', # Text color
				-back    => '#FFFFFF', # Text back
			},
		},
		-continuous => 0,
		-allow      => [],
		-deny       => [],
	};

	# Copy attributes over.
	if (exists $args->{'-attributes'}) {
		my $attr = delete $args->{'-attributes'};
		foreach my $tag (keys %{$attr}) {
			foreach my $name (keys %{$attr->{$tag}}) {
				$opts->{'-attributes'}->{$tag}->{$name} =
					$attr->{$tag}->{$name};
			}
		}
	}

	# Copy other options over.