# Library for generating HTML
# $Id: HTML.pm,v 1.1 2000/03/26 05:00:24 waidy Exp $

# Copyright 1999-2000 Tensilica Inc.
# This file is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published
# by the Free Software Foundation version 2.
#
# This file is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this file; see the file COPYING.  If not, write to the
# Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA

package HTML;

# Exports
#   $htext = quoteascii ($asciitext);
#	HTML to render $asciitext.  Replaces special characters
#	with their HTML references.  $htext may then be used as
#	an argument to wprint, block, inline, link, etc.
#   $attr = attribute ($name, $value);
#	Generate an element attribute setting of the form NAME=VALUE,
#	with special characters in the VALUE quoted.
# Methods
#   $html = new HTML ($file, $indent);
#	Create a new HTML output object directed to $file with HTML
#	indentation increment $indent.
#   $html->close ();
#   $html->hbegin ($title, $style, @bodyattr);
#	Generate HTML, HEAD, TITLE, STYLE, /HEAD, and BODY.
#   $html->hend ();
#	Generate /BODY and /HTML.
#   $html->bblock ($tag, @options);
#	Generate a block-level element begin tag of type $tag with
#	options @options (may be empty).
#   $html->eblock ([$tag]);
#	Generate a block-level element end tag.  If $tag is provided,
#	then it is used to match the bblock tag for error checking.
#   $html->block ($tag, $body, @options);
#	Generate a block-level element of type $tag with options
#	@options (may be empty) and body $body.  Equivalent to doing
#	bblock, wprint, and eblock.
#   $html->binline ($tag, @options);
#	Generate a inline element begin tag of type $tag with
#	options @options (may be empty).
#   $html->einline ([$tag]);
#	Generate a inline element end tag.  If $tag is provided,
#	then it is used to match the bblock tag for error checking.
#   $html->inline ($tag, $body, @options);
#	Generate a inline element of type $tag with options @options
#	(may be empty) and body $body.  Equivalent to doing binline,
#	wprint, and einline.
#   $html->blink ($url);
#	Generate a link to $url.
#   $html->elink ();
#	Generate a link end tag.
#   $html->link ($url, @text);
#	Generate a link to $url with the text @text.  Equivalent to
#	doing blink, wprint, and elink.
#   $html->banchor ($name);
#	Generate a link destination begin tag with id $name.
#   $html->eanchor ();
#	Generate a link destination end tag.
#   $html->comment (@text);
#	Generate an HTML comment containing @text.
#   $html->empty ($tag, @options);
#	Generate an inline element with no content and no end tag.
#	E.g. use for 'br' or 'img'.
#   $html->img ($src, $height, $width, $alt);
#	Generate an img element.
#   $html->ascii (@text);
#	Generate ASCII text, quoting HTML special characters.  Equivalent
#	to quoteascii and wprint.
#   $html->iprint (@text);
#	Generate HTML text.
#   $html->wprint (@text);
#	Generate HTML text with word wrapping.
#   $html->tablerow ([$head1, $head2, ...], $data1, $data2, ...);
#	Generate an HTML table row with headings $head1, ... and
#	data $data1, ...

use Exporter ();
@HTML::ISA = qw(Exporter);
@HTML::EXPORT = qw(&quoteascii &attribute &style);
@HTML::EXPORT_OK = @HTML::EXPORT;
%HTML::EXPORT_TAGS = ();

# Imports

# Perl library modules
use strict;

# Other modules
use Struct qw(
	$file
	$indent
	$level(get:set:inc)
	$col(get:set:inc)
	@HTMLtags(ref:push:pop)
	:_new(file:indent:level:col)
	);

# Global variables

use vars qw(%cref);

%cref = (
	'<' => '&lt;',
	'>' => '&gt;',
	'&' => '&amp;' );

# Routines

sub quoteascii {
  $_ = join('', @_);
  s/([<>&])/$cref{$1}/ge;
  $_;
}

sub attribute {
  my $name = shift(@_);
  $_ = join('', @_);
  if (/^\d+$/) {
    $name . '=' . $_;
  } else {
    s/\"/&\#34;/g;
    $name . '="' . $_ . '"';
  }
}

# Constructor

sub new {
  my ($class, $file, $indent) = @_;
  my $self = _new($class, $file, $indent, 0, 0);
  $self;
}

# Methods

sub close {
  my ($self) = @_;
  my @elements = @{$self->ref_HTMLtags()};
  die ("HTML::close: failed to close the following: @elements\n")
    unless @elements == 0;
}

sub hbegin {
  my ($self, $title, $style, @bodyattr) = @_;
  $self->bblock('html');
  $self->bblock('head');
  $self->block('title', $title);
  if (defined($style) && $style ne '') {
    $self->bblock('style', attribute('type', 'text/css'));
    $self->bprint('<!--');
    $self->inc_level ($self->indent());
    $self->wprint($style);
    $self->inc_level (-$self->indent());
    $self->bprint('  -->');
    $self->eblock('style');
  }
  $self->eblock('head');
  $self->bblock('body', @bodyattr);
}

