#!/usr/bin/perl
$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
;
$idx
++;
$name
=
join
(
"/"
,@{
$i
[0]});
$name
=~ s/([^A-Za-z0-9_])/
"%"
.
sprintf
(
"%.2X"
,
ord
($1)) /ge;
foreach
(
@i
) {
$idx
{
join
(
"/"
,
@$_
)} = [
$name
,
$idx
,
"perlvar.pod"
];
}
}
else
{
doindex(
@i
);
}
}
}
}
sub
check_slug {
if
(
$col
>
$lmargin
) {
output_flow(
"[]"
);
}
}
sub
dump2 {
my
(
$par
,
$line
,
$pos
,
$cmd
,
$var1
,
$var2
) =
@_
;
if
(
$cmd
eq
"begin"
) {
if
(
$var1
eq
"list"
) {
$lmargin
+=5;
$width
-=5;
}
elsif
(
$var1
eq
"pod"
) {
}
}
elsif
(
$cmd
eq
"end"
) {
if
(
$var1
eq
"list"
) {
$lmargin
-=5;
$width
+=5;
}
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"
) {
$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
);