Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Loading…

Pod6 improvements #177

Merged
merged 10 commits into from

2 participants

@timo
Collaborator

This is WIP, but it will give benefits right away, such as correctly working «...» as well as balanced formattingcodes like C< foo >.

It will also turn "output" blocks into preformatted blocks.

Things still missing:

formattingcodes really ought to use a nibbler and there needs to be a mechanism that applies formattingcodes after a whole paragraph is made, such as when building a table from multiple rows.

@moritz moritz merged commit ea59f98 into from
@timo timo deleted the branch
@timo timo restored the branch
@timo timo deleted the branch
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
This page is out of date. Refresh to see the latest.
View
29 lib/Pod/To/Text.pm
@@ -4,13 +4,20 @@ method render($pod) {
pod2text($pod)
}
+my &colored;
+if %*ENV<POD_TO_TEXT_ANSI> {
+ &colored = try { eval q{ use Term::ANSIColor; &colored } } // sub ($text, $color) { $text }
+} else {
+ &colored = sub ($text, $color) { $text }
+}
+
sub pod2text($pod) is export {
my @declarators;
given $pod {
when Pod::Heading { heading2text($pod) }
when Pod::Block::Code { code2text($pod) }
when Pod::Block::Named { named2text($pod) }
- when Pod::Block::Para { para2text($pod) }
+ when Pod::Block::Para { $pod.content.map({pod2text($_)}).join("") }
when Pod::Block::Table { table2text($pod) }
when Pod::Block::Declarator { declarator2text($pod) }
when Pod::Item { item2text($pod) }
@@ -107,8 +114,26 @@ sub signature2text($params) {
!! "()";
}
+my %formats = {
+ "C" => "bold",
+ "L" => "underline",
+ "D" => "underline",
+ "R" => "inverse"
+ };
+
+my %only_first_part = bag <D X L>;
+
sub formatting2text($pod) {
- twine2text($pod.content)
+ my $text = twine2text($pod.content);
+ if $pod.type ~~ %only_first_part {
+ if $text ~~ /'|'/ {
+ $text = $/.prematch
+ }
+ }
+ if $pod.type ~~ %formats {
+ return colored($text, %formats{$pod.type});
+ }
+ $text
}
sub twine2text($twine) {
View
30 src/Perl6/Actions.nqp
@@ -579,9 +579,39 @@ class Perl6::Actions is HLL::Actions does STDActions {
make Perl6::Pod::build_pod_string(@content);
}
+ method pod_balanced_braces($/) {
+ if $<endtag> {
+ my @content := [];
+ my @stringparts := [];
+ @stringparts.push(~$<start>);
+ if $<pod_string_character> {
+ for $<pod_string_character> {
+ if nqp::isstr($_.ast) {
+ @stringparts.push($_.ast);
+ } else {
+ @content.push(nqp::join("", @stringparts));
+ @stringparts := nqp::list();
+ @content.push($_.ast);
+ }
+ }
+ }
+ @stringparts.push(~$<endtag>);
+ @content.push(nqp::join("", @stringparts));
+ if +@content == 1 {
+ make @content[0];
+ } else {
+ make Perl6::Pod::build_pod_string(@content);
+ }
+ } else {
+ make ~$<braces>
+ }
+ }
+
method pod_string_character($/) {
if $<pod_formatting_code> {
make $<pod_formatting_code>.ast
+ } elsif $<pod_balanced_braces> {
+ make $<pod_balanced_braces>.ast
} else {
make ~$<char>;
}
View
67 src/Perl6/Grammar.nqp
@@ -533,10 +533,55 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
}
token pod_formatting_code {
+ :my $*POD_ALLOW_FCODES := nqp::getlexdyn('$*POD_ALLOW_FCODES');
+ :my $*POD_IN_FORMATTINGCODE := nqp::getlexdyn('$*POD_IN_FORMATTINGCODE');
+ :my $*POD_ANGLE_COUNT := nqp::getlexdyn('$*POD_ANGLE_COUNT');
+ <?{ $*POD_ALLOW_FCODES }>
+
+ :my $endtag;
$<code>=<[A..Z]>
- '<' { $*POD_IN_FORMATTINGCODE := 1 }
- $<content>=[ <!before '>'> <pod_string_character> ]+
- '>' { $*POD_IN_FORMATTINGCODE := 0 }
+ $<begin-tag>=['<'+ <!before '<'> | '«'] { $*POD_IN_FORMATTINGCODE := 1 }
+ <?{
+ my $codenum := nqp::ord($<code>.Str) - nqp::ord("A");
+ if !($*POD_ALLOW_FCODES +& (2 ** $codenum)) {
+ 0
+ } elsif ~$<begin-tag> eq '«' {
+ $endtag := "»";
+ $*POD_ANGLE_COUNT := -1;
+ 1
+ } else {
+ my $ct := nqp::chars($<begin-tag>);
+ $endtag := nqp::x(">", $ct);
+ my $rv := $*POD_ANGLE_COUNT == 0 || $*POD_ANGLE_COUNT >= $ct;
+ $*POD_ANGLE_COUNT := $ct;
+ $rv;
+ }
+ }>
+ {
+ if $<code>.Str eq "V" || $<code>.Str eq "C" {
+ $*POD_ALLOW_FCODES := 0;
+ }
+ }
+ $<content>=[ <pod_string_character> ]+?
+ $endtag
+ }
+
+ token pod_balanced_braces {
+ <?{ $*POD_IN_FORMATTINGCODE }>
+ :my $endtag;
+ [
+ $<braces>=['<'+ <!before '<'>||'>'+ <!before '>'>]
+ <?{ nqp::chars($<braces>) < $*POD_ANGLE_COUNT || $*POD_ANGLE_COUNT < 0 }>
+ ||
+ <?{ $*POD_ANGLE_COUNT >= 1 }>
+ $<start>=['<'+] <!before '<'>
+ <?{ nqp::chars($<start>) == $*POD_ANGLE_COUNT || $*POD_ANGLE_COUNT < 0 }>
+ {
+ $endtag := nqp::x(">", nqp::chars($<start>));
+ }
+ $<content>=[ <pod_string_character>*?]
+ <!after '>'> $<endtag>=[$endtag]
+ ]
}
token pod_string {
@@ -544,7 +589,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
}
token pod_string_character {
- <pod_formatting_code> || $<char>=[ \N || [
+ <pod_balanced_braces> || <pod_formatting_code> || $<char>=[ \N || [
<?{ $*POD_IN_FORMATTINGCODE == 1}> \n <!before \h* '=' \w>
]
]
@@ -584,6 +629,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
<pod_code_parent> { $*ALLOW_CODE := 1 }
|| <identifier>
]
+ :my $*POD_ALLOW_FCODES := nqp::getlexdyn('$*POD_ALLOW_FCODES');
<pod_configuration($<spaces>)> <pod_newline>+
[
<pod_content> *
@@ -597,6 +643,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
^^
$<spaces> = [ \h* ]
'=begin' \h+ 'table'
+ :my $*POD_ALLOW_FCODES := nqp::getlexdyn('$*POD_ALLOW_FCODES');
<pod_configuration($<spaces>)> <pod_newline>+
[
<table_row>*
@@ -631,6 +678,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
<pod_code_parent> { $*ALLOW_CODE := 1 }
|| <identifier>
]
+ :my $*POD_ALLOW_FCODES := nqp::getlexdyn('$*POD_ALLOW_FCODES');
<pod_configuration($<spaces>)> <pod_newline>
<pod_content=.pod_textcontent>**0..1
}
@@ -639,6 +687,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
^^
$<spaces> = [ \h* ]
'=for' \h+ $<type>=[ 'code' | 'comment' ]
+ :my $*POD_ALLOW_FCODES := nqp::getlexdyn('$*POD_ALLOW_FCODES');
<pod_configuration($<spaces>)> <pod_newline>
$<pod_content> = [ \h* <!before '=' \w> \N+ \n ]+
}
@@ -647,6 +696,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
^^
$<spaces> = [ \h* ]
'=for' \h+ 'table'
+ :my $*POD_ALLOW_FCODES := nqp::getlexdyn('$*POD_ALLOW_FCODES');
<pod_configuration($<spaces>)> <pod_newline>
[ <!before \h* \n> <table_row>]*
}
@@ -663,6 +713,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
<pod_code_parent> { $*ALLOW_CODE := 1 }
|| <identifier>
]
+ :my $*POD_ALLOW_FCODES := nqp::getlexdyn('$*POD_ALLOW_FCODES');
<pod_configuration($<spaces>)>
[\r\n|\s]
<pod_content=.pod_textcontent>**0..1
@@ -672,6 +723,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
^^
$<spaces> = [ \h* ]
'=' $<type>=[ 'code' | 'comment' ]
+ :my $*POD_ALLOW_FCODES := nqp::getlexdyn('$*POD_ALLOW_FCODES');
<pod_configuration($<spaces>)> [\r\n|\s]
$<pod_content> = [ \h* <!before '=' \w> \N+ \n ]*
}
@@ -679,6 +731,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
token pod_block:sym<abbreviated_table> {
^^
$<spaces> = [ \h* ]
+ :my $*POD_ALLOW_FCODES := nqp::getlexdyn('$*POD_ALLOW_FCODES');
'=table' <pod_configuration($<spaces>)> <pod_newline>
[ <!before \h* \n> <table_row>]*
}
@@ -688,7 +741,9 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
}
token pod_code_parent {
- 'pod' <!before \w> || 'item' \d* <!before \w>
+ || 'pod' <!before \w>
+ || 'output' <!before \w>
+ || 'item' \d* <!before \w>
# TODO: Also Semantic blocks one day
}
@@ -741,6 +796,8 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
:my $*VMARGIN := 0; # pod stuff
:my $*ALLOW_CODE := 0; # pod stuff
:my $*POD_IN_FORMATTINGCODE := 0; # pod stuff
+ :my $*POD_ALLOW_FCODES := 0b11111111111111111111111111; # allow which fcodes?
+ :my $*POD_ANGLE_COUNT := 0; # pod stuff
:my $*IN_REGEX_ASSERTION := 0;
:my $*SOFT := 0; # is the soft pragma in effect
:my $*IN_PROTO := 0; # are we inside a proto?
View
18 src/Perl6/Pod.nqp
@@ -100,6 +100,24 @@ class Perl6::Pod {
$val := $*W.add_constant('Int', 'int', $truth).compile_time_value;
}
+
+ if $key eq "allow" {
+ my $chars := nqp::chars($val);
+ my $pos := 0;
+ while $pos < $chars {
+ my $char := nqp::substr($val, $pos, 1);
+ if $char eq " " {
+ $pos := $pos + 1;
+ } else {
+ my $bitval := nqp::ord($char) - nqp::ord("A");
+ if $bitval >= 0 && $bitval <= 25 {
+ $*POD_ALLOW_FCODES := $*POD_ALLOW_FCODES +| (2 ** $bitval);
+ }
+ $pos := $pos + 2;
+ }
+ }
+ }
+
$key := $*W.add_constant('Str', 'str', $key).compile_time_value;
$val := $*W.add_constant('Str', 'str', $val).compile_time_value;
@pairs.push(
Something went wrong with that request. Please try again.