File Coverage

blib/lib/Tk/HyperText.pm

Criterion	Covered	Total	%
statement	9	9	100.0
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	12	12	100.0

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 Data::Dumper;
use URI::Escape;

our $VERSION = 0.09;

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.
	$opts->{'-continuous'} = delete $args->{'-continuous'} || delete $args->{'-continue'};
	$opts->{'-allow'} = delete $args->{'-allow'} || [];
	$opts->{'-deny'} = delete $args->{'-deny'} || [];

	# Pass the remaining arguments to ROText.
	$args->{'-foreground'} = $opts->{'-attributes'}->{'-style'}->{'-color'};
	$args->{'-background'} = $opts->{'-attributes'}->{'-style'}->{'-back'};
	$cw->SUPER::Populate($args);

	# Reconfigure the ROText widget with our attributes.
	$cw->SUPER::configure (
		-highlightthickness => 0,
		-exportselection    => 1,
		-insertofftime      => 1000,
		-insertontime       => 0,
		-cursor             => undef,
		-font => [
			-family => $opts->{'-attributes'}->{'-font'}->{'-family'},
			-size   => $cw->_size ($opts->{'-attributes'}->{'-font'}->{'-size'}),
		],
	);

	$cw->{hypertext} = {
		html        => '', # Holds the HTML code
		continue    => $opts->{'-continuous'},
		attrib      => $opts->{'-attributes'},
		history     => {},
		events      => {},
		permissions => 'allow_all',
		allow       => {},
		deny        => {},
	};

	if (scalar @{$opts->{'-allow'}}) {
		$cw->allowedTags (@{$opts->{'-allow'}});
	}
	if (scalar @{$opts->{'-deny'}}) {
		$cw->deniedTags (@{$opts->{'-deny'}});
	}
}

sub setHandler {
	my ($cw,%handlers) = @_;

	foreach my $event (keys %handlers) {
		my $code = $handlers{$event};
		$cw->{hypertext}->{events}->{$event} = $code;
	}
}

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

	if (exists $cw->{hypertext}->{events}->{$event}) {
		return &{$cw->{hypertext}->{events}->{$event}} ($cw,@args);
	}

	return undef;
}

sub loadString {
	my $cw = shift;
	my $text = shift;

	# Clear the widget.
	$cw->loadBlank();

	# Set the HTML buffer = our string.
	$cw->{hypertext}->{html} = $text;
	$cw->{hypertext}->{plain} = $text;
	$cw->{hypertext}->{plain} =~ s/<(.|\n)+?>//sig;

	# Render the text.
	$cw->render ($text);
}

sub loadBlank {
	my $cw = shift;
	$cw->{hypertext}->{html} = '';
	$cw->{hypertext}->{plain} = '';
	$cw->delete ("0.0","end");
}

sub allowedTags {
	my ($cw,@tags) = @_;
	$cw->{hypertext}->{allow} = {};
	foreach (@tags) {
		$_ = lc($_);
		$cw->{hypertext}->{allow}->{$_} = 1;
	}
}

sub deniedTags {
	my ($cw,@tags) = @_;
	$cw->{hypertext}->{deny} = {};
	foreach (@tags) {
		$_ = lc($_);
		$cw->{hypertext}->{deny}->{$_} = 1;
	}
}

sub allowHypertext {
	my $cw = shift;

	# Allow AIM-style HTML tags.
	my @allow = qw(html head title body a p br hr
		img font center sup sub b i u s);
	$cw->{hypertext}->{allow} = {};
	$cw->{hypertext}->{deny} = {};

	foreach (@allow) {
		$cw->{hypertext}->{allow}->{$_} = 1;
	}
}

sub allowEverything {
	my $cw = shift;

	# Allow everything again.
	$cw->{hypertext}->{allow} = {};
	$cw->{hypertext}->{deny} = {};
}

sub getText {
	my $cw = shift;
	my $asHTML = shift || 0;

	if ($asHTML) {
		return $cw->{hypertext}->{html};
	}
	return $cw->{hypertext}->{plain};
}

sub clearHistory {
	my $cw = shift;
	$cw->{hypertext}->{history} = {};
}

