Bug #71136 for Syntax-Highlight-Perl-Improved: Adding the ability to set a CODE reference within set_formats() rathern than a simple array ref.

The following patch extends the set_format() routine to allow you to pass CODE references in rather than the simple 2 element array reference. The CODE reference is executed and 3 variables are passed to it: Token Format Type Starting, Ending, or undef This allows you to write a routine to say, add HTML links, etc. within the returned, highlighted tokens.

--- /tmp/Improved.pm 2011-09-21 19:15:27.000000000 -0600 +++ /usr/local/lib/perl5/site_perl/5.8.9/Syntax/Highlight/Perl/Improved.pm 2011-09-21 21:20:19.000000000 -0600 @@ -1115,6 +1115,10 @@ are references to arrays containing the starting and ending formatting strings (in that order) for that format. +Optionally the value can also be a code reference which will be executed and returned. The code +reference will receive 3 variables, the first being the token name, the second being the format +name and the third being the word 'start' or 'end' to indicate were the parser is in it's process + =cut sub set_format { @@ -1123,9 +1127,12 @@ my %tmphash = ref($_[0]) ? %{$_[0]} : @_; foreach(keys %tmphash) { - @{$self->{'Formats'}{$_}}[0 .. $#{$tmphash{$_}}] = @{$tmphash{$_}}[0 .. $#{$tmphash{$_}}]; + if(ref($tmphash{$_}) eq 'CODE'){ + $self->{'Formats'}->{$_ } = $tmphash{$_}; + } else { + @{$self->{'Formats'}{$_}}[0 .. $#{$tmphash{$_}}] = @{$tmphash{$_}}[0 .. $#{$tmphash{$_}}]; + } } - } @@ -1161,6 +1168,10 @@ foreach my $format (@_) { $format_id .= '_' if($format_id ne ''); $format_id .= $format; + if(ref($self->{'Formats'}{$format_id}) eq 'CODE'){ + return $self->{'Formats'}{$format_id}->(undef, $format_id, 'start'); + } + return $self->{'Formats'}{$format_id}[0] if(exists $self->{'Formats'}{$format_id}); } @@ -1171,12 +1182,21 @@ # look for 'Scalar' first, then 'Variable'. # foreach my $i (-$#_ .. 0) { + if(ref($self->{'Formats'}{$_[$i]}) eq 'CODE'){ + return $self->{'Formats'}{$_[$i]}->(undef, $format_id, 'start'); + } + return $self->{'Formats'}{$_[$i]}[0] if(exists $self->{'Formats'}{$_[$i]}); } # # Otherwise, return the DEFAULT. # + + if(ref($self->{'Formats'}{'DEFAULT'}) eq 'CODE'){ + return $self->{'Formats'}{'DEFAULT'}->(undef, 'DEFAULT', 'start'); + } + return $self->{'Formats'}{'DEFAULT'}[0]; } @@ -1204,6 +1224,10 @@ foreach my $format (@_) { $format_id .= '_' if($format_id ne ''); $format_id .= $format; + if(ref($self->{'Formats'}{$format_id}) eq 'CODE'){ + return $self->{'Formats'}{$format_id}->(undef, $format_id, 'end'); + } + return $self->{'Formats'}{$format_id}[1] if(exists $self->{'Formats'}{$format_id}); } @@ -1214,12 +1238,20 @@ # look for 'Scalar' first, then 'Variable'. # for my $i (-$#_ .. 0) { + if(ref($self->{'Formats'}{$_[$i]}) eq 'CODE'){ + return $self->{'Formats'}{$_[$i]}->(undef, $format_id, 'end'); + } + return $self->{'Formats'}{$_[$i]}[1] if(exists $self->{'Formats'}{$_[$i]}); } # # Otherwise, return the DEFAULT. # + if(ref($self->{'Formats'}{'DEFAULT'}) eq 'CODE'){ + return $self->{'Formats'}{'DEFAULT'}->(undef, 'DEFAULT', 'end'); + } + return $self->{'Formats'}{'DEFAULT'}[1]; } @@ -1385,6 +1417,11 @@ my $ra_formats = undef; # + # Store the format type in case of CODE based ra_format + # -cfaber + my $frm; + + # # Prefer the names joined by an underscore from most general to least. # For example, the parameters: # 'Identifier', 'Variable', 'Scalar' @@ -1396,6 +1433,7 @@ $format_id .= $format; if(exists $self->{'Formats'}{$format_id}) { $ra_formats = $self->{'Formats'}{$format_id}; + $frm = $format_id; last; } } @@ -1410,6 +1448,7 @@ foreach my $i (-$#_ .. 0) { if(exists $self->{'Formats'}{$_[$i]}) { $ra_formats = $self->{'Formats'}{$_[$i]}; + $frm = $_[$i]; last; } } @@ -1420,6 +1459,12 @@ # unless(defined $ra_formats) { $ra_formats = $self->{'Formats'}{'DEFAULT'}; + $frm = 'DEFAULT'; + } + + + if(ref($ra_formats) eq 'CODE'){ + return $ra_formats->($token, $frm); } return $ra_formats->[0] . $token . $ra_formats->[1];