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

Diff of /test/html-webhacc/WebHACC/Language/DOM.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 08:39:12 2008 UTC
# Line 10  sub generate_structure_dump_section ($) Line 10  sub generate_structure_dump_section ($)
10        
11    my $out = $self->output;    my $out = $self->output;
12    
13    $out->start_section (id => 'document-tree', title => 'Document Tree',    $out->start_section (role => 'tree');
                        short_title => 'Tree');  
14    
15    $out->start_tag ('ol', class => 'xoxo');    $out->start_tag ('ol', class => 'xoxo');
16    
# Line 158  sub generate_structure_error_section ($) Line 157  sub generate_structure_error_section ($)
157    my $self = shift;    my $self = shift;
158        
159    my $out = $self->output;    my $out = $self->output;
160    $out->start_section (id => 'document-errors', title => 'Document Errors');    $out->start_section (role => 'structure-errors');
161    $out->start_tag ('dl', class => 'document-errors-list');    $out->start_error_list (role => 'structure-errors');
162    
163    my $input = $self->input;    my $input = $self->input;
164    my $result = $self->result;    my $result = $self->result;
# Line 178  sub generate_structure_error_section ($) Line 177  sub generate_structure_error_section ($)
177          ($self->{structure}, $onerror, $onsubdoc);          ($self->{structure}, $onerror, $onsubdoc);
178    }    }
179    
180    $out->end_tag ('dl');    $out->end_error_list (role => 'structure-errors');
   $out->html (qq[<script>  
     addSourceToParseErrorList ('@{[$input->id_prefix]}', 'document-errors-list');  
   </script>]);  
181    $out->end_section;    $out->end_section;
182  } # generate_structure_error_section  } # generate_structure_error_section
183    
184    sub generate_additional_sections ($) {
185      my $self = shift;
186      $self->SUPER::generate_additional_sections;
187      $self->generate_table_section;
188    } # generate_additional_sections
189    
190    sub generate_table_section ($) {
191      my $self = shift;
192    
193      my $tables = $self->{add_info}->{table} || [];
194      return unless @$tables;
195    
196      my $out = $self->output;
197      $out->start_section (id => 'tables', title => 'Tables');
198    
199      $out->html (q[<!--[if IE]><script type="text/javascript" src="../excanvas.js"></script><![endif]-->
200    <script src="../table-script.js" type="text/javascript"></script>
201    <noscript>
202    <p><em>Structure of tables are visualized here if scripting is enabled.</em></p>
203    </noscript>]);
204      
205      require JSON;
206      
207      my $i = 0;
208      for my $table (@$tables) {
209        $i++;
210        $out->start_section (id => 'table-' . $i,
211                             title => 'Table #' . $i);
212    
213        $out->start_tag ('dl');
214        $out->dt ('Table Element');
215        $out->start_tag ('dd');
216        $out->node_link ($table->{element});
217        $out->end_tag ('dl');
218        delete $table->{element};
219    
220        for (@{$table->{column_group}}, @{$table->{column}}, $table->{caption},
221             @{$table->{row}}) {
222          next unless $_;
223          delete $_->{element};
224        }
225        
226        for (@{$table->{row_group}}) {
227          next unless $_;
228          next unless $_->{element};
229          $_->{type} = $_->{element}->manakai_local_name;
230          delete $_->{element};
231        }
232        
233        for (@{$table->{cell}}) {
234          next unless $_;
235          for (@{$_}) {
236            next unless $_;
237            for (@$_) {
238              $_->{id} = refaddr $_->{element} if defined $_->{element};
239              delete $_->{element};
240              $_->{is_header} = $_->{is_header} ? 1 : 0;
241            }
242          }
243        }
244    
245        my $id_prefix = $self->input->id_prefix;
246        $out->script (q[tableToCanvas (] .
247            JSON::objToJson ($table) .
248            q[, document.getElementById ('] . $id_prefix . 'table-' . $i . q[')] .
249            q[, '] . $id_prefix . q[');]);
250    
251        $out->end_section;
252      }
253    
254      $out->end_section;
255    } # print_table_section
256    
257    sub print_listing_section ($$$) {
258      my ($opt, $input, $ids) = @_;
259      
260    #  push @nav, ['#' . $input->{id_prefix} . $opt->{id} => $opt->{label}]
261    #      unless $input->{nested};
262      print STDOUT qq[
263    <div id="$input->{id_prefix}$opt->{id}" class="section">
264    <h2>$opt->{heading}</h2>
265    
266    <dl>
267    ];
268      for my $id (sort {$a cmp $b} keys %$ids) {
269        print STDOUT qq[<dt><code>@{[htescape $id]}</code></dt>];
270        for (@{$ids->{$id}}) {
271          print STDOUT qq[<dd>].get_node_link ($input, $_).qq[</dd>];
272        }
273      }
274      print STDOUT qq[</dl></div>];
275    } # print_listing_section
276    
277    
278    sub print_rdf_section ($$$) {
279      my ($input, $rdfs) = @_;
280      
281    #  push @nav, ['#' . $input->{id_prefix} . 'rdf' => 'RDF']
282    #      unless $input->{nested};
283      print STDOUT qq[
284    <div id="$input->{id_prefix}rdf" class="section">
285    <h2>RDF Triples</h2>
286    
287    <dl>];
288      my $i = 0;
289      for my $rdf (@$rdfs) {
290        print STDOUT qq[<dt id="$input->{id_prefix}rdf-@{[$i++]}">];
291        print STDOUT get_node_link ($input, $rdf->[0]);
292        print STDOUT qq[<dd><dl>];
293        for my $triple (@{$rdf->[1]}) {
294          print STDOUT '<dt>' . get_node_link ($input, $triple->[0]) . '<dd>';
295          print STDOUT get_rdf_resource_html ($triple->[1]);
296          print STDOUT ' ';
297          print STDOUT get_rdf_resource_html ($triple->[2]);
298          print STDOUT ' ';
299          print STDOUT get_rdf_resource_html ($triple->[3]);
300        }
301        print STDOUT qq[</dl>];
302      }
303      print STDOUT qq[</dl></div>];
304    } # print_rdf_section
305    
306    sub get_rdf_resource_html ($) {
307      my $resource = shift;
308      if (defined $resource->{uri}) {
309        my $euri = htescape ($resource->{uri});
310        return '<code class=uri>&lt;<a href="' . $euri . '">' . $euri .
311            '</a>></code>';
312      } elsif (defined $resource->{bnodeid}) {
313        return htescape ('_:' . $resource->{bnodeid});
314      } elsif ($resource->{nodes}) {
315        return '(rdf:XMLLiteral)';
316      } elsif (defined $resource->{value}) {
317        my $elang = htescape (defined $resource->{language}
318                                  ? $resource->{language} : '');
319        my $r = qq[<q lang="$elang">] . htescape ($resource->{value}) . '</q>';
320        if (defined $resource->{datatype}) {
321          my $euri = htescape ($resource->{datatype});
322          $r .= '^^<code class=uri>&lt;<a href="' . $euri . '">' . $euri .
323              '</a>></code>';
324        } elsif (length $resource->{language}) {
325          $r .= '@' . htescape ($resource->{language});
326        }
327        return $r;
328      } else {
329        return '??';
330      }
331    } # get_rdf_resource_html
332    
333  1;  1;
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24