sub render {
	my ($cw,$html) = @_;

	# Initialize the style stack.
	my $mAttr = $cw->{hypertext}->{attrib};
	my %style = (
		weight     => 'normal', # or 'bold'
		slant      => 'roman',  # or 'italic'
		underline  => 0,        # or 1
		overstrike => 0,        # or 1
		family     => $mAttr->{'-font'}->{'-family'},
		size       => $mAttr->{'-font'}->{'-size'},
		foreground => '',
		background => '',
		justify    => 'left',   # or 'center' or 'right'
		offset     => 0,        # for  and
		lmargin1   => 0,        # for
		lmargin2   => 0,        # and
		rmargin    => 0,        # and
		pre        => 0,        # inside  tags
		linking    => 0,        # inside ... tags
		linktag    => '',       # Current linktag
		inul       => 0,        # Inside
		inol       => 0,        # Inside
		ullevel    => 0,
		ollevel    => 0,
		intable    => 0,
		intd       => 0,
	);
	my @escape = (
		'<'   => '<',
		'>'   => '>',
		'"' => '"',
		''' => "'",
		' ' => ' ',
		'®'  => chr(0x00ae),
		'©' => chr(0x00a9),
		'♥' => chr(0x2665),
		'♦'  => chr(0x2666),
		'♠' => chr(0x2660),
		'♣'  => chr(0x2663),
		'&'  => '&',
	);
	my @stackList = ();
	my $ulLevel = 0;
	my $olLevel = 0;
	my @stackOLLevel = ();
	my @stackULLevel = ();
	my $ulStyles = {};
	my $olStyles = {};
	my %hyperlink = (); # Hyperlink tags
	my $tabledata = {}; # Table data
	my $tableid = 0;    # Table ID
	my $formdata = {};  # Form data
	my $formname = '';  # Current form name
	my $curSelect = {      # Selectbox data
		in   => 0,     # Not in a  tag
		opts => [],    # Options
		name => '',    # Name
		size => 1,     # Size
		multiple => 0, # Multiple
		state    => 'readonly',
	};
	my (@stack) = $cw->_addStack (\%style);

	# Initialize the Text widget that gets our attention.
	my $browser = $cw;

	# Initialize the parser.
	my $parser = HTML::TokeParser->new (\$html);
	$parser->xml_mode(1);
	$parser->strict_names(1);
	$parser->marked_sections(1);
	my $foundOneBody = 0;
	my $end = 0;
	my $lineWritten = 0; # 1 = a line of text was written
	while (my $token = $parser->get_token) {
		my @data = @{$token};

		if ($data[0] eq "T") { # Plain Text
			my $text = $data[1];
			$text =~ s/([A-Za-z0-9]+)(\n+)([A-Za-z0-9]+)/$1 $3/ig;

			# Process escape sequences.
			while ($text =~ /&#x([^;]+?)\;/i) {
				my $hex = $1;
				my $qm  = quotemeta("&#x$hex");
				my $chr = hex $hex;
				my $char = chr($chr);
				$text =~ s/$qm/$char/ig;
			}
			while ($text =~ /&#([^;]+?)\;/i) {
				my $decimal = $1;
				my $hex = sprintf("%x", $decimal);
				my $qm  = quotemeta("&#$decimal;");
				my $chr = hex $hex;
				my $char = chr($chr);
				$text =~ s/$qm/$char/ig;
			}
			for (my $i = 0; $i < scalar(@escape) - 1; $i += 2) {
				my $qm = quotemeta($escape[$i]);
				my $rep = $escape[$i + 1];
				$text =~ s/$qm/$rep/ig;
			}

			# Unless in , remove newlines.
			unless ($style{pre}) {
				$text =~ s/[\x0d\x0a]//g;

				# If there's no text, skip this.
				if ($text =~ /^[\s\t]+$/) {
					next;
				}
				$text =~ s/^[\s\t]+/ /g;
				$text =~ s/[\s\t]+$/ /g;
			}

			# Generate a tag.
			my $tag = '';
			$tag = $cw->_makeTag(\%style,$browser);

			# Is this a hyperlink?
			if ($style{linking}) {
				# Bind this tag to an event.
				my $href = $hyperlink{$style{linktag}}->{href};
				my $target = $hyperlink{$style{linktag}}->{target};

				# Style up the initial color and underline.
				if (exists $cw->{hypertext}->{history}->{$href}) {
					$style{foreground} = $mAttr->{'-anchor'}->{'-visited'};
				}
				else {
					$style{foreground} = $mAttr->{'-anchor'}->{'-normal'};
				}
				$style{underline} = 1;
				push (@stack, $cw->_addStack(\%style));
				$tag = $cw->_makeTag(\%style,$browser);

				my $codeClick = sub {
					my ($parent,$tag,$href,$target) = @_;

					# Add this link to the history.
					$parent->{hypertext}->{history}->{$href} = 1;

					# Recolor this link.
					$parent->SUPER::tagConfigure ($tag,
						-foreground => $mAttr->{'-anchor'}->{'-active'},
					);

					# Call the link command.
					$cw->_event ('Resource',
						tag    => 'a',
						src    => $href,
						href   => $href,
						target => $target,
					);
				};
				my $codeHover = sub {
					my ($parent,$tag) = @_;
					$parent->SUPER::configure (
						-cursor => 'hand2',
					);
					$parent->SUPER::tagConfigure ($tag,
						-foreground => $mAttr->{'-anchor'}->{'-active'},
					);
				};
				my $codeOut = sub {
					my ($parent,$tag,$href) = @_;
					$parent->SUPER::configure (
						-cursor => undef,
					);

					if (exists $parent->{hypertext}->{history}->{$href}) {
						$parent->SUPER::tagConfigure ($tag,
							-foreground => $mAttr->{'-anchor'}->{'-visited'},
						);
					}
					else {
						$parent->SUPER::tagConfigure ($tag,
							-foreground => $mAttr->{'-anchor'}->{'-normal'},
						);
					}
				};

				# Bind the clicking of the link.
				$browser->tagBind ($tag,"", [ $codeClick,
				$tag, $href, $target ]);

				# Set up the hand cursor.
				$browser->tagBind ($tag,"", [ $codeHover,
				$tag ]);
				$browser->tagBind ($tag,"", [ $codeOut,
				$tag, $href ]);
			}

			# Insert the plain text.
			if (length $text > 0) {
				$browser->insert ('end', $text, $tag);
				$lineWritten = 1;
			}

			if ($style{linking}) {
				# Rollback the link styles.
				%style = $cw->_rollbackStack(\@stack,
					qw(foreground underline));
			}
		}
		elsif ($data[0] eq "S") { # Start Tag
			# Skip blocked tags.
			next if $cw->_blockedTag ($data[1]);

			my $tag = lc($data[1]);
			my $format = $cw->_makeTag(\%style);
			if ($tag =~ /^(html|head)$/) { # HTML, HEAD
				# That was nice of them.
			}
			elsif ($tag eq "title") { # Title
				my $title = $parser->get_text("title", "/title");
				$cw->_event ('Title',$title);
			}
			elsif ($tag eq "body") { # Body
				my $at = $data[2];

				my ($bg,$fg,$link,$alink,$vlink);
				if (exists $at->{bgcolor}) {
					$bg = $at->{bgcolor} || "#FFFFFF";
				}
				if (exists $at->{text}) {
					$fg = $at->{text} || "#000000";
				}
				if (exists $at->{link}) {
					$link = $at->{link};
					$mAttr->{'-anchor'}->{'-normal'} = $link || "#0000FF";
				}
				if (exists $at->{vlink}) {
					$vlink = $at->{vlink};
					$mAttr->{'-anchor'}->{'-visited'} = $vlink || "#990099";
				}
				if (exists $at->{alink}) {
					$alink = $at->{alink};
					$mAttr->{'-anchor'}->{'-active'} = $alink || "#FF0000";
				}

				if ($foundOneBody == 0) {
					# This is the first  tag found;
					# apply its colors globally.
					$bg = $mAttr->{'-style'}->{'-back'}
						unless length $bg;
					$fg = $mAttr->{'-style'}->{'-color'}
						unless length $fg;
					$browser->configure (
						-background => $bg,
						-foreground => $fg,
					);

					$mAttr->{'-style'}->{'-back'} = $bg;
					$mAttr->{'-style'}->{'-color'} = $fg;
					$foundOneBody = 1;
				}
				else {
					# The bg/fg colors only apply from here
					# on out.
					$style{background} = $bg;
					$style{foreground} = $fg;
					push (@stack, $cw->_addStack(\%style));
				}
			}
			elsif ($tag eq "a") { # Hyperlink
				my $at = $data[2];
				my $href = $at->{href} || '';
				my $target = $at->{target} || '';

				# Create a unique link tag for Tk::Text.
				my $linktag = join("-",$href,$target);
				$linktag .= '_' while exists $hyperlink{$linktag};
				$hyperlink{$linktag} = {
					href => $href, target => $target,
				};

				$style{linking} = 1;
				$style{linktag} = $linktag;
			}
			elsif ($tag eq "br") { # Line break
				$browser->SUPER::insert ('end', "\n", $format);
				$lineWritten = 0;
			}
			elsif ($tag eq 'p') { # Paragraph
				$browser->insert ('end', "\n\n", $format);
				$lineWritten = 0;
			}
			elsif ($tag eq 'form') { # Form
				my $at = $data[2];
				my $name = defined $at->{name} ? $at->{name} : 'untitledform';
				my $action = defined $at->{action} ? $at->{action} : '';
				my $method = defined $at->{method} ? $at->{method} : '';
				my $enc    = defined $at->{enctype} ? $at->{enctype} : '';

				# Start collecting the form data.
				$formdata->{$name}->{form} = {
					name => $name, action => $action, method => $method, enctype => $enc,
				};
				$formname = $name;
			}
			elsif ($tag eq 'textarea') { # Textarea
				my $at = $data[2];
				my $name = defined $at->{name} ? $at->{name} : 'x_not_a_form_field';
				my $cols = defined $at->{cols} ? $at->{cols} : 20;
				my $rows = defined $at->{rows} ? $at->{rows} : 4;
				my $state = defined $at->{disabled} ? 'disabled' : 'normal';
				my $wrap = 'word';
				if (defined $at->{wrap}) {
					if ($at->{wrap} eq 'off') {
						$wrap = 'none';
					}
				}

				my $value = $parser->get_text("textarea", "/textarea");

				$formdata->{$formname}->{fields}->{$name} = $value;
				$formdata->{$formname}->{defaults}->{$name} = $value;

				my $widget = $browser->Text (
					#-scrollbars => 'ose',
					-wrap       => $wrap,
					-width      => $cols,
					-height     => $rows,
					-font       => [
						-family => 'Courier',
						-size   => 12,
					],
					-foreground => '#000000',
					-background => '#FFFFFF',
					-highlightthickness => 0,
					-border             => 1,
				);
				$widget->insert('end',$value);
				$browser->windowCreate('end',
					-window => $widget,
					-align  => 'baseline',
				);
			}
			elsif ($tag eq 'select') { # Selectbox
				my $at = $data[2];
				my $name = defined $at->{name} ? $at->{name} : 'x_not_a_form_field';
				my $size = defined $at->{size} ? $at->{size} : 1;
				my $mult = defined $at->{multiple} ? 1 : 0;
				my $state = defined $at->{disabled} ? 'disabled' : 'readonly';
				$curSelect->{in}   = 1;
				$curSelect->{opts} = [];
				$curSelect->{name} = $name;
				$curSelect->{size} = $size;
				$curSelect->{multiple} = $mult;
				$curSelect->{state} = $state;
			}
			elsif ($tag eq 'option') { # Option
				my $at = $data[2];
				my $name  = $curSelect->{name};
				my $value = defined $at->{value} ? $at->{value} : '';
				my $label = $parser->get_text("option","/option");

				# Selected?
				if (exists $at->{selected} || !exists $formdata->{$formname}->{fields}->{$name}) {
					$formdata->{$formname}->{fields}->{$name} = $label;
					$formdata->{$formname}->{defaults}->{$name} = $value;
				}

				if ($curSelect->{in}) {
					push (@{$curSelect->{opts}}, [ $value, $label ]);
				}
			}
			elsif ($tag eq 'input') { # Input
				my $at = $data[2];
				my $name = defined $at->{name} ? $at->{name} : 'x_not_a_form_field';

				my $type = defined $at->{type} ? $at->{type} : 'text';
				my $size = defined $at->{size} ? $at->{size} : 15;
				my $value = defined $at->{value} ? $at->{value} : '';
				my $max   = defined $at->{maxlength} ? $at->{maxlength} : 0;
				my $state = defined $at->{disabled} ? 'disabled' : 'normal';
				my $checked = defined $at->{checked} ? 'checked' : 'cleared';

				$type = lc($type);
				$type = 'text' unless $type =~ /^(text|password|button|checkbox|radio|submit|reset)$/i;

				# Initialize the form variable.
				$formdata->{$formname}->{fields}->{$name} = $value unless exists $formdata->{$formname}->{fields}->{$name};
				$formdata->{$formname}->{defaults}->{$name} = $value unless exists $formdata->{$formname}->{defaults}->{$name};

				# Insert the widgets.
				if ($type eq 'text') {
					my $widget = $browser->Entry (
						-textvariable => \$formdata->{$formname}->{fields}->{$name},
						-width        => $size,
						-state        => $state,
						-background   => '#FFFFFF',
						-foreground   => '#000000',
						-font         => [
							-family => 'Helvetica',
							-size   => 10,
						],
						-highlightthickness => 0,
						-border             => 1,
					);
					$browser->windowCreate ('end',
						-window => $widget,
						-align  => 'baseline',
					);
				}
				if ($type eq 'password') {
					my $widget = $browser->Entry (
						-textvariable => \$formdata->{$formname}->{fields}->{$name},
						-show         => '*',
						-state        => $state,
						-width        => $size,
						-background   => '#FFFFFF',
						-foreground   => '#000000',
						-font         => [
							-family => 'Helvetica',
							-size   => 10,
						],
						-highlightthickness => 0,
						-border             => 1,
					);
					$browser->windowCreate ('end',
						-window => $widget,
						-align  => 'baseline',
					);
				}
				elsif ($type eq 'checkbox') {
					if ($checked eq 'cleared') {
						$formdata->{$formname}->{fields}->{$name} = '';
					}

					my $widget = $browser->Checkbutton (
						-variable => \$formdata->{$formname}->{fields}->{$name},
						-state    => $state,
						-onvalue  => $formdata->{$formname}->{defaults}->{$name},
						-offvalue => '',
						-text     => '',
						-background         => $style{background} || $mAttr->{'-style'}->{'-back'},
						-activebackground   => $style{background} || $mAttr->{'-style'}->{'-back'},
						-highlightthickness => 0,
					);
					$browser->windowCreate ('end',
						-window => $widget,
						-align  => 'baseline',
					);
				}
				elsif ($type eq 'radio') {
					if ($checked eq 'checked') {
						$formdata->{$formname}->{fields}->{$name} = $value;
					}

					my $widget = $browser->Radiobutton (
						-variable => \$formdata->{$formname}->{fields}->{$name},
						-state    => $state,
						-value    => $value,
						-text     => '',
						-background         => $style{background} || $mAttr->{'-style'}->{'-back'},
						-activebackground   => $style{background} || $mAttr->{'-style'}->{'-back'},
						-highlightthickness => 0,
					);
					$browser->windowCreate ('end',
						-window => $widget,
						-align  => 'baseline',
					);
				}
				elsif ($type =~ /^(button|submit|reset)$/i) {
					my $widget = $browser->Button (
						-text               => $value,
						-state              => $state,
						-cursor             => '',
						-highlightthickness => 0,
						-border             => 1,
						-font               => [
							-family => 'Helvetica',
							-size   => 10,
						],
					);
					$browser->windowCreate ('end',
						-window => $widget,
						-align  => 'baseline',
					);

					# Submit buttons submit the form.
					if ($type eq 'submit') {
						$widget->configure (-command => sub {
							# Collect all the fields.
							my $fields = ();
							foreach my $f (keys %{$formdata->{$formname}->{fields}}) {
								next if $f eq 'x_not_a_form_field';
								$fields->{$f} = $formdata->{$formname}->{fields}->{$f};
							}

							# If there are any listboxes, get them too.
							if (exists $formdata->{$formname}->{listwidget}) {
								foreach my $w (keys %{$formdata->{$formname}->{listwidget}}) {
									my @in = $formdata->{$formname}->{listwidget}->{$w}->curselection();
									if (scalar(@in) > 1) {
										my $values = [];
										foreach my $i (@in) {
											my $v = $formdata->{$formname}->{listwidget}->{$w}->get ($i);
											push (@{$values}, $v);
										}
										$fields->{$w} = $values;
									}
									elsif (scalar(@in) == 1) {
										$fields->{$w} = $formdata->{$formname}->{listwidget}->{$w}->get ($in[0]);
									}
									else {
										$fields->{$w} = undef;
									}
								}
							}

							# Submit the form.
							$cw->_event ('Submit',
								form    => $formdata->{$formname}->{form}->{name},
								action  => $formdata->{$formname}->{form}->{action},
								method  => $formdata->{$formname}->{form}->{method},
								enctype => $formdata->{$formname}->{form}->{enctype},
								fields  => $fields,
							);
						});
					}

					# Reset buttons reset the form.
					if ($type eq 'reset') {
						$widget->configure (-command => sub {
							# Reset all the fields.
							foreach my $f (keys %{$formdata->{$formname}->{defaults}}) {
								$formdata->{$formname}->{fields}->{$f} = $formdata->{$formname}->{defaults}->{$f};
							}
						});
					}
				}
			}
			elsif ($tag eq 'table') { # Table
				$browser->insert ('end', "\n") if $lineWritten;
				my $at = $data[2];
				my $border = $at->{border} || 0;
				my $cellspacing = $at->{cellspacing} || 0;
				my $cellpadding = $at->{cellpadding} || 0;
				$tableid++;
				$tabledata->{$tableid}->{widget} =
					$cw->Frame (
						-takefocus          => 0,
						-highlightthickness => 0,
						-relief             => 'raised',
						-borderwidth        => $cw->_isNumber ($border,0),
						-background         => $style{background} || $mAttr->{'-style'}->{'-back'},
					);
				$tabledata->{$tableid}->{row} = -1;
				$tabledata->{$tableid}->{col} = -1;
				$tabledata->{$tableid}->{border} = $cw->_isNumber ($border,0);
				$tabledata->{$tableid}->{cellspacing} = $cw->_isNumber ($cellspacing,0);
				$tabledata->{$tableid}->{cellpadding} = $cw->_isNumber ($cellpadding,0);
				$browser->windowCreate ('end',
					-window => $tabledata->{$tableid}->{widget},
					-align  => 'baseline',
				);
				$style{intable} = 1;
				push (@stack, $cw->_addStack(\%style));
			}
			elsif ($tag eq "tr") { # Table Row
				if ($style{intable}) {
					$tabledata->{$tableid}->{col} = -1;
					$tabledata->{$tableid}->{row}++;
				}
			}
			elsif ($tag =~ /^(td|th|thead|tbody|tfoot)$/) { # Table Data
				if ($style{intable}) {
					my $at = $data[2];
					my $colspan = undef;
					my $rowspan = undef;
					if (defined $at->{colspan}) {
						$colspan = $at->{colspan};
					} if (defined $at->{rowspan}) {
						$rowspan = $at->{rowspan};
					}
					$style{intd} = 1;
					$tabledata->{$tableid}->{col}++;
					$browser = $tabledata->{$tableid}->{widget}->ROText (
						-exportselection => 1,
						-takefocus       => 0,
						-highlightthickness => 0,
						-relief          => 'sunken',
						-wrap            => 'word',
						-borderwidth     => $tabledata->{$tableid}->{border},
						-insertofftime   => 1000,
						-insertontime    => 0,
						-width           => 0,
						-height          => 2,
						-padx            => $tabledata->{$tableid}->{cellpadding},
						-pady            => $tabledata->{$tableid}->{cellpadding},
						-foreground      => $style{foreground} || $mAttr->{'-style'}->{'-color'},
						-background      => $style{background} || $mAttr->{'-style'}->{'-back'},
						-cursor          => undef,
						-font       => [
							-family => $style{family},
							-weight => $style{weight},
							-slant  => $style{slant},
							-size   => $cw->_size ($style{size}),
							-underline => $style{underline},
							-overstrike => $style{overstrike},
						],
					);
					my @spans = ();
					push (@spans, '-columnspan' => $colspan) if defined $colspan;
					push (@spans, '-rowspan' => $rowspan) if defined $rowspan;
					$browser->grid (
						-row => $tabledata->{$tableid}->{row},
						-column => $tabledata->{$tableid}->{col},
						-sticky => 'nsew',
						-padx => $tabledata->{$tableid}->{cellspacing},
						-pady => $tabledata->{$tableid}->{cellspacing},
						@spans,
					);
					$lineWritten = 0;
				}
				push (@stack, $cw->_addStack(\%style));
			}
			elsif ($tag eq 'hr') { # HR
				my $at = $data[2];
				my $height = 4;
				if (exists $at->{size}) {
					$height = $at->{size};
				}
				my $width = $cw->screenwidth;
				my $frame = $browser->Frame (
					-relief             => 'raised',
					-height             => $height,
					-width              => $width,
					-borderwidth        => 1,
					-highlightthickness => 0,
				);
				$browser->insert ('end', "\n", $format);
				$browser->windowCreate ('end',
					-window => $frame,
					-padx   => 0,
					-pady   => 5,
				);
				$browser->insert ('end', "\n", $format);
				$lineWritten = 0;
			}
			elsif ($tag eq 'img') { # IMG
				my $at = $data[2];

				my $format = '';
				my $align = lc($at->{align}) || '';
				$align = 'baseline' unless $align =~ /^(top|center|bottom|baseline)$/;
				if (length $at->{src}) {
					my ($ext) = $at->{src} =~ /\.([^\.]+)$/i;
					if ($ext =~ /^gif$/i) {
						$format = 'GIF';
					}
					elsif ($ext =~ /^png$/i) {
						$format = 'PNG';
					}
					elsif ($ext =~ /^(jpeg|jpe|jpg)$/i) {
						$format = 'JPEG';
					}
					elsif ($ext =~ /^bmp$/i) {
						$format = 'BMP';
					}
				}

				my $broken = 0;

				# Request this resource.
				my $data = $cw->_event ('Resource',
					tag    => 'img',
					src    => $at->{src} || '',
					width  => $at->{width} || '',
					height => $at->{height} || '',
					vspace => $at->{vspace} || '',
					hspace => $at->{hspace} || '',
					align  => $at->{align} || '',
					alt    => $at->{alt} || '',
				);
				$data = '' unless defined $data;

				# Invalid format?
				if (length $format == 0 || length $data == 0) {
					$broken = 1;
				}

				if (length $data > 0 && not $broken) {
					my $image = $cw->Photo (
						-data   => $data,
						-format => $format,
					);
					$browser->imageCreate ('end',
						-image => $image,
						-align => $align,
						-padx  => $cw->_isNumber($at->{hspace},2),
						-pady  => $cw->_isNumber($at->{vspace},2),
					);
				}
				else {
					my $image = $cw->Photo (
						-data   => $cw->_brokenImage(),
						-format => 'PNG',
					);
					$browser->imageCreate ('end',
						-image => $image,
						-align => $align,
						-padx  => $cw->_isNumber($at->{hspace},2),
						-pady  => $cw->_isNumber($at->{vspace},2),
					);
				}

				$lineWritten = 1;
			}
			elsif ($tag eq 'font' || $tag eq 'basefont') { # Font
				my $at = $data[2];

				if (exists $at->{face}) {
					$style{family} = $at->{face};
				}
				if (exists $at->{size}) {
					$style{size} = $at->{size};
				}
				if (exists $at->{color}) {
					$style{foreground} = $at->{color};
				}
				if (exists $at->{back}) {
					$style{background} = $at->{back};
				}

				push (@stack, $cw->_addStack(\%style));
			}
			elsif ($tag =~ /^h(1|2|3|4|5|6)$/) { # Heading
				my $level = $1;
				my $size = $cw->_heading($level);
				$browser->insert ('end',"\n\n") if $lineWritten;
				$style{size} = $size;
				$style{weight} = 'bold';
				push (@stack, $cw->_addStack(\%style));
			}
			elsif ($tag eq "ol") { # Ordered List
				my $at = $data[2];
				if ($style{inol} == 0 && $style{inul} == 0 && $lineWritten) {
					$browser->insert ('end',"\n\n");
				}
				elsif ($style{inol} || $style{inul}) {
					$browser->insert ('end',"\n");
				}
				$style{lmargin1} += 15;
				$style{lmargin2} += 30;
				$style{inol}++;
				$olLevel++;

				my $type = 1;
				my $start = 1;
				if (defined $at->{type}) {
					$type = $at->{type};
				}
				if (defined $at->{start}) {
					$start = $at->{start};
				}

				$olStyles->{$olLevel} = {
					type     => $type,
					position => $start,
				};

				push (@stackList,join('#','ol',$olLevel));
				push (@stackOLLevel,$olLevel);

				push (@stack, $cw->_addStack(\%style));
			}
			elsif ($tag eq "ul") { # Unordered List
				my $at = $data[2];
				if ($style{inol} == 0 && $style{inul} == 0 && $lineWritten) {
					$browser->insert ('end',"\n\n");
				}
				elsif ($style{inol} || $style{inul}) {
					$browser->insert ('end',"\n");
				}
				$style{lmargin1} += 15;
				$style{lmargin2} += 30;
				$style{inul}++;
				$ulLevel++;

				# Find out any style info.
				my $type = "disc";
				if (defined $at->{type}) {
					$type = $at->{type};
				}

				$ulStyles->{$ulLevel} = {
					type => $type,
				};

				push (@stackList,join('#','ul',$ulLevel));
				push (@stackULLevel,$ulLevel);

				push (@stack, $cw->_addStack(\%style));
			}
			elsif ($tag eq 'li') { # List Item
				if (scalar(@stackList)) {
					my ($family,$level) = split(/#/, $stackList[-1], 2);
					my $kind = '';
					my $begin = 0;
					if ($family eq "ol") {
						$kind = $olStyles->{$level}->{type};
						$begin = $olStyles->{$level}->{position};
					}
					else {
						$kind = $ulStyles->{$level}->{type};
						$begin = 0;
					}

					if ($family eq "ol") {
						$olStyles->{$level}->{position}++;
						my $symbol = $cw->_getOLsym ($kind,$begin);
						$symbol .= ".";
						$symbol .= " " until length $symbol >= 8;
						$browser->insert ('end',"$symbol",$format);
					}
					else {
						my $symbol = $cw->_getULsym ($kind);
						$browser->insert ('end',"$symbol  ",$format);
					}
				}
			}
			elsif ($tag eq 'blockquote') { # Blockquote
				$browser->insert ('end',"\n",$format) if $lineWritten;
				$style{lmargin1} += 25;
				$style{lmargin2} += 25;
				$style{rmargin} += 25;
				push (@stack, $cw->_addStack(\%style));
			}
			elsif ($tag eq 'div') { # Div
				my $at = $data[2];
				$browser->insert ('end',"\n",$format) if $lineWritten;

				if (exists $at->{align}) {
					if ($at->{align} =~ /^(center|left|right)$/i) {
						$style{justify} = lc($1);
					}
				}

				push (@stack, $cw->_addStack(\%style));
			}
			elsif ($tag eq 'span') { # Span
				push (@stack, $cw->_addStack(\%style));
			}
			elsif ($tag eq 'pre') { # Pre
				$browser->insert('end', "\n", $format) if $lineWritten;
				$style{family} = $mAttr->{'-font'}->{'-mono'};
				$style{pre} = 1;
				push (@stack, $cw->_addStack(\%style));
			}
			elsif ($tag =~ /^(code|tt|kbd|samp)$/) { # Code
				$style{family} = $mAttr->{'-font'}->{'-mono'};
				push (@stack, $cw->_addStack(\%style));
			}
			elsif ($tag =~ /^(center|right|left)$/) { # Alignment
				my $align = $1;
				$browser->insert ('end',"\n",$format);
				$style{justify} = lc($align);
				push (@stack, $cw->_addStack(\%style));
			}
			elsif ($tag eq 'sup') { # Superscript
				$style{size}--;
				$style{size} = 0 if $style{size} < 0;
				$style{offset} += 4;
				push (@stack, $cw->_addStack(\%style));
			}
			elsif ($tag eq 'sub') { # Subscript
				$style{size}--;
				$style{size} = 0 if $style{size} < 0;
				$style{offset} -= 2;
				push (@stack, $cw->_addStack(\%style));
			}
			elsif ($tag eq 'big') { # Big
				$style{size}++;
				push (@stack, $cw->_addStack(\%style));
			}
			elsif ($tag eq 'small') { # Small
				$style{size}--;
				push (@stack, $cw->_addStack(\%style));
			}
			elsif ($tag =~ /^(b|strong)$/) { # Bold
				$style{weight} = "bold";
				push (@stack, $cw->_addStack(\%style));
			}
			elsif ($tag =~ /^(i|em|address|var|cite|def)$/) { # Italic
				$style{slant} = "italic";
				push (@stack, $cw->_addStack(\%style));
			}
			elsif ($tag =~ /^(u|ins)$/) { # Underline
				$style{underline} = 1;
				push (@stack, $cw->_addStack(\%style));
			}
			elsif ($tag =~ /^(s|del)$/) { # Strike-out
				$style{overstrike} = 1;
				push (@stack, $cw->_addStack(\%style));
			}
		}
		elsif ($data[0] eq "E") { # End Tag
			# Skip blocked tags.
			next if $cw->_blockedTag ($data[1]);

			my $tag = lc($data[1]);
			my $format = $cw->_makeTag(\%style);
			if ($tag =~ /^(html|head)$/) { # /HTML, /HEAD
				# That was nice of them.
			}
			elsif ($tag eq 'title') { # /Title
				# Ignore; we already got the title.
			}
			elsif ($tag eq 'body') { # /Body
				$browser->insert('end',"\n",$format);
				%style = $cw->_rollbackStack(\@stack,
					qw(foreground background));
			}
			elsif ($tag eq 'a') { # /A
				# We're not linking anymore.
				$style{linking} = 0;
				$style{linktag} = '';
			}
			elsif ($tag eq 'p') { # /Paragraph
				$browser->insert('end',"\n\n",$format);
				$lineWritten = 0;
			}
			elsif ($tag eq 'table') { # /Table
				$browser->insert('end',"\n",$format);
				%style = $cw->_rollbackStack(\@stack,
					qw(intable));
			}
			elsif ($tag eq "tr") { # /Table Row
				# Do nothing.
			}
			elsif ($tag =~ /^(td|th|thead|tbody|tfoot)$/) { # /Table Data
				if ($style{intd}) {
					$style{intd} = 0;
					my $endline = $browser->index('end');
					$endline =~ s/\..*$//;
					my $i = 0;
					my $max = 0;
					while ($i++ < $endline) {
						my $l = length (
							$browser->get("$i.0","$i.0 lineend")
						);
						$max = $l if $l > $max;
					}
					$browser->configure (-width => $max,
						-height => $endline - 1);
					%style = $cw->_rollbackStack(\@stack,
						qw(intd));

					# Reset the browser.
					$browser = $cw;
				}
			}
			elsif ($tag eq 'select') { # /Select
				if ($curSelect->{in}) {
					# Collect the choices.
					my @choices = ();
					foreach my $choice (@{$curSelect->{opts}}) {
						push (@choices,$choice->[1] || $choice->[0]);
					}

					# Determine if we need a Listbox or a BrowseEntry.
					my $name = $curSelect->{name} || 'x_not_a_form_field';
					my $size = $curSelect->{size};
					my $mult = $curSelect->{multiple};
					$size = 1 unless $cw->_isNumber($size);
					if ($size <= 1) {
						# BrowseEntry.
						my $widget = $browser->BrowseEntry (
							-variable => \$formdata->{$formname}->{fields}->{$name},
							-choices  => [ @choices ],
							-state      => $curSelect->{state},
							-foreground => '#000000',
							-background => '#FFFFFF',
							-disabledforeground => '#000000',
							-disabledbackground => '#FFFFFF',
							-border     => 1,
							-highlightthickness => 0,
							-font       => [
								-family => 'Helvetica',
								-size   => 10,
							],
						);
						$browser->windowCreate ('end',
							-window => $widget,
							-align  => 'baseline',
						);
					}
					else {
						# Listbox.
						$formdata->{$formname}->{listboxes}->{$name} = 1;
						$formdata->{$formname}->{listwidget}->{$name} = $browser->Listbox (
							-height => $size,
							-foreground => '#000000',
							-background => '#FFFFFF',
							-font       => [
								-family => 'Helvetica',
								-size   => 10,
							],
							-selectmode => ($mult ? 'multiple' : 'single'),
							-exportselection => 0,
							-border          => 1,
							-highlightthickness => 0,
						);
						$formdata->{$formname}->{listwidget}->{$name}->insert('end',@choices);
						$browser->windowCreate ('end',
							-window => $formdata->{$formname}->{listwidget}->{$name},
							-align  => 'baseline',
						);
					}
				}
			}
			elsif ($tag eq 'font') { # /Font
				%style = $cw->_rollbackStack(\@stack,
					qw(family size color back));
			}
			elsif ($tag =~ /^h(1|2|3|4|5|6)$/) { # /Heading
				$browser->insert('end',"\n\n",$format);
				%style = $cw->_rollbackStack(\@stack,
					qw(size weight));
				$lineWritten = 0;
			}
			elsif ($tag eq 'ol') { # /Ordered List
				pop (@stackList);
				%style = $cw->_rollbackStack(\@stack,
					qw(lmargin1 lmargin2));

				my $lastLevel = pop(@stackOLLevel);
				$style{olLevel} = $stackOLLevel[-1] || 0;
				delete $olStyles->{$lastLevel};

				$style{inol}--;
				$olLevel--;
				$olLevel = 0 if $olLevel < 0;
				$style{inol} = 0 if $style{inol} < 0;

				if ($style{inol} || $style{inul}) {
					$browser->insert ('end',"\n",$format);
					$lineWritten = 0;
				}
				else {
					$browser->insert ('end',"\n\n",$format);
					$lineWritten = 0;
				}
			}
			elsif ($tag eq 'ul') { # /Unordered List
				pop (@stackList);
				%style = $cw->_rollbackStack(\@stack,
					qw(lmargin1 lmargin2));

				my $lastLevel = pop(@stackULLevel);
				$style{ulLevel} = $stackULLevel[-1] || 0;
				delete $ulStyles->{$lastLevel};

				$style{inul}--;
				$ulLevel--;
				$ulLevel = 0 if $ulLevel < 0;
				$style{inul} = 0 if $style{inul} < 0;

				if ($style{inol} || $style{inul}) {
					$browser->insert ('end',"\n",$format);
					$lineWritten = 0;
				}
				else {
					$browser->insert ('end',"\n\n",$format);
					$lineWritten = 0;
				}
			}
			elsif ($tag eq 'li') { # /LI
				$browser->insert('end',"\n",$format);
				$lineWritten = 0;
			}
			elsif ($tag eq 'blockquote') { # /Blockquote
				$browser->insert('end',"\n",$format);
				%style = $cw->_rollbackStack(\@stack,
					qw(lmargin1 lmargin2 rmargin));
				$lineWritten = 0;
			}
			elsif ($tag eq 'div') { # /Div
				$browser->insert('end',"\n",$format);
				%style = $cw->_rollbackStack(\@stack,'justify');
				$lineWritten = 0;
			}
			elsif ($tag eq 'span') { # /Span
				%style = $cw->_rollbackStack(\@stack);
			}
			elsif ($tag eq 'pre') { # /Pre
				$browser->insert ('end',"\n",$format);
				%style = $cw->_rollbackStack(\@stack,
					qw(family pre));
			}
			elsif ($tag =~ /^(code|tt|kbd|samp)$/) { # /Code
				%style = $cw->_rollbackStack(\@stack,'family');
			}
			elsif ($tag =~ /^(center|right|left)$/) { # /Align
				$browser->insert('end',"\n",$format);
				%style = $cw->_rollbackStack(\@stack,'justify');
				$lineWritten = 0;
			}
			elsif ($tag =~ /^(sup|sub)$/) { # /Superscript, /Subscript
				%style = $cw->_rollbackStack(\@stack,
					qw(size offset));
			}
			elsif ($tag =~ /^(big|small)$/) { # /Big, /Small
				%style = $cw->_rollbackStack(\@stack,'size');
			}
			elsif ($tag =~ /^(b|strong)$/) { # /Bold
				%style = $cw->_rollbackStack(\@stack,'weight');
			}
			elsif ($tag =~ /^(i|em|address|var|cite|def)$/) { # /Italic
				%style = $cw->_rollbackStack(\@stack,'slant');
			}
			elsif ($tag =~ /^(u|ins)$/) { # /Underline
				%style = $cw->_rollbackStack(\@stack,'underline');
			}
			elsif ($tag =~ /^(s|del)$/) { # /Overstrike
				%style = $cw->_rollbackStack(\@stack,'overstrike');
			}
		}
	}
}

sub _addStack {
	my ($cw,$style) = @_;

	my @keys = sort { $a cmp $b } keys %{$style};
	my @parts = ();
	foreach my $k (@keys) {
		my $val = $style->{$k};
		$val = uri_escape($val);
		push (@parts,join("=",$k,$val));
	}

	return join ("&",@parts);
}

sub _rollbackStack {
	my ($cw,$stack,@keys) = @_;

	my $newStyle = {};
	if (scalar @{$stack} > 1) {
		my $curStack = $stack->[-1];
		my $lastStack = $stack->[-2];
		my $curStyle = {};
		my $lastStyle = {};

		# Collect the style data.
		foreach my $p (split(/\&/, $curStack)) {
			my ($k,$val) = split(/=/, $p, 2);
			$val = uri_unescape($val);
			$curStyle->{$k} = $val;
		}
		foreach my $p (split(/\&/, $lastStack)) {
			my ($k,$val) = split(/=/, $p, 2);
			$val = uri_unescape($val);
			$lastStyle->{$k} = $val;
		}

		$newStyle = $lastStyle;

		# For @keys, set these values to what they were before.
		foreach my $k (@keys) {
			$newStyle->{$k} = (defined $lastStyle->{$k} &&
				length $lastStyle->{$k}) ? $lastStyle->{$k} : '';
		}

		pop(@{$stack});
		return %{$newStyle};
	}
	else {
		my $curStyle = {};

		foreach my $p (split(/\&/, $stack->[-1])) {
			my ($k,$val) = split(/=/, $p, 2);
			$val = uri_unescape($val);
			$curStyle->{$k} = $val;
		}

		return %{$curStyle};
	}
}

sub _makeTag {
	my ($cw,$style,$widget) = @_;

	my @parts = ();
	foreach my $k (sort { $a cmp $b } keys %{$style}) {
		my $val = uri_escape($style->{$k}) || '';
		push (@parts,$val);
	}

	my $tag = join("-",@parts);

	if (defined $widget) {
		$widget->tagConfigure ($tag,
			-foreground => $style->{foreground},
			-background => $style->{background},
			-font       => [
				-family => $style->{family},
				-weight => $style->{weight},
				-slant  => $style->{slant},
				-size   => $cw->_size ($style->{size}),
				-underline => $style->{underline},
				-overstrike => $style->{overstrike},
			],
			-offset => $style->{offset},
			-justify => $style->{justify},
			-lmargin1 => $style->{lmargin1},
			-lmargin2 => $style->{lmargin2},
			-rmargin  => $style->{rmargin},
		);
	}
	else {
		$cw->SUPER::tagConfigure ($tag,
			-foreground => $style->{foreground},
			-background => $style->{background},
			-font       => [
				-family => $style->{family},
				-weight => $style->{weight},
				-slant  => $style->{slant},
				-size   => $cw->_size ($style->{size}),
				-underline => $style->{underline},
				-overstrike => $style->{overstrike},
			],
			-offset => $style->{offset},
			-justify => $style->{justify},
			-lmargin1 => $style->{lmargin1},
			-lmargin2 => $style->{lmargin2},
			-rmargin  => $style->{rmargin},
		);
	}

	return $tag;
}

# Calculates the point size from an HTML size.
sub _size {
	my ($cw,$size) = @_;

	# Translate words to numbers?
	if ($size =~ /[^0-9]/) {
		$size = $cw->_sizeStringToNumber ($size);
	}

	my %map = (
		# HTML => Point
		0 => 8,
		1 => 9,
		2 => 10,
		3 => 12,
		4 => 14,
		5 => 16,
		6 => 18,
	);

	return exists $map{$size} ? $map{$size} : 10;
}

# Calculates the HTML size for a heading.
sub _heading {
	my ($cw,$level) = @_;

	my %map = (
		# Level => HTML Size
		1 => 6,
		2 => 5,
		3 => 4,
		4 => 3,
		5 => 2,
		6 => 1,
	);

	return exists $map{$level} ? $map{$level} : 6;
}

sub _sizeStringToNumber {
	my ($cw,$string) = @_;

	my %map = (
		'xx-large' => 6,
		'x-large'  => 5,
		'large'    => 4,
		'medium'   => 3,
		'small'    => 2,
		'x-small'  => 1,
		'xx-small' => 0,
	);

	return exists $map{$string} ? $map{$string} : 3;
}

sub _isNumber {
	my ($cw,$number,$default) = @_;

	if (defined $number && length $number && $number !~ /[^0-9]/) {
		return $number;
	}
	else {
		return $default;
	}
}

sub _getOLsym {
	my ($cw,$type,$pos) = @_;

	my %letterhash = (
		0 => '',
		1 => 'A',
		2 => 'B',
		3 => 'C',
		4 => 'D',
		5 => 'E',
		6 => 'F',
		7 => 'G',
		8 => 'H',
		9 => 'I',
		10 => 'J',
		11 => 'K',
		12 => 'L',
		13 => 'M',
		14 => 'N',
		15 => 'O',
		16 => 'P',
		17 => 'Q',
		18 => 'R',
		19 => 'S',
		20 => 'T',
		21 => 'U',
		22 => 'V',
		23 => 'W',
		24 => 'X',
		25 => 'Y',
		26 => 'Z',
	);

	if ($type =~ /^[0-9]+$/) {
		# Numeric types are easy.
		return $pos;
	}
	elsif ($type eq 'I') {
		# Roman numerals.
		return uc ($cw->_roman($pos));
	}
	elsif ($type eq 'i') {
		# Roman numerals.
		return lc ($cw->_roman($pos));
	}
	elsif ($type =~ /^[A-Za-z]+$/) {
		# Alphabetic.
		my $string = '';
		while ($pos > 26) {
			my $first = $pos % 26;
			my $second = ($pos - $first) / 26;
			$string = $letterhash{$first} . $string;
			$pos = $second;
		}

		$string = $letterhash{$pos} . $string;

		if ($type =~ /^[A-Z]+$/) {
			return uc($string);
		}
		else {
			return lc($string);
		}
	}

	return $pos;
}

sub _getULsym {
	my ($cw,$type) = @_;

	my $circle = chr(0x25cb);
	my $disc   = chr(0x25cf);
	my $square = chr(0x25aa);

	if ($type =~ /^circle$/i) {
		return $circle;
	}
	elsif ($type =~ /^square$/i) {
		return $square;
	}
	else {
		return $disc;
	}
}

sub _roman {
	my ($cw,$dec) = @_;

	0 < $dec and $dec < 4000 or return undef;

	my %roman2arabic = qw(I 1 V 5 X 10 L 50 C 100 D 500 M 1000);
	my %roman_digit = qw(1 IV 10 XL 100 CD 1000 MMMMMM);
	my @figure = reverse sort keys %roman_digit;
	$roman_digit{$_} = [ split(//, $roman_digit{$_}, 2) ] foreach @figure;

	my ($x,$roman);
	foreach (@figure) {
		my ($digit, $i, $v) = (int($dec / $_), @{$roman_digit{$_}});
		if (1 <= $digit and $digit <= 3) {
			$roman .= $i x $digit;
		}
		elsif ($digit == 4) {
			$roman .= join("", $i, $v);
		}
		elsif ($digit == 5) {
			$roman .= $v;
		}
		elsif (6 <= $digit and $digit <= 8) {
			$roman .= $v . ($i x ($digit - 5));
		}
		elsif ($digit == 9) {
			$roman .= join("", $i, $x);
		}
		$dec -= $digit * $_;
		$x = $i;
	}

	return $roman;
}

sub _blockedTag {
	my ($self,$tag) = @_;

	my $deny = 0;

	# If we have defined any "allowed tags", check it.
	if (scalar keys %{$self->{hypertext}->{allow}} > 0) {
		$deny = 1;

		# See if this tag is allowed.
		if (exists $self->{hypertext}->{allow}->{$tag}) {
			$deny = 0;
		}
	}

	# If we have any "denied tags", check them.
	if (scalar keys %{$self->{hypertext}->{deny}} > 0) {
		if (exists $self->{hypertext}->{deny}->{$tag}) {
			$deny = 1;
		}
	}

	return $deny;
}

sub _brokenImage {
	return q~iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABGdBTUEAAK/INwWK6QAAABl0RVh0
U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAKTSURBVHjaYmxpafnPMEAgPT2dASCAWECM
6upqxoFwwJs3b/4DBBATwwADgAAacAcABNCAOwAggAbcAQABNOAOAAigAXcAQAANuAMAAmjAHQAQ
QAPuAIAAItoBjIyM04D4PxKeBhVPBuIzyOJAzEesuQABxESk5S4uoqKZ/6urGf63tjL89/ZmUGJh
yQSKBwGlM8/U1hr/Ly5m+C8oyJAK5DNAMFEAIIAYQJUREDAQwkAwrYON7f9/Tc3//5WV/+8WEAAJ
7i53c/v/v7T0/xsGhv8xQAwUOwPEfMSY+fr16/8AAUSKA+SB+O4hoCXAcP7/X1b2f7mu7v//RUX/
/7Ow/I8GigtCHJBMjHkwBwAEENFpAKjhIZCaXosQYOjg5GRgWLWKYfKfPwwngELvgfJAdXNJSYQA
AURSLgAa3nOQgWH1ahkZBgY2NgaGW7cYnj95wvAaFDRg+xk6Sc0FAAFEkgOAiQ4UDcbGJiYMDOzs
DD8+fGBgBgrYAbE4AwMwBhhcSHUAQACRWg6Ud7i4KClxcTE8uX6dYRdQ4C0Q6wPxVIh8JilZEAQA
AoiUciBZSUgos9zIiIFh+XKGFqBYPhCD4p4ViJ2BOA0YOkCqgxQHAAQQseUAyFeZq8zNGRjmzmUo
+vePYQ9Q4AEw0YF8fhaILwOxJxDzQkIhiFgHAAQQC5HqMssZGY0/b9/OEAvk3IEkunugRAe0nBno
iDRQWvgAxI5AvAlSEK0jxmCAACKqHAAVLKCCiAGSz/9D7GcogcoZAPFMJLndQBxEbDkAEEAsRGa/
T0AqC4rR5S6AWthQTDIACKABrw0BAmjAHQAQQAPuAIAAGnAHAATQgDsAIIAG3AEAATTgDgAIIEZw
q2QAAUCAAQBj+lYRrQ+vagAAAABJRU5ErkJggg==~;
}

1;

__END__