Changeset 22828 for src

Timestamp:

10/30/08 17:59:32 (2 months ago)

Author:

azawawi

Message:

[STD_syntax_highlight] main(ARGV) refactoring

Files:

• src/perl6/STD_syntax_highlight (modified) (10 diffs)

src/perl6/STD_syntax_highlight

@@ -16 +16 @@
 use DumpMatch;
 
-# These are needed for redspan
+=head1 NAME
+
+STD_syntax_highlight - Highlights Perl 6 source code using STD.pm
+
+=head1 SYNOPSIS
+
+    # print html output with inlined resources for 'comp_unit'
+    STD_syntax_highlight foo.pl
+
+    # print separate html, css and javascript files
+    STD_syntax_highlight --clean-html foo.pl
+
+    # print html for with 'statementlist' as the top-level rule
+    STD_syntax_highlight foo.pl statementlist
+
+    # write only simple html/css to simple.html
+    STD_syntax_highlight --simple-html=foo.simple.html foo.pl
+
+    # write redspans output to foo.redspans.html
+    STD_syntax_highlight --redspans-html=foo.redspans.html foo.pl
+
+=head1 SUBROUTINES
+
+=over
+
+=cut
+
+my ($clean_html,$help) = (0,0);
+my ($simple_html,$full_html,$redspans_html) = (0,0,'-');
+my ($file, $parser, $src_text); 
+
+# These are needed for redspans
 $::ACTIONS = 'Actions';
 my @loc;
 
-=head1 NAME
-
-STD_syntax_highlight - Highlights Perl 6 source code using STD.pm
-
-=head1 SYNOPSIS
-
-    # print html output with inlined resources for 'comp_unit'
-    STD_syntax_highlight foo.pl
-
-    # print separate html, css and javascript files
-    STD_syntax_highlight --clean-html foo.pl
-
-    # print html for with 'statementlist' as the top-level rule
-    STD_syntax_highlight foo.pl statementlist
-
-    # write only simple html/css to simple.html
-    STD_syntax_highlight --simple-html=foo.simple.html foo.pl
-
-    # write redspans output to foo.redspans.html
-    STD_syntax_highlight --redspans-html=foo.redspans.html foo.pl
-
-=head1 SUBROUTINES
-
-=over
-
-=cut
-
-#process the command line
-my ($clean_html,$help) = (0,0);
-my ($simple_html,$full_html,$redspans_html) = (0,0,'-');
-GetOptions(
-    "clean-html"=>\$clean_html,
-    "simple-html=s"=>\$simple_html,
-    "full-html=s"=>\$full_html,
-    "redspans-html=s"=>\$redspans_html,
-    "help"=>\$help
-);
-
-if ($#ARGV < 0 || $help) {
-    die <<"HELP";
+=item main
+
+Your standard main method
+=cut
+sub main {
+    
+    #process the command line
+    GetOptions(
+        "clean-html"=>\$clean_html,
+        "simple-html=s"=>\$simple_html,
+        "full-html=s"=>\$full_html,
+        "redspans-html=s"=>\$redspans_html,
+        "help"=>\$help
+    );
+
+    if ($#ARGV < 0 || $help) {
+        die <<"HELP";
 USAGE: 
     $PROGRAM_NAME [options] filename [rule]
@@ -78 +86 @@
     
 HELP
-}
-
-#start parsing...
-my $file = shift;
-my $what = shift // 'comp_unit';
-
-unless(-r $file) {
-    die "Could not open '$file' for reading\n";
-}
-
-# slurp the file for redspans
-my $txt = read_file($file);
-$loc[length($txt) - 1] = [];
-
-my $r = STD->parsefile($file,$what);
+    }
+
+    #start parsing...
+    $file = shift @ARGV;
+    my $what = shift @ARGV // 'comp_unit';
+
+    unless(-r $file) {
+        die "Could not open '$file' for reading\n";
+    }
+
+    # slurp the file for redspans
+    $src_text = read_file($file);
+    $loc[length($src_text) - 1] = [];
+
+    $parser = STD->parsefile($file,$what);
+
+    # and finally print out the html code
+    highlight_match($what=>$parser,{});
+}
 
 =item write_html_file
@@ -124 +136 @@
     if($simple_html) {
         traverse_match($r,$name,0,$events,$opt);
-        my $html = highlight_perl6_simple($::ORIG,$events,$opt);
+        my $html = highlight_perl6_simple($r,$::ORIG,$events,$opt);
         write_html_file $simple_html, $html;
     }
     if($full_html) {
         traverse_match($r,$name,0,$events,$opt);
-        my $html = highlight_perl6($::ORIG,$events,$opt);
+        my $html = highlight_perl6_full($r,$::ORIG,$events,$opt);
         write_html_file $full_html, $html;
     }
@@ -138 +150 @@
 }
 
-=item highlight_perl6
+=item highlight_perl6_full
 
 Generates the Perl6 highlighted HTML string for STD parse tree provided. 
 The resources can be inlined (by default) or externalized (--clean-html). 
 =cut
-sub highlight_perl6 {
-    my ($orig,$events,$opt) = @_;
+sub highlight_perl6_full {
+    my ($r,$orig,$events,$opt,$file) = @ARG,
     my $str = "";
     my $at = 0;
@@ -204 +216 @@
 
         if($curr_rule eq 'identifier') {
-            if($r->is_type($text)) {
+            if($parser->is_type($text)) {
                 $str .= qq{<span class="_type">$esc_text</span>};
-            } elsif($r->is_routine($text)) {
+            } elsif($parser->is_routine($text)) {
                 $str .= qq{<span class="_routine">$esc_text</span>};
             } else {
@@ -239 +251 @@
 =cut
 sub highlight_perl6_simple {
-    my ($orig,$events,$opt) = @_;
+    my ($orig,$events,$opt) = @ARG;
     my $str = "";
     my $at = 0;
@@ -292 +304 @@
         # process types, routines and identifiers
         if($curr_rule eq 'identifier') {
-            if($r->is_type($text)) {
+            if($parser->is_type($text)) {
                 $code .= qq{<span class="_type">$esc_text</span>};
-            } elsif($r->is_routine($text)) {
+            } elsif($parser->is_routine($text)) {
                 $code .= qq{<span class="_routine">$esc_text</span>};
             } else {
@@ -378 +390 @@
     for my $i (0 .. @loc-1) {
         say("Undefined $i"),next unless defined $loc[$i];
-        my $c = substr($txt,$i,1);
+        my $c = substr($src_text,$i,1);
         my $tree = "@{$loc[$i]}";
         if($tree ne $last_tree) {
@@ -415 +427 @@
 ###################################################################
 # R E D S P A N S
-my @locs;
 { 
     package Actions;
@@ -473 +484 @@
 =cut
 
-# and finally print out the html code
-highlight_match($what=>$r,{});
-
+main @ARGV;