[svn:parrot] r36060 - trunk/languages/pod/src/parser

Author: kjs
Date: Tue Jan 27 11:49:16 2009
New Revision: 36060

Modified:
   trunk/languages/pod/src/parser/actions.pm
   trunk/languages/pod/src/parser/grammar.pg

Log:
[pod] implement some bits for languages/pod. Can't test, as no Makefile is generated on my box (windows; should it?)
Needs more work, but it's a start.

Modified: trunk/languages/pod/src/parser/actions.pm
==============================================================================
--- trunk/languages/pod/src/parser/actions.pm	(original)
+++ trunk/languages/pod/src/parser/actions.pm	Tue Jan 27 11:49:16 2009
@@ -18,6 +18,110 @@
 
 method TOP($/) {
     make $( $/ );
+    # for $<pod_section> {
+    #     $( $_  );
+    # }
+}
+
+method skipped($/) {
+
+}
+
+method pod_section($/) {
+    for $<pod_sequence> {
+        ## XXX store it where? A block?
+        $( $_ );
+    }
+}
+
+method pod_sequence($/, $key) {
+    make $( $/{$key} );
+}
+
+method pod_directive($/) {
+
+}
+
+method cut_directive($/) {
+
+}
+
+## XXX refactor the block_title stuff for heading and begin_directive.
+
+method heading($/) {
+    my $heading := Pod::DocTree::Heading.new();
+    ## set the level of the heading
+    $heading.level($<digit>);
+
+    if $<block_title> {
+        my $title := $( $<block_title>[0] );
+        $heading.title( $title.name() );
+    }
+    make $heading;
+}
+
+
+method begin_directive($/) {
+    my $block := Pod::DocTree::Block.new();
+    my $name  := $( $<block_name> );
+    $block.name( $name.name() );
+
+    if $<block_title> {
+        my $title := $( $<block_title>[0] );
+        $heading.title( $title.name() );
+    }
+    make $block;
+}
+
+method end_directive($/) {
+
+}
+method for_directive($/) {
+    # use same code as in begin-directive.
+}
+
+method over_directive($/) {
+
+}
+
+method back_directive($/) {
+
+}
+
+method item_directive($/) {
+    my $item := Pod::DocTree::Item.new();
+
+    make $item;
+}
+
+method encoding_directive($/) {
+
+}
+
+method paragraph($/) {
+
+}
+
+method literal_paragraph($/) {
+
+}
+
+method block_name($/) {
+    ## XXX fix: only match the non-whitespace text
+    make Pod::DocTree::Text.new( :name( $/ ) );
+}
+
+method block_title($/) {
+    make Pod::DocTree::Text.new( :name( $<formatted_text> ) );
+}
+
+method format_code($/) {
+
+}
+
+## XXX not sure if this needs action method is needed.
+method pod_ws($/) {
+
 }
 
 # Local Variables:

Modified: trunk/languages/pod/src/parser/grammar.pg
==============================================================================
--- trunk/languages/pod/src/parser/grammar.pg	(original)
+++ trunk/languages/pod/src/parser/grammar.pg	Tue Jan 27 11:49:16 2009
@@ -29,16 +29,16 @@
 }
 
 regex pod_sequence {
-      <heading>
-    | <begin_directive>
-    | <end_directive>
-    | <for_directive>
-    | <back_directive>
-    | <item_directive>
-    | <over_directive>
-    | <encoding_directive>
-    | <literal_paragraph>
-    | <paragraph>
+    | <heading>              #= heading
+    | <begin_directive>      #= begin_directive
+    | <end_directive>        #= end_directive
+    | <for_directive>        #= for_directive
+    | <back_directive>       #= back_directive
+    | <item_directive>       #= item_directive
+    | <over_directive>       #= over_directive
+    | <encoding_directive>   #= encoding_directive
+    | <literal_paragraph>    #= literal_paragraph
+    | <paragraph>            #= paragraph
 }
 
 token pod_directive {
@@ -164,8 +164,7 @@
     | <digit>
     | <punct>
     | <pod_ws>
-    ]+ 
-    {*}
+    ]+
 }
 
 regex format_code {
@@ -183,3 +182,10 @@
 }
 
 token blank_line { ^^ <.pod_ws>? \n }
+
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4: