From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

#!/usr/bin/perl
use Parse;
$x = new Parse;
$col=0;
$lmargin=5;
if($ENV{COLUMNS}) {
$width = $ENV{COLUMNS}-4;
} else {
$width = 75;
}
sub output_flow {
my(@out) = @_;
if($col<$lmargin) {
print " " x ($lmargin-$col);
$col=$lmargin;
}
foreach(@out) {
next if !length;
if((length($_) + $col) > $width) {
print "\n";
print " " x $lmargin;
$col = $lmargin;
}
$col += length($_);
if($bold) {
s/(\S)/$1\x08$1/g;
} elsif($underline) {
s/(\S)/$1\x08_/g;
}
print $_;
}
}
sub output_verb {
my($text,$indent) = @_;
if( $col < $indent ) {
print " " x ($indent-$col);
$col=$indent;
}
$text =~ s/\n/ "\n" .(" " x $indent)/ges;
$text =~ s/ +$//;
print $text;
$col = length($text)-rindex($text,"\n")-1;
}
sub flowed {
my($out);
foreach $i (@_) {
if(ref $i eq "ARRAY") {
my(@i) = (@$i);
my($c) = shift @i;
if($c eq "X" or $c eq "R") {
flowed(@{$i[0]});
} elsif( $c eq "E" ) {
output_flow($Parse::Escape2ASCII{$i[0]});
} else {
$bold++ if $c eq "B";
$underline++ if $c eq "I";
flowed(@i);
$bold-- if $c eq "B";
$underline-- if $c eq "I";
}
} else {
output_flow(split(/(\S+\s*)/,$i));
}
}
}
@listtype=();
$idx=0;
sub doindex {
foreach (@_) {
if(ref $_ eq "ARRAY") {
my(@i) = @$_;
my($i) = shift @i;
if( $i eq "X") {
shift @i; # discard printable block
$idx++;
$name = join("/",@{$i[0]});
$name =~ s/([^A-Za-z0-9_])/ "%".sprintf("%.2X",ord($1)) /ge;
foreach (@i) {
$idx{join("/",@$_)} = [$name,$idx,"perlvar.pod"];
}
#print "Index: ",Parse::dumpout([@i]),"\n";
} else {
doindex(@i);
}
}
}
}
# See if the column is too far over for the specified left margin
# equivalent in uglieness and rationale to TeX's "slug".
sub check_slug {
if( $col > $lmargin) {
output_flow("[]");
}
}
sub dump2 {
my($par,$line,$pos,$cmd,$var1,$var2) = @_;
#print "cmd = $cmd\n";
if( $cmd eq "begin" ) {
if($var1 eq "list") {
$lmargin+=5;
$width-=5;
# unshift(@listtype,$var2);
# unshift(@listnum,1);
}
elsif($var1 eq "pod") {
}
}
elsif( $cmd eq "end" ) {
if($var1 eq "list") {
$lmargin-=5;
$width+=5;
# shift(@listtype);
# shift(@listnum);
}
elsif($var1 eq "pod") {
}
}
elsif( $cmd eq "item") {
$bold++;
if($var1->[0] eq "bullet") {
$lmargin-=3;
output_flow( "* " );
$lmargin+=3;
if(@$var2) {
flowed(@$var2);
print "\n\n";
$col=0;
}
} elsif($var1->[0] eq "number") {
$lmargin-=4;
output_flow( $var1->[1] . ". ");
$lmargin+=4;
if(@$var2) {
flowed(@$var2);
print "\n\n";
$col=0;
}
} else {
$lmargin-=5;
flowed(@$var2);
if( ($col-(5+2)) >= $lmargin) {
print "\n";
$col=0;
}
$lmargin+=5;
print "\n";
$col=0;
}
$bold--;
}
elsif( $cmd eq "head") {
#print "<HR><H$var1>", flowed(@$var2), "</H$var1>\n";
$underline++;
$lmargin -= 2;
check_slug;
flowed(@$var2);
$lmargin += 2;
$underline--;
print "\n\n";
$col=0;
}
elsif( $cmd eq "verb") {
check_slug;
output_verb($var1."\n\n",$lmargin+3);
}
elsif( $cmd eq "flow") {
check_slug;
flowed(@$var2);
print "\n\n";
$col=0;
}
}
$x->parse_from_file_by_name($ARGV[0] || "pod/perlvar.pod",\&dump2);
##write index
#foreach (sort keys %idx) {
# print join(" ",$_,@{$idx{$_}}),"\n";
#}
#
#dump2(@_) while(@_=splice(@results,0,6));