Permalink
Browse files

Doing stuff

  • Loading branch information...
1 parent 35fdd02 commit a182bccf415c01f46b4f9cf12d3018581ef534d1 @flussence flussence committed Sep 26, 2011
Showing with 65 additions and 22 deletions.
  1. +65 −22 lib/Pod/To/HTML.pm
View
@@ -1,19 +1,77 @@
-module Pod::To::HTML;
+use v6;
+
+BEGIN { push @*INC, '../Pod-Tree-Walker/lib' }
use Text::Escape;
+use Pod::Tree::Walker;
+
+class Pod::To::HTML does Pod::Tree::Walker;
+
+has $.pod;
+
+has $.title = 'Pod Document';
+has $.body;
+has @.meta;
+has @.indexes;
+has @.footnotes;
+
+method write-to(IO $output) {
+ self.walk-pod-tree($!pod);
-# FIXME: this code's a horrible mess. It'd be really helpful to have a module providing a generic
-# way to walk a Pod tree and invoke callbacks on each node, that would reduce the multispaghetti at
-# the bottom to something much more readable.
+ $output.print(self.html-header);
+ $output.print(self.html-footer);
+
+ #$output.print(pod2html($!pod));
+}
+
+method html-header returns Str {
+ my Str $html-title = escape_html($!title // 'Pod Document');
+ my Str $meta-tags = self.stringify-metadata;
+
+ # TODO: use qq:to""
+ return qq'
+ <!doctype html>
+ <html>
+ <head>
+ <meta charset="UTF-8" />
+ <title>{$html-title}</title>
+ <style>
+ /* code things -
+ code gets the browser-default font
+ kbd gets a slightly less common monospace font
+ samp gets the hard pixelly fonts
+ */
+ kbd \{ font-family: "Droid Sans Mono", "Luxi Mono", "Inconsolata", monospace }
+ samp \{ font-family: "Terminus", "Courier", "Lucida Console", monospace }
+
+ /* footnote things */
+ aside \{ opacity: 0.7 }
+ a[id^="fn-"]:target \{ background: #ff0 }
+ </style>
+ <link rel="stylesheet" href="http://perlcabal.org/syn/perl.css">
+ {$meta-tags}
+ </head>
+ <body class="pod" id="___top">
+ ';
+}
+#= Returns accumulated metadata as a string of C«<meta>» tags
+method stringify-metadata returns Str {
+ return @!meta.map(-> $p {
+ qq[<meta name="{escape_html($p.key)}" value="{node2text($p.value)}" />]
+ }).join("\n");
+}
+
+method html-footer returns Str {
+ return "</body>\n</html>\n";
+}
+
+# OLD CODE BELOW
my $title;
my @meta;
my @indexes;
my @body;
my @footnotes;
- sub Debug(Callable $) { } # Disable debug code
-#sub Debug(Callable $c) { $c() } # Enable debug code
-
#= Converts a Pod tree to a HTML document.
sub pod2html($pod) is export returns Str {
@body.push: node2html($pod);
@@ -122,7 +180,6 @@ sub do-footnotes returns Str {
}
sub twine2text($twine) returns Str {
- Debug { say "twine2text called for {$twine.perl}" };
return '' unless $twine.elems;
my $r = $twine[0];
for $twine[1..*] -> $f, $s {
@@ -134,7 +191,6 @@ sub twine2text($twine) returns Str {
#= block level or below
multi sub node2html($node) returns Str {
- Debug { say "Generic node2html called for {$node.perl}" };
return node2inline($node);
}
@@ -149,24 +205,20 @@ multi sub node2html(Pod::Block::Declarator $node) returns Str {
~ "\n</article>\n";
}
default {
- Debug { say "I don't know what {$node.WHEREFORE.perl} is" };
node2html([$node.WHEREFORE.perl, q{: }, $node.content]);
}
}
}
multi sub node2html(Pod::Block::Code $node) returns Str {
- Debug { say "Code node2html called for {$node.perl}" };
return '<pre>' ~ node2inline($node.content) ~ "</pre>\n"
}
multi sub node2html(Pod::Block::Comment $node) returns Str {
- Debug { say "Comment node2html called for {$node.perl}" };
return '';
}
multi sub node2html(Pod::Block::Named $node) returns Str {
- Debug { say "Named Block node2html called for {$node.perl}" };
given $node.name {
when 'config' { return '' }
when 'nested' { return '' }
@@ -197,12 +249,10 @@ multi sub node2html(Pod::Block::Named $node) returns Str {
}
multi sub node2html(Pod::Block::Para $node) returns Str {
- Debug { say "Para node2html called for {$node.perl}" };
return '<p>' ~ node2inline($node.content) ~ "</p>\n";
}
multi sub node2html(Pod::Block::Table $node) returns Str {
- Debug { say "Table node2html called for {$node.perl}" };
my @r = '<table>';
if $node.caption {
@@ -236,14 +286,12 @@ multi sub node2html(Pod::Block::Table $node) returns Str {
}
multi sub node2html(Pod::Config $node) returns Str {
- Debug { say "Config node2html called for {$node.perl}" };
return '';
}
# TODO: would like some way to wrap these and the following content in a <section>; this might be
# the same way we get lists working...
multi sub node2html(Pod::Heading $node) returns Str {
- Debug { say "Heading node2html called for {$node.perl}" };
my $lvl = min($node.level, 6); #= HTML only has 6 levels of numbered headings
my %escaped = (
uri => escape_uri(node2rawtext($node.content)),
@@ -260,7 +308,6 @@ multi sub node2html(Pod::Heading $node) returns Str {
# FIXME
multi sub node2html(Pod::Item $node) returns Str {
- Debug { say "List Item node2html called for {$node.perl}" };
return '<ul><li>' ~ node2html($node.content) ~ "</li></ul>";
}
@@ -275,7 +322,6 @@ multi sub node2html(Str $node) returns Str {
#= inline level or below
multi sub node2inline($node) returns Str {
- Debug { say "missing a node2inline multi for {$node.perl}" };
return node2text($node);
}
@@ -344,7 +390,6 @@ multi sub node2inline(Str $node) returns Str {
#= HTML-escaped text
multi sub node2text($node) returns Str {
- Debug { say "missing a node2text multi for {$node.perl}" };
return escape_html(node2rawtext($node));
}
@@ -365,12 +410,10 @@ multi sub node2text(Str $node) returns Str {
#= plain, unescaped text
multi sub node2rawtext($node) returns Str {
- Debug { say "Generic node2rawtext called with {$node.perl}" };
return $node.Str;
}
multi sub node2rawtext(Pod::Block $node) returns Str {
- Debug { say "node2rawtext called for {$node.perl}" };
return twine2text($node.content);
}

0 comments on commit a182bcc

Please sign in to comment.