sub hend {
  my ($self) = @_;
  $self->eblock('body');
  $self->eblock('html');
}

sub bblock {
  my ($self, @tag) = @_;
  die("HTML: no tag for bblock\n")
    if @tag < 1;
  $self->bprint ('<', join(' ', @tag), '>');
  $self->inc_level ($self->indent());
  $self->push_HTMLtags ($tag[0]);
}

sub eblock {
  my ($self, $check) = @_;
  my $tag = $self->pop_HTMLtags();
  die("HTML: tag mismatch: eblock expected $check but got $tag.\n")
    if defined($check) && $tag ne $check;
  $self->inc_level (-$self->indent());
  $self->bprint ('</', $tag, '>');
}

sub block {
  my ($self, $tag, $body, @attrs) = @_;
  $self->bblock ($tag, @attrs);
  $self->wprint ($body);
  $self->eblock ($tag);
}

sub binline {
  my ($self, @tag) = @_;
  die("HTML: no tag for binline\n")
    if @tag < 1;
  $self->iprint ('<', join(' ', @tag), '>');
  $self->push_HTMLtags ($tag[0]);
}

sub einline {
  my ($self, $check) = @_;
  my $tag = $self->pop_HTMLtags();
  die("HTML: tag mismatch: einline expected $check but got $tag.\n")
    if defined($check) && $tag ne $check;
  $self->iprint ('</', $tag, '>');
}

sub inline {
  my ($self, $tag, $body, @attrs) = @_;
  $self->binline ($tag, @attrs);
  $self->wprint ($body);
  $self->einline ($tag);
}

sub blink {
  my ($self, $url) = @_;
  $self->binline ('a', attribute('href', $url));
}

sub elink {
  my ($self) = @_;
  $self->einline ('a');
}

sub link {
  my ($self, $url, @text) = @_;
  $self->inline ('a', join('', @text), attribute('href', $url));
}

sub banchor {
  my ($self, $name) = @_;
  $self->binline ('a', attribute('name', $name));
}

sub eanchor {
  my ($self) = @_;
  $self->einline ('a');
}

sub pre {
  my $self = shift @_;
  $self->bblock ('pre');
  $self->file->print (quoteascii(@_));
  $self->eblock ('pre');
}

sub img {
  my ($self, $src, $height, $width, $alt) = @_;
  $self->empty ('img', attribute('src', $src),
		       attribute('height', $height),
		       attribute('width', $width),
		       attribute('alt', $alt));
}

sub comment {
  my $self = shift(@_);
  $self->bprint ('<!-- ', @_, ' -->');
}

sub empty {
  my ($self, @tag) = @_;
  die("HTML: no tag for empty\n")
    if @tag < 1;
  if ($tag[0] eq 'br') {
    $self->bprint ('<', join(' ', @tag), '>');
  } else {
    $self->iprint ('<', join(' ', @tag), '>');
  }
}

sub ascii {
  my $self = shift(@_);
  $self->wprint (quoteascii(@_));
}

sub bprint {
  my $self = shift(@_);
  my $file = $self->file();
  if ($self->col() != 0) {
    $file->print ("\n");
    $self->set_col (0);
  }
  my $level = $self->level();
  $file->print ("\t" x ($level >> 3), ' ' x ($level & 0x7), @_, "\n");
}

sub iprint {
  my $self = shift(@_);
  my $file = $self->file();
  my $data = join('', @_);
  if ($self->col() == 0) {
    my $level = $self->level();
    $file->print ("\t" x ($level >> 3), ' ' x ($level & 0x7), $data);
    $self->set_col ($level + length($data));
  } else {
    $file->print ($data);
    $self->inc_col (length($data));
  }
}

sub wprint {
  my $self = shift(@_);
  my $file = $self->file();
  my $col = $self->col();
  my $word;
  foreach $word (split(/(?=\s+)/, join('', @_))) {
    if ($col == 0 || $word =~ /^\n/ || ($col + length($word)) > 78) {
      $file->print("\n")
	if $col != 0;
      $word =~ s/^\s+//;
      my $level = $self->level();
      $file->print ("\t" x ($level >> 3), ' ' x ($level & 0x7), $word);
      $col = $level + length($word);
    } else {
      $file->print ($word);
      $col += length($word);
    }
  }
  $self->set_col ($col);
}

sub tablerow {
  my ($self, $head, @cells) = @_;
  $self->bblock('tr');
  my $cell;
  foreach $cell (@$head) {
    $self->block('th', $cell);
  }
  foreach $cell (@cells) {
    $self->block('td', $cell);
  }
  $self->eblock('tr');
}

sub style {
  join ("\n", map((ref($_[$_*2+0]) eq 'ARRAY'
		   ? join(', ', @{ $_[$_*2+0] })
		   : $_[$_*2+0])
		  .' {'.join('; ', map($_->[0].': '.$_->[1],
				       @{ $_[$_*2+1] }))
		   .'}',
		  0 .. ((@_ >> 1) - 1)));
}


1;


# Local Variables:
# mode:perl
# perl-indent-level:2
# cperl-indent-level:2
# End: