my $state = "limbo"; my @sections; my @sect_titles; my $sectno = 0; my $nodeno = 0; my @nodes; use strict; my %nodeparts; my %nodedefs; my %nodenames; my $data = do { local $/; <> }; $| = 1; # First pass while (length $data) { #print(substr($data,0,5)."\n"); if ($data =~ s/^(( [^\@]+| \@\@| \@[\:\.\^](.*?)@>\s*| \@!\@(.)(.*?)@>\s*| \@"[a-fA-F0-9]+| \@'[0-7]+| \@([\\\$+!\?;,\#\&\/\|])| \@([t=])(.*?)\@>| \@{(.*?)\@} )+)//sx) { $nodes[$nodeno]{$state} .= $1; } elsif ($data =~ s/^\@d\s*//s) { $state = "defs"; } elsif ($data =~ s/^\@\*\s*(.*?)\.\s*//s) { $state = "doc"; my $sectname = $1; $sectname =~ s/\\\[\d+\]\s*//; $sect_titles[++$sectno] = $sectname; print STDERR "[$sectno] "; ++$nodeno; $nodes[$nodeno]{title} = $sectname; $nodes[$nodeno]{sectno} = $sectno; } elsif ($data =~ s/^\@ \s*//s) { $state = "doc"; ++$nodeno; } elsif ($data =~ s/^\@p\s*//s) { $state = "pascal"; } elsif ($data =~ s/^\@f\s*//s) { $state = "format"; } elsif ($data =~ s/^\@<\s*([^@]+)\s*@>=//s) { my $nname = $1; if ($nname =~/\.\.\.$/) { $nname = resolve($nname); } $nodes[$nodeno]{defines} = $nname; $nname =~ s/\s+/ /gsm; #warn "Storing |$nname|"; push @{$nodeparts{$nname}}, $nodeno; $nodedefs{$nname} = $nodeno; $nodenames{$nname} = 1; $state = "pascal"; } elsif ($data =~ s/^(\@<\s*(.*?)\s*\@>)//s) { my $orig = $1; my $nname = $2; $nname =~ s/\s+/ /gsm; if ($nname =~/\.\.\.$/) { $nname = resolve($nname); } #warn "Storing |$nname|"; #push @{$nodeparts{$nname}}, $nodeno; $nodenames{$nname} = 1; $nodes[$nodeno]{$state} .= $orig; } else { die "Unparsable ". substr($data,0,25). " in node ".$nodeno; } } use Data::Dumper; print q{

}; for (1..$nodeno) { my $node = $nodes[$_]; next if ($node->{limbo}); if ($node->{title}) { print "{sectno}\">

$node->{title}

\n"; } print "

".$_." "; if ($node->{doc}) { print map "$_

\n", split /\n\n/, detex($node->{doc}); print "

"; } if ($node->{pascal}) { if ($node->{defines}) { print "".detex($node->{defines})." =
"} print "

";
		print depascal($node->{pascal});
		print "

"; if ($node->{defines} and $#{$nodeparts{$node->{defines}}} > 1) { print "

See also ", join ", ", map {qq{$_} } @{$nodeparts{$node->{defines}}}; print "

" } } print "\n\n"; } print ""; print "

\n"; use HTML::Entities; sub common_filtering { my $data = shift; $data =~ s/\@t.*?@>|@\///sg; # Screw indexing $data =~ s/\@[\:\.\^](.*?)@>\s*|\@!\@(.)(.*?)@>\s*|@!//sg; return $data; } sub detex { my $data = shift; 1 while $data =~ s/(\@<\s*(.*?)\s*\@>)/link_to(resolve($2))/es; $data =~ s/~/ /g; $data =~ s/\$\$.*?\$\$//gs; # Urgh $data =~ s/\\\.\{(.*?)\}/$1<\/span>/g; $data =~ s/\\(TeX|XeTeX|PASCAL)\\?/$1/g; #$data =~ s/\@"([a-fA-F0-9]+)/

0x$1<\/code>/g;
	#$data =~ s/\@'([0-7]+)/0$1<\/code>/g;
	$data =~ s/\|([^\|]+)\|/"".depascal($1)."<\/code>"/eg;
	return common_filtering($data);
}

sub depascal {
	my $data = shift;
	#$data =~ s/\@,|\@+/ /g;
	my $new;
	while ($data) {
		if ($data=~ s/^(\@<\s*(.*?)\s*\@>)//s) { $new .= link_to(resolve($2)); next }
		if ($data =~ s/^(\@t.*?@>|\@[\/;\+\|\$\?])//s) { next; }
		if ($data =~ s/^\@,//s) { $new .= " "; next ;}
		if ($data =~ s/^\@\{.*?\@\}//s) { next; } # Bye bye comments
		if ($data =~ s/^(\@[\:\.\^](.*?)@>\s*|\@!\@(.)(.*?)@>\s*|@!)//) { next; }
		if ($data=~ s/^\@"([a-fA-F0-9]+)//s) { $new .= hex($1); next;}
		if ($data=~ s/^\@'([0-7]+)//s) { $new .= oct($1); next }
		if ($data =~ s/^([^@]+)//) {$new .= encode_entities($1); next }
		if ($data =~ s/^\@#|\@\\//) {$new .= "
"; next }
		if ($data =~ s/\@\@//) { $new .= "@"; next;}
		die substr($data, 0, 5); 
	}
	return $new;

}
sub link_to {
	my $nname = shift;
	return qq{$nname};
}
sub resolve {
	my $portion = shift;
		$portion =~ s/\s+/ /gsm;

	$portion=~ s/\.\.\.$//;
	for (keys %nodenames) { # Urgh
		#warn $_. " -> $portion ";
		if (/\Q$portion\E/) { return $_ }
	}
	#warn $_ for sort keys %nodeparts;
	#warn $nodeno;
	die $portion;
	die;
}