Changeset 22822 for src

Show
Ignore:
Timestamp:
10/29/08 21:51:53 (2 months ago)
Author:
azawawi
Message:

[STD_syntax_highlight] redspan is implemented but the output is not colored yet

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • src/perl6/STD_syntax_highlight

    r22821 r22822  
    1515use DumpMatch; 
    1616 
     17# These are needed for redspan 
     18$::ACTIONS = 'Actions'; 
     19my @loc; 
     20 
    1721=head1 NAME 
    1822 
    … …  
    3539    # write redspans output to foo.redspans.html 
    3640    STD_syntax_highlight --redspans-html=foo.redspans.html foo.pl 
     41 
    3742=head1 SUBROUTINES 
    3843 
    … …  
    4348#process the command line 
    4449my ($clean_html,$help) = (0,0); 
    45 my ($simple_html,$full_html,$redspans_html) = (0,'-',0); 
     50my ($simple_html,$full_html,$redspans_html) = (0,0,'-'); 
    4651GetOptions( 
    4752    "clean-html"=>\$clean_html, 
    … …  
    6671 
    6772    --full-html=filename    
    68         write full-mode html to filename (enabled by default, - for STDOUT) 
     73        write full-mode html to filename (disabled by default, - for STDOUT) 
    6974  
    7075    --redspans-html=filename    
    … …  
    8287} 
    8388 
     89# slurp the file for redspans 
     90my $txt = read_file($file); 
     91$loc[length($txt) - 1] = []; 
     92 
    8493my $r = STD->parsefile($file,$what); 
    8594 
    … …  
    95104    my $opt = shift || {}; 
    96105    my $events = []; 
    97     traverse_match($r,$name,0,$events,$opt); 
     106 
    98107    if($simple_html) { 
     108        traverse_match($r,$name,0,$events,$opt); 
    99109        my $output = highlight_perl6_simple(${$r->{_orig}},$events,$opt); 
    100110        if($simple_html eq '-') { 
    … …  
    108118    } 
    109119    if($full_html) { 
     120        traverse_match($r,$name,0,$events,$opt); 
    110121        my $output = highlight_perl6(${$r->{_orig}},$events,$opt); 
    111122        if($full_html eq '-') { 
    … …  
    235246    my $str = ""; 
    236247    my $at = 0; 
    237     my $color = ''; 
    238248    my %colors = (); 
    239249 
    … …  
    328338sub highlight_perl6_redspans { 
    329339   # my ($orig,$events,$opt) = @_; 
    330 } 
     340    my $str = ""; 
     341    my %colors = (); 
     342 
     343    my $CSS = "STD_syntax_highlight.css"; 
     344    open CSS_FILE, $CSS 
     345        or die "Could not open $CSS: $OS_ERROR\n"; 
     346    my $line; 
     347    my $css_class; 
     348    while($line = <CSS_FILE>) { 
     349        if($line =~ /^\s*\.(\w+)/) { 
     350            $css_class = $1; 
     351        } elsif($line =~ /^#\w+/) { 
     352            # ignore #elem colors 
     353            $css_class = 0; 
     354        } elsif($line =~ /color\s*:\s*(\w+)/) { 
     355            $colors{$css_class} = $1 if $css_class; 
     356        } 
     357    } 
     358    close CSS_FILE; 
     359 
     360    # slurp libraries and javascript to inline them 
     361    my $css = qq{<link href="../$CSS" rel="stylesheet" type="text/css">}; 
     362    if(!$clean_html) { 
     363        $css = read_file($CSS) 
     364            or die "Error while slurping file: $OS_ERROR\n"; 
     365        $css = qq{<style type="text/css">\n$css\n</style>}; 
     366    } 
     367 
     368    my $timestamp = localtime; 
     369    $str .= <<"HTML"; 
     370<html> 
     371<head> 
     372    <title>$file</title> 
     373<!-- 
     374     Generated by $PROGRAM_NAME at $timestamp 
     375--> 
     376    $css 
     377</head> 
     378<body> 
     379    <pre> 
     380HTML 
     381 
     382    my ($last_tree,$buffer) = ("",""); 
     383    for my $i (0 .. @loc-1) { 
     384        say("Undefined $i"),next unless defined $loc[$i]; 
     385        my $c = substr($txt,$i,1); 
     386        my $tree = "@{$loc[$i]}"; 
     387        if($tree ne $last_tree) { 
     388            $str .= "\n'$buffer'\n$last_tree\n" if $buffer ne ''; 
     389            $buffer = $c; 
     390        } else { 
     391            $buffer .= $c; 
     392        } 
     393        $last_tree = $tree; 
     394    } 
     395     
     396    $str .= <<"HTML"; 
     397    </pre> 
     398</body> 
     399</html> 
     400HTML 
     401 
     402   $str; 
     403} 
     404 
     405################################################################### 
     406# R E D S P A N S 
     407my @locs; 
     408{  
     409    package Actions; 
     410 
     411    our $AUTOLOAD; 
     412 
     413    sub AUTOLOAD { 
     414        my $self = shift; 
     415        my $C = shift; 
     416        my $F = $C->{_from}; 
     417        my $P = $C->{_pos}; 
     418        $AUTOLOAD =~ s/^Actions:://; 
     419        $loc[$P] = [] if $loc[$P];      # in case we backtracked to here 
     420        for ($F..$P-1) { 
     421            unshift @{$loc[$_]}, $AUTOLOAD; 
     422        } 
     423    } 
     424 
     425    sub stdstopper { } 
     426    sub terminator { } 
     427    sub unitstopper { } 
     428    sub comp_unit { } 
     429} 
     430 
    331431 
    332432=item escape_html