--- test/html-webhacc/WebHACC/Output.pm	2008/08/15 12:11:56	1.18
+++ test/html-webhacc/WebHACC/Output.pm	2008/12/11 03:22:57	1.27
@@ -8,11 +8,11 @@
   my $s = $_[0];
   $s =~ s/&/&/g;
   $s =~ s/</&lt;/g;
-  $s =~ s/>/&gt;/g;
+#  $s =~ s/>/&gt;/g;
   $s =~ s/"/&quot;/g;
-  $s =~ s{([\x00-\x09\x0B-\x1F\x7F-\xA0\x{FEFF}\x{FFFC}-\x{FFFF}])}{
-    sprintf '<var>U+%04X</var>', ord $1;
-  }ge;
+#  $s =~ s{([\x00-\x09\x0B-\x1F\x7F-\xA0\x{FEFF}\x{FFFC}-\x{FFFF}])}{
+#    sprintf '<var>U+%04X</var>', ord $1;
+#  }ge;
   return $s;
 };
 
@@ -20,7 +20,7 @@
   my $s = $_[0];
   $s =~ s/&/&amp;/g;
   $s =~ s/</&lt;/g;
-  $s =~ s/>/&gt;/g;
+#  $s =~ s/>/&gt;/g;
   $s =~ s/"/&quot;/g;
   return $s;
 };
@@ -68,49 +68,49 @@
 } # has_error
 
 sub set_utf8 ($) {
-  binmode shift->{handle}, ':utf8';
+  binmode $_[0]->{handle}, ':utf8';
 } # set_utf8
 
 sub set_flush ($) {
-  shift->{handle}->autoflush (1);
+  $_[0]->{handle}->autoflush (1);
 } # set_flush
 
 sub unset_flush ($) {
-  shift->{handle}->autoflush (0);
+  $_[0]->{handle}->autoflush (0);
 } # unset_flush
 
 sub html ($$) {
-  shift->{handle}->print (shift);
+  $_[0]->{handle}->print ($_[1]);
 } # html
 
 sub text ($$) {
-  shift->html ($htescape->(shift));
+  $_[0]->{handle}->print ($htescape->($_[1]));
 } # text
 
 sub url ($$%) {
   my ($self, $url, %opt) = @_;
-  $self->html (q[<code class=uri>&lt;]);
+  $self->{handle}->print (q[<code class=uri>&lt;]);
   $self->link ($url, %opt, url => $url);
-  $self->html (q[></code>]);
+  $self->{handle}->print (q[></code>]);
 } # url
 
 sub start_tag ($$%) {
   my ($self, $tag_name, %opt) = @_;
-  $self->html ('<' . $htescape_value->($tag_name)); # escape for safety
+  $self->{handle}->print ('<' . $tag_name);
   if (exists $opt{id}) {
     my $id = $self->input->id_prefix . $opt{id};
-    $self->html (' id="' . $htescape_value->($id) . '"');
+    $self->{handle}->print (' id="' . $htescape_value->($id) . '"');
     delete $opt{id};
   }
-  for (keys %opt) {    # for safety
-    $self->html (' ' . $htescape_value->($_) . '="' .
-                 $htescape_value->($opt{$_}) . '"');
+  for (keys %opt) {
+    $self->{handle}->print
+        (' ' . $_ . '="' . $htescape_value->($opt{$_}) . '"');
   }
-  $self->html ('>');
+  $self->{handle}->print ('>');
 } # start_tag
 
 sub end_tag ($$) {
-  shift->html ('</' . $htescape_value->(shift) . '>');
+  $_[0]->{handle}->print ('</' . $_[1] . '>');
 } # end_tag
 
 sub start_section ($%) {
@@ -181,7 +181,7 @@
     if ($self->{section_rank} == 2 or length $opt{parent_id}) {
       my $st = $opt{short_title} || $opt{title};
       push @{$self->{nav}},
-          [$id => $st => $opt{text}];
+          [$id => $st => $opt{text}] if $self->{section_rank} == 2;
       
       $self->start_tag ('script');
       $self->html (qq[ addSectionLink ('$id', ']);
@@ -271,25 +271,24 @@
 } # add_source_to_parse_error_list
 
 sub start_code_block ($) {
-  shift->html ('<pre><code>');
+  $_[0]->{handle}->print ('<pre><code>');
 } # start_code_block
 
 sub end_code_block ($) {
-  shift->html ('</code></pre>');
+  $_[0]->{handle}->print ('</code></pre>');
 } # end_code_block
 
 sub code ($$;%) {
   my ($self, $content, %opt) = @_;
   $self->start_tag ('code', %opt);
   $self->text ($content);
-  $self->html ('</code>');
+  $self->{handle}->print ('</code>');
 } # code
 
 sub script ($$;%) {
   my ($self, $content, %opt) = @_;
   $self->start_tag ('script', %opt);
-  $self->html ($content);
-  $self->html ('</script>');
+  $self->{handle}->print ($content . '</script>');
 } # script
 
 sub dt ($$;%) {
@@ -310,9 +309,9 @@
   while (@options) {
     my $opt = shift @options;
     if ($opt->{options}) {
-      $self->html ('<optgroup label="');
+      $self->{handle}->print ('<optgroup label="');
       $self->nl_text ($opt->{label});
-      $self->html ('">');
+      $self->{handle}->print ('">');
       unshift @options, @{$opt->{options}}, {end_options => 1};
     } elsif ($opt->{end_options}) {
       $self->end_tag ('optgroup');
@@ -330,15 +329,21 @@
 sub link ($$%) {
   my ($self, $content, %opt) = @_;
   $self->start_tag ('a', %opt, href => $opt{url});
-  $self->text ($content);
-  $self->html ('</a>');
+  $self->{handle}->print ($htescape->($content) . '</a>');
 } # link
 
 sub xref ($$%) {
   my ($self, $content, %opt) = @_;
-  $self->html ('<a href="#' . $htescape->($self->input->id_prefix . $opt{target}) . '">');
+  $self->{handle}->print
+      ('<a href="#' . $htescape->($self->input->id_prefix . $opt{target}) . '">');
   $self->nl_text ($content, text => $opt{text});
-  $self->html ('</a>');
+  $self->{handle}->print ('</a>');
+} # xref
+
+sub xref_text ($$%) {
+  my ($self, $content, %opt) = @_;
+  $self->html ('<a href="#' . $htescape->($self->input->id_prefix . $opt{target}) . '">');
+  $self->{handle}->print ($htescape->($content) . '</a>');
 } # xref
 
 sub link_to_webhacc ($$%) {
@@ -394,9 +399,10 @@
 sub node_link ($$) {
   my ($self, $node) = @_;
   if ($node->isa ('Message::IF::Node')) {
-    $self->xref ($get_node_path->($node), target => 'node-' . refaddr $node);
+    $self->xref_text ($get_node_path->($node),
+                      target => 'node-' . refaddr $node);
   } else {
-    $self->html ($get_object_path->($node));
+    $self->{handle}->print ($get_object_path->($node));
   }
 } # node_link
 
@@ -425,62 +431,69 @@
   my ($self, $type, %opt) = @_;
   my $node = $opt{node};
 
-  my @arg;
-  {
-    if (defined $Msg->{$type}) {
-      my $msg = $Msg->{$type}->[1];
-      if ($msg =~ /<var>/) {
-        $msg =~ s{<var>\$([0-9]+)</var>}{
-          defined $arg[$1] ? $htescape->($arg[$1]) : '(undef)';
-        }ge;
-        $msg =~ s{<var>{\@([A-Za-z0-9:_.-]+)}</var>}{
-          UNIVERSAL::can ($node, 'get_attribute_ns')
-              ? $htescape->($node->get_attribute_ns (undef, $1)) : ''
-        }ge;
-        $msg =~ s{<var>{\@}</var>}{
-          UNIVERSAL::can ($node, 'value') ? $htescape->($node->value) : ''
-        }ge;
-        $msg =~ s{<var>{text}</var>}{
-          defined $opt{text} ? $htescape->($opt{text}) : ''
-        }ge;
-        $msg =~ s{<var>{value}</var>}{
-          defined $opt{value} ? $htescape->($opt{value}) : ''
-        }ge;
-        $msg =~ s{<var>{local-name}</var>}{
-          UNIVERSAL::can ($node, 'manakai_local_name')
+  if (defined $Msg->{$type}) {
+    my $msg = $Msg->{$type}->[1];
+    if ($msg =~ /<var>/) {
+      $msg =~ s{<var>{\@([A-Za-z0-9:_.-]+)}</var>}{
+        UNIVERSAL::can ($node, 'get_attribute_ns')
+            ? $htescape->($node->get_attribute_ns (undef, $1)) : ''
+      }ge;
+      $msg =~ s{<var>{\@}</var>}{
+        UNIVERSAL::can ($node, 'value') ? $htescape->($node->value) : ''
+      }ge;
+      $msg =~ s{<var>{text}</var>}{
+        defined $opt{text} ? $htescape->($opt{text}) : ''
+      }ge;
+      $msg =~ s{<var>{value}</var>}{
+        defined $opt{value} ? $htescape->($opt{value}) : ''
+      }ge;
+      $msg =~ s{<var>{octets}</var>}{
+        if (defined $opt{octets}) {
+          join ', ', map {sprintf '0x%02X', ord $_} split //, ${$opt{octets}};
+        } else {
+          '';
+        }
+      }ge;
+      $msg =~ s{<var>{char}</var>}{
+        defined $opt{char} ? $htescape->(${$opt{char}}) : ''
+      }ge;
+      $msg =~ s{<var>{char:hexref}</var>}{
+        if (defined $opt{char}) {
+          join '', map {sprintf '&amp;#x%02X;', ord $_} split //, ${$opt{char}};
+        } else {
+          '';
+        }
+      }ge;
+      $msg =~ s{<var>{local-name}</var>}{
+        UNIVERSAL::can ($node, 'manakai_local_name')
             ? $htescape->($node->manakai_local_name) : ''
-        }ge;
-        $msg =~ s{<var>{element-local-name}</var>}{
-          (UNIVERSAL::can ($node, 'owner_element') and
-           $node->owner_element)
+      }ge;
+      $msg =~ s{<var>{element-local-name}</var>}{
+        (UNIVERSAL::can ($node, 'owner_element') and $node->owner_element)
             ? $htescape->($node->owner_element->manakai_local_name) : ''
-        }ge;
-      }
-      $self->html ($msg);
-      return;
-    } elsif ($type =~ s/:([^:]*)$//) {
-      unshift @arg, $1;
-      redo;
+      }ge;
     }
+    $self->{handle}->print ($msg);
+  } else {
+    $self->{handle}->print ($htescape->($type));
   }
-  $self->text ($type);
 } # nl_text
 
 }
 
 sub nav_list ($) {
-  my $self = shift;
-  $self->html (q[<ul class="navigation" id="nav-items">]);
-  for (@{$self->{nav}}) {
-    $self->html (qq[<li><a href="#@{[$htescape->($_->[0])]}">]);
-    $self->nl_text ($_->[1], text => $_->[2]);
-    $self->html ('</a>');
-  }
-  $self->html ('</ul>');
+#  my $self = shift;
+#  $self->html (q[<ul class="navigation" id="nav-items">]);
+#  for (@{$self->{nav}}) {
+#    $self->html (qq[<li><a href="#@{[$htescape->($_->[0])]}">]);
+#    $self->nl_text ($_->[1], text => $_->[2]);
+#    $self->html ('</a>');
+#  }
+#  $self->html ('</ul>');
 } # nav_list
 
 sub http_header ($) {
-  shift->html (qq[Content-Type: text/html; charset=utf-8\n\n]);
+  $_[0]->{handle}->print (qq[Content-Type: text/html; charset=utf-8\n\n]);
 } # http_header
 
 sub http_error ($$) {
@@ -489,23 +502,24 @@
   my $text = {
     404 => 'Not Found',
   }->{$code};
-  $self->html (qq[Status: $code $text\nContent-Type: text/html ; charset=us-ascii\n\n$code $text]);
+  $self->{handle}->print
+      (qq[Status: $code $text\nContent-Type: text/html ; charset=us-ascii\n\n$code $text]);
 } # http_error
 
 sub html_header ($) {
   my $self = shift;
-  $self->html (q[<!DOCTYPE html>]);
+  $self->{handle}->print (q[<!DOCTYPE html>]);
   $self->start_tag ('html', lang => $self->{primary_language});
-  $self->html (q[<head><title>]);
+  $self->{handle}->print (q[<head><title>]);
   $self->nl_text (q[WebHACC:Title]);
-  $self->html (q[</title>
+  $self->{handle}->print (q[</title>
 <link rel="stylesheet" href="../cc-style.css" type="text/css">
 <script src="../cc-script.js"></script>
 </head>
 <body onclick=" return onbodyclick (event) " onload=" onbodyload () ">
 <h1>]);
   $self->nl_text (q[WebHACC:Heading]);
-  $self->html (q[</h1><script> insertNavSections () </script>]);
+  $self->{handle}->print (q[</h1><script> insertNavSections () </script>]);
 } # html_header
 
 sub generate_input_section ($$) {
@@ -523,7 +537,7 @@
   my $options = sub ($) {
     my $context = shift;
 
-    $out->html (q[<div class="details default"><p class=legend onclick="nextSibling.style.display = nextSibling.style.display == 'block' ? 'none' : 'block'; parentNode.className = nextSibling.style.display == 'none' ? 'details' : 'details open'">]);
+    $out->{handle}->print (q[<div class="details default"><p class=legend onclick="nextSibling.style.display = nextSibling.style.display == 'block' ? 'none' : 'block'; parentNode.className = nextSibling.style.display == 'none' ? 'details' : 'details open'" tabindex=0>]);
     $out->nl_text (q[Options]);
     $out->start_tag ('div');
 
@@ -545,13 +559,16 @@
     $out->select ([
       {value => '', label => 'As specified'},
       {value => 'application/atom+xml'},
+      {value => 'text/cache-manifest'},
+      {value => 'text/css'},
+      {value => 'text/x-css-inline'},
+      {value => 'text/x-h2h'},
+      {value => 'text/html'},
+      {value => 'text/x-regexp-js'},
+      {value => 'text/x-webidl'},
       {value => 'application/xhtml+xml'},
       {value => 'application/xml'},
-      {value => 'text/html'},
       {value => 'text/xml'},
-      {value => 'text/css'},
-      {value => 'text/cache-manifest'},
-      {value => 'text/x-webidl'},
     ], name => 'i', selected => scalar $cgi->get_parameter ('i'));
     $out->end_tag ('label');
 
@@ -565,23 +582,75 @@
         {label => 'Japanese charsets', options => [
           {value => 'Windows-31J'},
           {value => 'Shift_JIS'},
+          {value => 'x-sjis'},
           {value => 'EUC-JP'},
+          {value => 'x-euc-jp'},
           {value => 'ISO-2022-JP'},
+          {value => 'ISO-2022-JP-1'},
+          {value => 'ISO-2022-JP-2'},
         ]},
-        {label => 'European charsets', options => [
+        {label => 'Latin charsets', options => [
+          {value => 'Windows-1250'},
           {value => 'Windows-1252'},
+          {value => 'Windows-1254'},
+          {value => 'Windows-1257'},
+          {value => 'Windows-1258'},
           {value => 'ISO-8859-1'},
+          {value => 'ISO-8859-2'},
+          {value => 'ISO-8859-3'},
+          {value => 'ISO-8859-4'},
+          {value => 'ISO-8859-9'},
+          {value => 'ISO-8859-10'},
+          {value => 'ISO-8859-13'},
+          {value => 'ISO-8859-14'},
+          {value => 'ISO-8859-15'},
+          {value => 'ISO-8859-16'},
           {value => 'US-ASCII'},
         ]},
-        {label => 'Asian charsets', options => [
+        {label => 'Greek charsets', options => [
+          {value => 'Windows-1253'},
+          {value => 'ISO-8859-7'},
+        ]},
+        {label => 'Cyrillic charsets', options => [
+          {value => 'Windows-1251'},
+          {value => 'ISO-8859-5'},
+        ]},
+        {label => 'Arabic charsets', options => [
+          {value => 'Windows-1256'},
+          {value => 'ISO-8859-6'},
+        ]},
+        {label => 'Hebrew charsets', options => [
+          {value => 'Windows-1255'},
+          {value => 'ISO-8859-8'},
+        ]},
+        {label => 'Thai charsets', options => [
           {value => 'Windows-874'},
           {value => 'ISO-8859-11'},
           {value => 'TIS-620'},
         ]},
+        {label => 'Chinese charsets', options => [
+          {value => 'Big5'},
+          {value => 'x-x-big5'},
+          {value => 'Big5-HKSCS'},
+          {value => 'GBK'},
+          {value => 'GB2312'},
+          {value => 'GB_2312-80'},
+          {value => 'ISO-2022-CN'},
+          {value => 'ISO-2022-CN-EXT'},
+        ]},
+        {label => 'Korean charsets', options => [
+          {value => 'Windows-949'},
+          {value => 'EUC-KR'},
+          {value => 'KS_C_5601-1987'},
+          {value => 'ISO-2022-KR'},
+        ]},
         {label => 'Unicode charsets', options => [
           {value => 'UTF-8'},
           {value => 'UTF-8n'},
-        ]},
+          {value => 'UTF-16'}, 
+          {value => 'UTF-16BE'},
+          {value => 'UTF-16LE'},
+       ]},
       ], name => 'charset',
       selected => scalar $cgi->get_parameter ('charset'));
       $out->end_tag ('label');
@@ -597,7 +666,7 @@
       $out->end_tag ('label');
     }
 
-    $out->html (q[</div></div>]);
+    $out->{handle}->print (q[</div></div>]);
   }; # $options
 
   $out->start_section (id => 'input', title => 'Input');