/[suikacvs]/test/html-webhacc/WebHACC/Output.pm
Suika

Diff of /test/html-webhacc/WebHACC/Output.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by wakaba, Sun Jul 20 16:53:10 2008 UTC revision 1.3 by wakaba, Mon Jul 21 05:24:32 2008 UTC
# Line 1  Line 1 
1  package WebHACC::Output;  package WebHACC::Output;
2  use strict;  use strict;
3    
4  require IO::Handle;  require IO::Handle;
5    use Scalar::Util qw/refaddr/;
6    
7  my $htescape = sub ($) {  my $htescape = sub ($) {
8    my $s = $_[0];    my $s = $_[0];
# Line 113  sub end_code_block ($) { Line 115  sub end_code_block ($) {
115    shift->html ('</code></pre>');    shift->html ('</code></pre>');
116  } # end_code_block  } # end_code_block
117    
118  sub code ($$) {  sub code ($$;%) {
119    shift->html ('<code>' . $htescape->(shift) . '</code>');    my ($self, $content, %opt) = @_;
120      $self->start_tag ('code', %opt);
121      $self->text ($content);
122      $self->html ('</code>');
123  } # code  } # code
124    
125    sub script ($$;%) {
126      my ($self, $content, %opt) = @_;
127      $self->start_tag ('script', %opt);
128      $self->html ($content);
129      $self->html ('</script>');
130    } # script
131    
132    sub dt ($$;%) {
133      my ($self, $content, %opt) = @_;
134      $self->start_tag ('dt', %opt);
135      $self->text ($content);
136    } # dt
137    
138  sub link ($$%) {  sub link ($$%) {
139    my ($self, $content, %opt) = @_;    my ($self, $content, %opt) = @_;
140    $self->start_tag ('a', %opt, href => $opt{url});    $self->start_tag ('a', %opt, href => $opt{url});
# Line 137  sub link_to_webhacc ($$%) { Line 155  sub link_to_webhacc ($$%) {
155    $self->link ($content, %opt);    $self->link ($content, %opt);
156  } # link_to_webhacc  } # link_to_webhacc
157    
158    
159    my $get_node_path = sub ($) {
160      my $node = shift;
161      my @r;
162      while (defined $node) {
163        my $rs;
164        if ($node->node_type == 1) {
165          $rs = $node->node_name;
166          $node = $node->parent_node;
167        } elsif ($node->node_type == 2) {
168          $rs = '@' . $node->node_name;
169          $node = $node->owner_element;
170        } elsif ($node->node_type == 3) {
171          $rs = '"' . $node->data . '"';
172          $node = $node->parent_node;
173        } elsif ($node->node_type == 9) {
174          @r = ('') unless @r;
175          $rs = '';
176          $node = $node->parent_node;
177        } else {
178          $rs = '#' . $node->node_type;
179          $node = $node->parent_node;
180        }
181        unshift @r, $rs;
182      }
183      return join '/', @r;
184    }; # $get_node_path
185    
186    sub node_link ($$) {
187      my ($self, $node) = @_;
188      $self->xref ($get_node_path->($node), target => 'node-' . refaddr $node);
189    } # node_link
190    
191  sub nav_list ($) {  sub nav_list ($) {
192    my $self = shift;    my $self = shift;
193    $self->html (q[<ul class="navigation" id="nav-items">]);    $self->html (q[<ul class="navigation" id="nav-items">]);
194    for (@{$self->{nav}}) {    for (@{$self->{nav}}) {
195      $self->html (qq[<li><a href="@{[$htescape->($_->[0])]}">@{[$htescape->($_->[1])]}</a>]);      $self->html (qq[<li><a href="#@{[$htescape->($_->[0])]}">@{[$htescape->($_->[1])]}</a>]);
196    }    }
197    $self->html ('</ul>');    $self->html ('</ul>');
198  } # nav_list  } # nav_list
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24