#!/usr/local/bin/perl -w

eval 'exec /opt/perl_5.005.02/bin/perl -w -S $0 ${1+"$@"}'
    if 0; # not running under some shell
eval 'exec perl -S $0 ${1+"$@"}'
	if $running_under_some_shell;

=head1 NAME

pod2fm - convert pod format to FrameMaker documents and book file

=head1 SYNOPSIS

Under UNIX system (where fmbatch can be run):

    pod2fm [-mmlonly |
            -nodoc [-lock]
            [-book [<book_name>] [-noopen]
                [-template <document> [-format <types>]...]
                [-toc [-stoc <suffix>]]
                [-index [-sindex <suffix>]]
            ]
        ]
        [ -dir <location> | <pod>...]

Under Win32 and Macintosh:

    pod2fm [ -dir <location> | <pod>...]

=head1 DESCRIPTION

This program parses all files with .pod extension and creates FrameMaker
documents. You can control what is generated by arguments given on the
command line. On systems where B<fmbatch> is available (i.e.: UNIX systems)

I<Pod2fm> can:

=item * Generate Frame MML, MIF, and binary formats.

=item * Generate hypertext links to a group of documents.

=item * Create a Frame 'book' that includes all of the documents from a run.

=item * Create Table of Contents and Index documents.

=item * Create documents that can be used with FrameViewer for On-Line Docs.

=head1 OPTIONS

=over 12

=item B<-mmlonly>

=item B<-nommlonly>

This switch tells I<pod2fm> if it should stop execution after it has generated
the 'MML' version of the document. The document is written into a file with the
'.mml' extension.

If B<-mmlonly> is specified, it can be the only command line switch.

The default, under UNIX is 'B<-nommlonly>'. On Win32 and Macintosh, B<-mmlonly>
is always on.

=item B<-nodoc>

=item B<-doc>

Available only on UNIX systems.

The switch instructs I<pod2fm> to use the FrameMaker tool 'fmbatch' to convert
the '.doc' file, which is in MIF format, in to the binary FrameMaker format.

The default is B<-doc>.

=item B<-lock>

=item B<-nolock>

Available only on UNIX systems.

I<Pod2fm> generates Hypertext Marker that allow you to click on a marked
word in a document and Frame will take you to the spot in a document
that the marker is pointing to. To be able to use this feature, you need
to save the documents as 'locked' or 'read only'. The B<-lock> option
will cause I<pod2fm> to generate 'locked' versions of the documents.

The B<-lock> option only works if you are generating binary documents. (See
the B<-doc> option.)

The default is B<-nolock>.

=item B<-book> [I<book_name>]

Available only on UNIX systems.

This switch allows I<pod2fm> to create a FrameMaker book file that contains
all of the documents that are on the command line. A book is a way to
organize a group of related documents so they can operated on at the same
time.  A book file allows you to apply a common format to all the
documents, and print all of them at the same time.

I<book_name> is an optional argument to -book. It allows you to specify a name
for the book file. If I<book_name> is not specified, it defaults to 'perl'.
In any case, the file name extension is '.book'.

=item B<-noopen>

=item B<-open>

Available only on UNIX systems.

If this option is on the command line, I<pod2mf> will try to open the book it
created in FrameMaker. Because this options works on the book file, you
must be generating a book with the B<-book> option.

The default is B<-open>.

=item B<-template> I<document>

Available only on UNIX systems.

I<Pod2fm> generates a minimal format for the documents it produces. You can 
use the B<-template> option to specify a template document that I<pod2fm> can
copy the format from so that you can control the format. You can control which
format in the template document to use with the B<-format> option. The
I<document> name is required argument to B<-template>, and specifies path to
the document template.

=item B<-font> I<family>

Use I<family> as the global font. This option has two effects: If the
B<-template> option is not used, this font family is set for all
paragraphs except B<pod_pre>, which is typeset in Courier. The other
usage is for the closing tag of the C<CE<lt>E<gt>> command.

=item B<-format> I<type>

Available only on UNIX systems.

The option B<-format> allows you to control which format to copy from the
template document specified with the B<-template> option. You can specify one
or more arguments to each B<-format> option by giving a comma separated list
of format types, like this:

    -format Page,Paragraph,Character

You can also have more than one B<-format> option on the command line.

The legal format I<type>s are:

    all		All type are specified (Default).
    Character	Character Formats.
    Paragraph	Paragraph Formats.
    Page	Master Page Layouts.
    Reference	Reference Page Layouts.
    Table	Table Formats.
    Variables	Variable Definitions.
    Math	Math Definitions.
    Cross	Cross-Reference Definitions.
    Color	Color Definitions.
    Conditional	Conditional Text Definitions.

There are two other I<type>s that can be included as an argument to control
how the other I<types> are used:

    Break	Preserve Page Breaks
    Other	Preserve Other Format Changes.

=item B<-toc>

=item B<-notoc>

=item B<-stoc> I<suffix>

=item B<-index>

=item B<-noindex>

=item B<-sindex> I<suffix>

Available only on UNIX systems.

When you are generating a book from a template with I<pod2fm>, you can generate
a Table of Contents and an Index by specifying the B<-toc> and the B<-index>
options. See the L<"Table of Contents"> and L<"Index"> sub-sections in
L<"TEMPLATES"> of this man page, for more information.

The defaults are B<-notoc> and B<-noindex>.

The B<-stoc> and B<-sindex> allow for overriding the default suffixes
`TOC' and `IDX', respectively.

=item B<-dir> I<location>

=item I<pod>...

By default, I<pod2fm> will look for pod files from the standard perl install
(the C<$installprivlib> from C<Config.pm>.) You can override this by using the
B<-dir> command line option. You can also specify the pods that you want on
the command line, but you can't mix the B<-dir> and pods in the same command.

When specifying individual files, the order is important, i.e. I<pod2fm>
searches for items and headers first in the currently processed file and
then in the other files, beginning with the first one on the command
line. E.g. when converting the perl manual, one should state
F<perlvar.pod>, F<perlfunc.pod> and F<perlrun.pod> first, so that the
explanations for functions, variables and runtime options are found
there and not e.g. in F<perldelta.pod>.

=back

=head1 TEMPLATES

By using the B<-template> command line option, when you are generating a book
using the B<-book> option, you can override the default formats that I<pod2fm>
produces.

A template is a FrameMaker document, the binary form or MIF, that has formats
you want already applied to it. With this version of I<pod2fm>, you can
override the Master Page and Reference Page layouts, and Paragraph formats.
There are other formats that you can specify, like Character formats and Color
definitions, but this version of I<pod2fm> does not do anything with them.

=head2 Paragraph Formats

There are several Paragraph Formats that I<pod2fm> uses and there is a
mapping from the pod command to the paragraph format that is produced.
The exception to the mapping is the I<=over> and I<=back> commands: they
modify the paragraph format by shifting its left edge by .1" times the
amount in the I<=over> command.

You need to take this into account when you are changing the paragraph
format.  If you drop the size of the font in the format, you do not get
a smaller amount of shifting. An I<=over> 5 always give an indent of
.5".

The paragraph formats that I<pod2fm> uses are:

=over 12

=item B<pod_TITLE>

Paragraphs marked with this format contain the name of the pod. The name is
automatically added to the start of each document, and this format is only
used here.

You can use the B<pod_TITLE> tag to generate a header or footer with the
name of the pod in it by changing the Master Page layout. If you are
generating a book, this format is exported so that you can create a
Table of Contents by changing the Reference Page.

=item B<pod_Body>

This format marks a standard paragraph. The left edge moves with
each I<=over> I<n> and I<=back>. The edge moves by I<n>*.1".

=item B<pod_head1>

This format is used for section headers. The command is used like:

S<    C<=head1> I<text>>

where I<text> is printed in this format. The I<=over> or I<=back> command do not
change this format.

If you are generating a book, this format is exported so that you can create a
Table of Contents by changing the Reference Page. Also, a Marker is placed on
the I<text> so that it can be placed in an Index.

=item B<pod_head2>

This format is used for sub-section headers. The command is used like:

S<    C<=head2> I<text>>

where I<text> is printed in this format. The I<=over> or I<=back> command do not
change this format.

If you are generating a book, this format is exported so that you can create a
Table of Contents by changing the Reference Page. Also, a Marker is placed on
the I<text> so that it can be placed in an Index.

=item B<pod_ol>

This format is used on ordered (numbered) lists. If the indent command is in
this form:

S<    C<=item> I<n>[I<.>]>

where I<n> is any number followed by an optional period. The next paragraph 
will be marked with this format and will print as a hanging indent that starts
with an automatically generated number and a period. The start of the 
paragraph is shifted by the amount in the I<=over> command. Any paragraphs that
come after the first are marked with B<pod_Body> and the left edge is shifted
by the amount from the I<=over> command.

=item B<pod_ul>

This format is used on unordered lists. If the indent command is in this form:

S<    C<=item *>>

the next paragraph will be marked with this format and will print as a
hanging indent that starts bullet. The start of the paragraph is shifted by
the amount in the I<=over> command. Any paragraphs that come after the first
are marked with B<pod_Body> and the left edge is shifted by the amount from
the I<=over> command.

=item B<pod_dl>

This format is used on description lists. If the indent command is in this form:

S<    >S<C<=item *> I<text>>

the I<text> will be printed after a bullet, on a line by itself.  Any
paragraphs that come after the first are marked with B<pod_Body> and the left
edge is shifted by the amount from the I<=over> command.

=item B<pod_hi>

This format is used on hanging indent lists. If the indent command is in
this form:

S<    C<=item> I<text>>

the I<text> will be printed as a hanging indent. The next paragraph will
be marked with this format and will print with the start of the
paragraph shifted by the amount in the I<=over> command.
Any paragraphs that come after the first are marked with B<pod_Body> and
the left edge is shifted by the amount from the I<=over> command.

=item B<pod_il>

This format is used on implied lists. If the first line of a paragraph is
in this form:

    ____hang_______text
     |		|
     +- spaces	+- tabs
	  or
	 tabs

the I<hang> will be printed as a hanging indent and the I<text> will be
printed with the left edge shifted to 2.5" from the current B<pod_Body>
left edge. The rest of the lines in the paragraph are treated the same,
i.e.: each line in the pod's paragraph is converted to a FrameMaker
paragraph that is marked with B<pod_il>. Any paragraphs that come after
the first are marked with B<pod_Body> and the left edge is shifted by
the amount from the I<=over> command.

=item B<pod_pre>

This format is used on verbatim paragraphs. If the first line of a
paragraph is in this form:

    ____text
     |
     +- spaces
	  or
	 tabs

the I<text>, including the leading white space, will be printed with the
left edge shifted to the current B<pod_Body> left edge.  The rest of the
lines in the paragraph are treated the same, i.e.: each line in the
pod's paragraph is converted to a FrameMaker paragraph that is marked
with B<pod_pre>. Any paragraphs that come after the first are marked
with B<pod_Body> and the left edge is shifted by the amount from the
I<=over> command.

=back

=head2 Table of Contents

If you are producing a book, and you have a B<-template> command line option
and you are importing the Master Page Layout (B<-format Page> or the default),
you can produce a Table of Contents by adding the B<-toc> option. I<Pod2fm>
will automatically add a generated document called I<book_name>TOC.doc to
the book file, where I<book_name> is the optional argument to the B<-book>
command line option. If no argument is give on the B<-book>, you will get a
document called F<perlTOC.doc>.

To specify the format of the Table of Contents, you need to go to the
reference pages of the template document and create a flow called 'TOC'.
Within the flow, you need to create a picture of what the Table of
Contents will look like. You can add I<Building block> to the picture
that allows you to control what is printed, things like the page number
and text for the TOC entry. See the FrameMaker On-Line Help or I<Using
FrameMaker> printed manual for a complete description of how to set up a
TOC Reference page.

The TOC entry is derived from paragraphs in the documents in the book that are
marked with specific paragraph formats. I<Pod2fm> uses the paragraph formats
B<pod_TITLE>, B<pod_head1>, and B<pod_head2> to mark the TOC entries.

To make a TOC entry show, you need to create a new paragraph format that tracks
the format used in the documents. The new paragraph have the form:

S<    I<format_name>TOC>

where I<format_name> is the format name used in the document. Here is an
example of TOC specification:

    Paragraph tagged	Specifies
    ----------------	---------
    pod_TITLE		<$paratext><$nopage>
    pod_head1		    <$paratext>\t<$pagenum>
    pod_head2			<$paratext>\t<$pagenum>

would print something like this:

    POD2FM
	NAME					1
	SYNOPSIS				1
	DESCRIPTION				1
	OPTIONS					1
	TEMPLATES				3
	    Paragraph Formats			3
	    Table of Contents			5
	    Index				6
	BUGS					6
	AUTHORS					7

=head2 Index

An Index document is much the same as a Table of Contents document: you must
be generating a book and importing Reference Page Layouts from a template,
and have a B<-index> command line option.

The format for the Index is also specified on a Reference Page in a flow called
B<IX>, and it has it's own set of I<Building Blocks>. Please see the FrameMaker
documentation for more details on how to create the Index Reference Page.

I<Pod2fm> generates the index from any I<Index> markers that have been
place in the documents. The markers are generated on any I<=head> or
I<=item> command, and any interior sequences (like IE<lt>E<gt>,
BE<lt>E<gt>, and LE<lt>E<gt>) that refers to and I<=head> or I<=item>.

=head1 SCRIPT CATEGORIES

POD

=head1 PREREQUISITES

Getopt::Long
File::Find
File::Basename
Config
vars

=head1 COREQUISITES

authors/id/PEASE/pod2fm-1.10.tar.gz

=head1 CHANGES

=head2 Changes in 1.10

=over 4

=item *

Cleanups, added support for XE<lt>E<gt>, LE<lt>...|...E<gt>.

=back

=head2 Changes in 1.9

=over 4

=item *

Added checks for Win32 and Macintosh versions of Perl.

=back

=head2 Changes in 1.8 from 0.10

=over 4

=item *

Cleaned up for newer versions of Perl (5.003 and up)

=item *

Added the B<-dir> option to use all of the pod found in a directory as input.
Fixed bug in the processing of TOC and Index.

=back

=head1 BUGS

You can't change the amount of indent using a template file (yet...).

=head1 AUTHORS

Based on pod2html (in a galaxy long, long ago and far, far away.)

Extended for MML by S<Mark Pease >E<lt>Mark_Pease-RXYE40@email.sps.mot.comE<gt>.

fmbatch and book support added by S<Tim Bunce >E<lt>Tim.Bunce@ig.co.ukE<gt>.

Reviewed and enhanced by S<Marek Rouchal >E<lt>Marek.Rouchal@siemens-scg.comE<gt>.

Please send bug reports to S<Mark Pease >E<lt>Mark_Pease-RXYE40@email.sps.mot.comE<gt>.

=cut

use strict;
use Getopt::Long;
use File::Find;
use File::Basename;
use Config;
use vars qw(
    $gt
    $lt
    %HTML_Escapes
    $IgnoreHead1rx
    $VERSION
    $running_under_some_shell
    @opt_debug
    $opt_mmlonly
    $opt_doc
    $opt_book
    $opt_lock
    $opt_template
    $opt_font
    @opt_format
    $opt_toc
    $opt_stoc
    $opt_index
    $opt_sindex
    $opt_open
    $opt_dir
    );

$VERSION = do { my @r=(q$Revision: 1.10 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};

# flush stdout
$| = 1;

################################################################################
# CONFIGURE
#
#
################################################################################

my $book_ext = 'book';
my $doc_ext = 'doc';
my $fmbatch = 'fmbatch';
$fmbatch = 'fmbatch -i' if $ENV{FM_PROGNAME} && $ENV{FM_PROGNAME} =~ m/^i/;

#
# Page formats
#
my $TopMargin	 = .75;
my $BottomMargin = .75;
my $LeftMargin	 = .75;
my $RightMargin  = .75;

#
# Paragraph indents and tab stop locations in inches.
#
my $IndentAmount = 0.1;

my $BodyLeft = 0.3;
my $BodyIndent = 0.3;

my @ListTab = ($BodyLeft, $BodyLeft + 1, $BodyLeft + 2);

my $ilLeft = $BodyLeft + 1.0;
my $ilIndent = $BodyLeft + 0.5;
my @ilTab = ($ilLeft, $ilLeft + 1, $ilLeft + 2);

my $dlLeft = $BodyLeft;
my $dlIndent = $BodyLeft;

################################################################################
# END CONFIGURE
################################################################################

################################################################################
# GENERAL GLOBAL VALUES
################################################################################

my %index = ();
my @Pods = ();
my %Podnames = ();
my %picref_seen = ();
my $A = {};	# The beginning of all things

################################################################################
# COMMAND LINE ACTIONS
#
#   Set up defaults for the command line, and process it.
################################################################################

my $do_mmlonly = 0;		# Produce MIF ".doc" files
my $do_doc = 1;			# Generate the binary ".doc" files
my $save_type = 'd';		# SaveAs type: "d" - normal format, "l" - locked
my $do_book = 0;		# Don't Generate a book
my $book_name = 'perl';		# The default name for a book.
my $import_formats = 'pflcvrtxkmBO';# Default formats to import from Template
my $do_toc = 0;			# Don't include a TOC
my $do_index = 0;			# Don't include a INDEX
my $open_frame = 1;		# Open maker on the book file once it is built
my $dir = $Config{installprivlib};	# Take the installed pods as default;

if ($Config{'osname'} eq 'MacOS' || $Config{'osname'} eq 'MSWin32'){
    # For system that don't have fmbatch.

    $do_mmlonly = 1;		# Produce MIF ".mml" files
    $do_doc = 0;		# Don't Generate the binary ".doc" files

    GetOptions(
	"dir=s"
    ) || die "$0: Unable to process command line.\n";
} else {
    GetOptions(
	"debug=s@",
	"mmlonly!",
	"doc!",
	"book:s",
	"lock!",
	"template=s",
	"font=s",
	"format=s@",
	"toc!",
	"stoc=s",
	"index!",
	"sindex=s",
	"open!",
	"doc=s",
	"dir=s"
    ) || die "$0: Unable to process command line.\n";
}

# Fix up debug, if necessary.
my %opt_debug = ();
foreach my $tmp (@opt_debug) {
    $opt_debug{$tmp} = 1;
}

# Specify global font family
my $Font = $opt_font || 'Times';

my $toc_ext = $opt_stoc || 'TOC';
my $idx_ext = $opt_sindex || 'IDX';


my $OL_Num     = 0;  # Initalize ordered list enumeration
my $OL_Dot = ''; # Initalize ordered list dot style
my $OL_First_Item   = 0;  # Initalize ordered list flag

#
# Verify options
#

my $batch_name = '';

if (defined $opt_mmlonly and $opt_mmlonly) {
    #
    # Generate MML only.
    #
    $do_mmlonly = 1;
    $do_doc = 0;
    $do_book = 0;
    $do_toc = 0;
    $do_index = 0;
    $open_frame = 0;

    warn "$0: You can't produce .${doc_ext} files because you asked for MML only.
    Continuing, only producing .mml\n"
	if $opt_doc;

    warn "$0: You can't generate a book because you asked for MML only.
    Continuing, only producing .mml\n"
	if $opt_book or $opt_lock or $opt_toc or $opt_index;

    warn "$0: You can't import formats because you asked for MML only.
    Continuing, only producing .mml\n"
	if defined $opt_template or defined @opt_format;

} else {
    #
    # Generate MIF, and maybe other stuff.
    #
    $do_mmlonly = 0;

    #
    # Process Document Generation options.
    #
    $do_doc = $opt_doc if defined $opt_doc;

    #
    # Process book options.
    #
    if (defined $opt_book or $do_book) {
	#
	# Generate a MIF file for the book, with the default name of "perl".
	#
	$do_book = 1;
	$opt_book = $book_name unless $opt_book;
	$batch_name = $opt_book;

	#
	# Process lock options.
	#
	$save_type = (defined $opt_lock and $opt_lock) ? 'l' : 'd';

	#
	# Check for templates and formats.
	#
	die "$0: Template file $opt_template does not exist!\n"
	    if defined($opt_template) and !(-e $opt_template);

	die "$0: You must specify a template using -template <file>."
	    if defined(@opt_format) and !defined($opt_template);

	#
	# Process the format options.
	#
	if (defined(@opt_format)) {
	    my %type;

    FORMAT: foreach (@opt_format) {
		#
		# Each format argument could be a "," seperated list.
		#
		foreach (split /,/) {
		    {
			# Do it all
			/all/i	and do {$type{$_}='pflcvrtxkmBO',last FORMAT;};

			# Presere Page Breaks
			/^b/i	and do {$type{$_}='m',last;};

			# Character Formats
			/^ch/i	and do {$type{$_}='f',last;};

			# Color Definitions
			/^col/i	and do {$type{$_}='k',last;};

			# Conditional Text
			/^con/i	and do {$type{$_}='x',last;};

			# Cross-references
			/^cr/i	and do {$type{$_}='c',last;};

			# Math Definitions
			/^m/i	and do {$type{$_}='m',last;};

			# Presere Other Formats
			/^o/i	and do {$type{$_}='m',last;};

			# Master Page Layouts
			/^pag/i	and do {$type{$_}='l',last;};

			# Paragraph Formats
			/^par/i	and do {$type{$_}='p',last;};

			# References Pages
			/^r/i	and do {$type{$_}='r',last;};

			# Table Formats
			/^t/i	and do {$type{$_}='t',last;};

			# Varables
			/^v/i	and do {$type{$_}='v',last;};

			# Default
			die "$0: Unknow format type $_\n";
		    }
		}
	    }
	    $import_formats = '';	    # Start with nothing.
	    foreach (keys %type) {
		$import_formats .= $type{$_};
	    }
	}

	#
	# Make sure we can do TOC and INDEX's
	#
	if (defined $opt_toc and $opt_toc ) {
	    if (!$opt_template or !$import_formats =~ /r/) {
		warn "$0: You can't generate a Table of Contents unless you " .
		"specify a template and you ask for Page formats to be " .
		"imported.\n" .
		"Continuing with out generating a TOC.\n";
		$do_toc = 0;
	    } else {
		$do_toc = 1;
	    }
	}

	if (defined $opt_index and $opt_index) {
	    if (!$opt_template and !$import_formats =~ /r/) {
		warn "$0: You can't generate an Index unless you specify a " .
		"template and you ask for Page formats to be imported.\n" .
		"Continuing with out generating an INDEX.\n";
		$do_index = 0;
	    } else {
		$do_index = 1;
	    }
	}
	$open_frame = !defined $opt_open || $opt_open;
    } else {
	#
	# We are not working with a book.
	#
	$batch_name = "batch";
	$do_book = 0;
	$do_toc = 0;
	# generate index markers no matter what
	$do_index = defined($opt_index) && $opt_index;
	$open_frame = 0;
    }
}

#
# Check to see if a directory is asked for
#
if ($opt_dir) {
    die "$0: You can't specify a dir if you also specify pod names\n"
	if(@ARGV);
    $dir = $opt_dir;
} else {
    #
    # check for podnames on command line
    #
    while ($ARGV[0]) {
	push(@Pods,shift @ARGV);
    }
}

if(!@Pods && -d $dir){
    find (
	sub {
	    if (-f $_) {
		push(@Pods, $File::Find::name)
		    if $File::Find::name =~ /\.(pm|pod)$/;
	    }
	},
	$dir
    );
}

@Pods or die "$0: No pod file found on command line or in $dir\n";

my @book;	# Build a FrameMaker book file for all the parts
my @fmbatch;	# Build an fmbatch script for mif-doc conversion

if ($do_book or $do_doc) {
    if ($do_book) {
	push @book, "<Book 3.00>";
	push @book, "<BWindowRect 5 26 301 870>";
	if ($do_toc) {
	    #
	    # Create a TOC document.
	    #
	    my $toc = "${opt_book}${toc_ext}";
	    if(open(TOC, ">$toc.mml")) {
		push @fmbatch, "echo Building $toc.${doc_ext}";
		push @fmbatch, "Open $toc.${doc_ext}";
		push @fmbatch, "Validate $toc.${doc_ext}";	# test
		push @fmbatch, "SaveAs $save_type  $toc.${doc_ext} $toc.${doc_ext}";
		push @fmbatch, "Quit $toc.${doc_ext}";
		push @book, "<BookComponent";
		push @book, " <FileName `<c\\>$toc.${doc_ext}'>";
		push @book, " <PageNumPrefix `'>";
		push @book, " <PageNumSuffix `'>";
		push @book, " <FileNameSuffix `$toc_ext'>";
		push @book, " <DeriveType TOC>";
		foreach(qw(pod_TITLE pod_head1 pod_head2)) {
		    push @book, " <DeriveTag `$_'>";
		}
		push @book, " <DefaultPrint Yes>";
		push @book, " <DefaultApply No>";
		push @book, " <DefaultDerive Yes>";
		push @book, " <DeriveLinks Yes>";
		push @book, ">";

		print TOC mml_header();
		close(TOC);
		unless ($do_mmlonly) {
		    system("mmltomif $toc.mml $toc.${doc_ext}");
		    warn "$0: Unable to run mmltomif on $toc.mml\n"
			if $? >> 8;
		    unlink("$toc.mml") unless $opt_debug{'keep_mml'};
		}
	    } else {
		warn "$0: Unable to create a TOC! Continuing...\n";
		$do_toc = '';
	    }
	}
    }
}

# loop twice through the pods, first to learn the links, then to produce mml
for my $count (0,1) {
    my $in_mml = '';
    unless($count) {
	print "Scanning pods" unless $count;
    } else {
	print "\n";
    }
    foreach my $podfh ( @Pods ) {
	my $in_list = '';
	my $cmd = '';
	my $title = '';
	my $rest = '';
	my @depth = ();
	my $pod = basename($podfh, qw(.pm .pod));
	Debug("files", "opening '$podfh'\n");
	if($count) {
	    print "Creating $pod.${doc_ext} from $podfh\n";
	} else {
	    print ".";
	}
	$/ = "\n=";	    # grok pods by item (Nonstandard but effecient)
	open(PODFH,"<$podfh")	|| die "can't open $podfh: $!";
	my @all = <PODFH>;
	close(PODFH);
	$/ = "\n";
	$all[0] =~ s/^=// or shift(@all);
	for(my $i=0; $i <= $#all; $i++) {
	    splice(@all, $i+1, 1) unless ($all[$i] =~ s/=$//) &&
		((!defined $all[$i+1]) || ($all[$i+1] !~ /^cut/));
	}

	#
	# We don't need to continue if no pod information was found in the
	# file.
	#
	next unless scalar(@all);

	unless (grep(/head\d\s+NAME/, @all)) {
	    warn "$0: NAME header not found in $podfh, skipping\n";
	    next;
	}
	$Podnames{$pod} = draw_a_number() unless($count);

	my $mml = "$pod.${doc_ext}";
	if($count){		# give us a mml and rcs header
	    open(MML, ">$pod.mml")
			|| die "$0: can't create $mml: $!";
	    print MML mml_header(), "<pod_TITLE>\n\U$pod\E";

	    if ($do_doc) {
		push @fmbatch, "echo Building $pod.${doc_ext}";
		push @fmbatch, "Open $pod.${doc_ext}";
		push @fmbatch, "Validate $pod.${doc_ext}";	# test
		if($opt_template && !$do_book) {
		    push @fmbatch, "Open $opt_template";
		    push @fmbatch, "Validate $opt_template";	# test
		    push @fmbatch, "ImportFormats $import_formats $pod.${doc_ext} $opt_template";
		}
		push @fmbatch, "SaveAs $save_type  $pod.${doc_ext} $pod.${doc_ext}";
		push @fmbatch, "Quit $pod.${doc_ext}";
	    }
	    if ($do_book) {
		push @book, "<BookComponent";
		push @book, " <FileName `<c\\>$pod.${doc_ext}'>";
		push @book, " <PageNumPrefix `'>";
		push @book, " <PageNumSuffix `'>";
		push @book, " <DefaultPrint Yes>";
		push @book, " <DefaultApply Yes>";
		push @book, ">";
	    }
	}

	my $i;
	for($i=0;$i<=$#all;$i++) {	# decide what to do with each chunk
	    ($cmd,$title,$rest) = ($all[$i] =~ /^(\w+)\s*([^\n]*)\n*(.*)$/so);
	    if ($cmd =~ /^pod/o) {
		do_rest($pod, $rest, '', @depth);
	    }
	    elsif ($cmd =~ /^item/o) {
		if($count) {	# producting mml
		    unless(@depth) {
		    	warn "Warning: '=item $title' without previuos =over\n";
		    	do_list("over", 5, $all[$i], \$in_list, \@depth);
		    }
		    do_item($pod, $title, $rest, $in_list, @depth);
		}
		else {
		    # scan item
		    scan_thing("item", $title, $rest, $pod);
		}
	    }
	    elsif ($cmd =~ /^head([12])/o) {
		my $num = $1;
		if($count) {	# producting mml
		    do_hdr($pod, $num, $title, $rest, @depth);
		}
		else{
		    # header scan
		    scan_thing($cmd, $title, $rest, $pod);
		}
	    }
	    elsif ($cmd =~ /^over/o) {
		do_list("over", $title || 5, $all[$i+1], \$in_list,\@depth)
		    if($count);
	    }
	    elsif ($cmd =~ /^back/o) {
		if($count) {	# producting mml
		    unless(@depth) { # just skip it
		    	warn "Warning: =back without =over found.\n";
		    	next;
		    }
		    do_list("back", 0, $all[$i+1], \$in_list, \@depth);
		    print_Body(@depth);
		    do_rest($pod, $title.$rest, $in_mml, @depth);
		}
	    }
	    elsif ($cmd =~ /^(cut|end)/o) {
		next;
	    }
	    elsif ($cmd =~ /^for/o) {  # experimental pragma mml
		if($count){  # producing mml
		    if($title =~ s/^mml//){
			$in_mml = 1;
			do_rest($pod, $title.$rest, $in_mml, @depth);
		    }
		}
	    }
	    elsif ($cmd =~ /^begin/o) {	# experimental pragma mml
		if($count) {  # producing mml
		    if($title =~ s/^mml//){
			print MML $title,"\n",$rest;
		    }
		    elsif($title =~ /^end/){
			next;
		    }
		}
	    }
	    else {
		warn "unrecognized POD command: '=$cmd'\n";
	    }
	}
	# close open lists without '=back' stmts
	if($count) { # producing html
	    while(scalar(@depth)) {
		warn "Warning: Missing =back, auto-closing open =over\n";
		do_list("back", 0, $all[$i+1], \$in_list, \@depth);
		print_Body(@depth);
	    }

	    close(MML);	# must close to flush pipes etc

	    #
	    # Start mif converter, if we can.
	    #
	    unless ($do_mmlonly) {
		system("mmltomif $pod.mml $mml");
		warn "$0: Unable to run mmltomif on $pod.mml\n" if $? >> 8;
		unlink("$pod.mml") unless $opt_debug{'keep_mml'};
	    }
	}
    }
}

if ($do_doc) {
    if ($do_book) {
	if ($do_index) {
	    my $idx = "${opt_book}${idx_ext}";
	    if(open INDEX, ">$idx.mml") {
		push @fmbatch, "echo Building $idx.${doc_ext}";
		push @fmbatch, "Open $idx.${doc_ext}";
		push @fmbatch, "Validate $idx.${doc_ext}";	# test
		push @fmbatch, "SaveAs $save_type $idx.${doc_ext} $idx.${doc_ext}";
		push @fmbatch, "Quit $idx.${doc_ext}";
		push @book, "<BookComponent";
		push @book, " <FileName `<c\\>$idx.${doc_ext}'>";
		push @book, " <PageNumPrefix `'>";
		push @book, " <PageNumSuffix `'>";
		push @book, " <FileNameSuffix `doc'>";
		push @book, " <DeriveType IDX>";
		foreach(qw(Index)) {
		    push @book, " <DeriveTag `$_'>";
		}
		push @book, " <DefaultPrint Yes>";
		push @book, " <DefaultApply No>";
		push @book, " <DefaultDerive Yes>";
		push @book, " <DeriveLinks Yes>";
		push @book, ">";
		print INDEX mml_header();
		close(INDEX);
		unless ($do_mmlonly) {
		    system("mmltomif $idx.mml $idx.${doc_ext}");
		    warn "$0: Unable to run mmltomif on $idx.mml\n"
			if $? >> 8;
		    unlink("$idx.mml") unless $opt_debug{'keep_mml'};
		}
	    } else {
		warn "$0: Unable to create an index file. Continuing...";
		$do_index = '';
	    }
	}
	open(BOOK,">${opt_book}.${book_ext}")
	    || die "$0: Unable to open the book file ${opt_book}.${book_ext}: $!\n";
	print BOOK join("\n", @book);
	close(BOOK);

	push @fmbatch,
	    "echo Components complete, updating ${opt_book}.${book_ext}...";
	push @fmbatch, "Open ${opt_book}.${book_ext}";
	#push @fmbatch, "Validate ${opt_book}.${book_ext}";	# test
	if ($opt_template) {
	    # hack to avoid locks :-)
	    # system("cp $opt_template x.${doc_ext}");
	    # $opt_template = 'x.${doc_ext}';
	    push @fmbatch,"Open $opt_template";
	    push @fmbatch,
		"ImportFormats $import_formats ${opt_book}.${book_ext} $opt_template";
	    push @fmbatch,"Quit $opt_template";
	}
	push @fmbatch, "Update ${opt_book}.${book_ext}";	# Now Update
	push @fmbatch, "SaveAs d ${opt_book}.${book_ext} ${opt_book}.${book_ext}";
	push @fmbatch, "Quit ${opt_book}.${book_ext}";
    }

    open(BATCH, ">${batch_name}.fmbatch")
	|| die "$0: Unable to create ${opt_book}.fmbatch\n";
    print BATCH join("\n", @fmbatch);
    close(BATCH);

    system("$fmbatch ${batch_name}.fmbatch");
    if($? >> 8) {
    	die "$0: Unable to run $fmbatch on ${batch_name}.fmbatch\n";
    }
    else {
    	unlink "${batch_name}.fmbatch";
    }
}

system("fmclient -f ${opt_book}.${book_ext}") if $open_frame;

exit 0;

################################################################################
#
# Subroutine: print_Body
#
# Description:
#   This routine handles the formating of Body paragraphs.
#
################################################################################

sub print_Body {
    my(@depth) = @_;
    my $temp;

    my ($over) = get_shift(@depth);

    print MML "<pod_Body>\n";
    $temp = $BodyLeft + $over;
    print MML "<LeftIndent $temp\">\n";
    $temp = $BodyIndent + $over;
    print MML "<FirstIndent $temp\">\n";
}

################################################################################
#
# Subroutine: print_pre
#
# Description:
#   This routine handles the formating of pre (preformated) paragraphs.
#
################################################################################

sub print_pre {
    my(@depth) = @_;
    my $temp;

    my ($over) = get_shift(@depth);

    print MML "<pod_pre>\n";
    $temp = $BodyLeft + $over;
    print MML "<LeftIndent $temp\">\n";
    $temp = $BodyLeft + $over;
    print MML "<FirstIndent $temp\">\n";
}

################################################################################
#
# Subroutine: print_il
#
# Description:
#   This routine handles the formating of il (indented) lists. This is an
#   implied format.
#
################################################################################

sub print_il {
    my(@depth) = @_;
    my $temp;

    my ($over, $list) = get_shift(@depth);

    print MML	"<pod_il>\n";
    $temp = $ilLeft + $over;
    print MML "<LeftIndent $temp\">\n";
    $temp = $ilIndent + $over;
    print MML "<FirstIndent $temp\">\n";
    print MML	"<TabStops \n";
    foreach my $tab (@ilTab) {
	$temp = $tab +$over;
	print MML "    <TabStop $temp\">\n";
    }
    print MML ">\n";
}

################################################################################
#
# Subroutine: print_ol
#
# Description:
#   This routine handles the formating of ol (ordered or numbered) lists.
#
################################################################################

sub print_ol {
    my(@depth) = @_;
    my $temp;

    my ($over, $list) = get_shift(@depth);

    print MML	"<pod_ol>\n";
    $temp = $BodyLeft + $over;
    print MML "<LeftIndent $temp\">\n";
    $temp = $BodyLeft + $list;
    print MML "<FirstIndent $temp\">\n";
    print MML "<Autonumber Yes>\n";
    if($OL_First_Item) {
    	print MML qq(<NumberFormat "<n=$OL_Num>$OL_Dot\\t">\n);
        $OL_First_Item = 0;
    }
    else {
    	print MML qq(<NumberFormat "<n+>$OL_Dot\\t">\n);
    }
    $OL_Num++;
    print MML "<TabStops \n";
    foreach my $tab (@ListTab) {
	$temp = $tab + $over;
	print MML "    <TabStop $temp\">\n";
    }
    print MML ">\n";
}

################################################################################
#
# Subroutine: print_ul
#
# Description:
#   This routine handles the formating of ul (unordered/unnumbered) lists.
#
################################################################################

sub print_ul {
    my(@depth) = @_;
    my $temp;

    my ($over, $list) = get_shift(@depth);

    print MML	"<pod_ul>\n";
    $temp = $BodyLeft + $over;
    print MML "<LeftIndent $temp\">\n";
    $temp = $BodyLeft + $list;
    print MML "<FirstIndent $temp\">\n";
    print MML	"<TabStops \n";
    foreach my $tab (@ListTab) {
	$temp = $tab + $over;
	print MML "    <TabStop $temp\">\n";
    }
    print MML ">\n";
}

################################################################################
#
# Subroutine: print_dl
#
# Description:
#   This routine handles the formating of dl (description) lists.
#
################################################################################

sub print_dl {
    my(@depth) = @_;
    my $temp;

    my ($over, $list) = get_shift(@depth);

    print MML	"<pod_dl>\n";
    $temp = $dlLeft + $list;
    print MML "<LeftIndent $temp\">\n";
    $temp = $dlIndent + $list;
    print MML "<FirstIndent $temp\">\n";
}

################################################################################
#
# Subroutine: print_hi
#
# Description:
#   This routine handles the formating of hi (hanging indent) paragraphs.
#
################################################################################

sub print_hi {
    my(@depth) = @_;

    my ($over, $list) = get_shift(@depth);

    print MML	"<pod_hi>\n";
    my $li = $BodyLeft + $over;
    print MML "<LeftIndent $li\">\n";
    my $fi = $BodyLeft + $list;
    print MML "<FirstIndent $fi\">\n";
    print MML	"<TabStops \n".
		"    <TabStop $li\">\n" .
		">\n";
}

################################################################################
#
# Subroutine: get_shift
#
# Description:
#   This routine finds the amount of shift that needs to happen because of an
#   "over" or a "item".
#
################################################################################

sub get_shift {
    my @depth = @_;
    my $over = 0;
    my $list = 0;

    foreach my $shift (@depth) {
	$list = $over;
	$over += $shift;
    }

    return ($over*$IndentAmount, $list*$IndentAmount);
}

################################################################################
#
# Subroutine: print_marker
#
# Description:
#   This routine outputs a hypertext marker, and, if an index is going to be
#   generated, an index marker.
#
################################################################################

my %ref_markers = ();
sub print_marker {
    my ($type, $key, $file) = @_;
    Debug('print_marker',"type=$type key=$key file=$file\n");

    my $marker = '';

    # make $value FM-compliant
    my $value = join('_',recover_sym($key));
    pre_escapes(\$value);
    post_escapes(\$value);
    if ($type =~ /^NAME|INDEX$/) {
	if($type eq 'NAME' && !$ref_markers{$value}++) {
	    $marker = "<Marker <MType 8> <MText `newlink $value'>>";
	}
	if ($do_index && $index{$key}) {
	    $value = $index{$key};
	    Debug('index',"marking index '$value' (key '$key')\n");
	    $value = pre_escapes(\$value);
	    $value = post_escapes(\$value);
	    # double-escape angle brackets here!
	    $value =~ s/\\([<>])/\\\\\\$1/g;
	    #$marker .= "<Marker <MType 2> <MTypeName `Index'> <MText `$value'>>";
	    $marker .= "<Marker <MType 2> <MText `$value'>>";
	}
    } else {
	$marker = "<Marker <MType 8> <MText `gotolink ${file}:${value}'>>";
    }
    return noremap($marker);
}

################################################################################
#
# Subroutine: do_list
#
# Description:
#    This routine opens/closes a (new) list context after determining the
#    type of list to use.
#
################################################################################

sub do_list {
    my ($which,$amount,$next_one,$list_type,$depth) = @_;

    my $key = '';
    if($which eq 'over') {
	($key) = ($next_one =~ /^item\s+(\S.*)/);
	unless(defined($key) && length($key)) {
	    Debug("list", "Bad list, no item key found in '$next_one'\n");
	    $$list_type="HI";
	} elsif($key =~ /^(\d+)(\.?)/) { # numerical list
	    $$list_type = "OL";
	    $OL_Num = $1 || 0; # Reset ordered list enumeration
	    $OL_Dot = $2; # Reset ordered list dot style
	    $OL_First_Item = 1; # Signal beginning of list
	} elsif($key =~ /^\*\s*$/) { # bulleted list
	    $$list_type="UL";
	} elsif($key =~ /^\*\s*\S/) {
	    $$list_type="DL";
	} else {
	    $$list_type="HI";
	}
	Debug('list',"Found list '$which', amount '$amount', type '$$list_type'\n");
	push(@$depth, $amount);
    }
    elsif($which eq 'back'){
	$$list_type = '';
	$amount = pop(@$depth);
    }
}

################################################################################
#
# Subroutine: do_hdr
#
# Description:
#    This routine processes a =head paragraph.
#
################################################################################

sub do_hdr {
    my ($pod,$num,$title,$rest,@depth) = @_;

    ($num == 1) and print MML "\n";
    process_thing($pod,\$title,"NAME",'Header');
    print MML "\n<pod_head$num>\n";
    print MML "$title\n";
    print_Body(@depth);
    do_rest($pod,$rest,'',@depth);
}

################################################################################
#   
# Subroutine: do_item
#   
# Description:
#    This routine processes an =item paragraph.
#
################################################################################

sub do_item {
    my ($pod,$title,$rest,$list_type,@depth) = @_;
    Debug('do_item',"pod=$pod title=$title list_type=$list_type\n");

    trim($title);
    if($list_type =~ /^[DU]L$/) {
    	$title =~ s/^[*]\s*//;
    } elsif($list_type =~ /^OL$/) {
    	$title =~ s/^\d*\.?\s*//;
    }
    my $orig = $title;
    process_thing($pod,\$title,"NAME",'Item');
    if($list_type eq "DL") {
	print_dl(@depth);
	print MML "<bold>$title<nobold><HardReturn>\n";
    } elsif ($list_type eq "OL") {
	print_ol(@depth);
	print MML "$title\n" if($orig =~ /\S/);
    } elsif ($list_type eq "UL") {
	print_ul(@depth);
	if($title) {
	    print MML "$title<HardReturn>\n";
	}
    } else { # HI hanging indent
	print_hi(@depth);
	my ($over) = get_shift(@depth);
	my $orig = canonify($orig);
	$orig =~ s/E<[^<>]*>/./g; # turn entities into single characters
	if ($over > length($orig) * $IndentAmount) {
	    print MML "$title\t";
	} else {
	    print MML "$title<HardReturn>\n";
	}
    }
    do_rest($pod,$rest,'',@depth);
    print_Body(@depth);
}

################################################################################
#
# Subroutine: do_rest
#
# Description:
#    This routine processes the rest of any paragraph.
#
################################################################################

sub do_rest {
    my ($pod,$rest,$in_mml,@depth) = @_;

    my($p, $q, $line, @paras, $inpre);
    my @lines = ();
    @paras = split(/\n\n\n*/,$rest);
    for($p=0;$p<=$#paras;$p++){
	$paras[$p] =~ s/^\n//mg;	# Zap any extra empty lines.
	@lines = split(/\n/,$paras[$p]);
	if (!defined $lines[0]) {
	    # There must be only one line in the paragraph
	    $lines[0] = $paras[$p];
	}
	if($in_mml) {	# handle =for mml paragraphs
	    print MML $paras[0];
	    $in_mml = 0;
	    next;
	}
	elsif($lines[0] =~ /^\s+\w+\t+.*/) {  # listing or unordered list
	    print_il(@depth);
	    foreach $line (@lines) {
		if($line =~ /^\s+(\w+)\t+(.*)/) {
		    my ($key,$rem) = ($1,$2);
		    process_thing($pod,\$rem, "MML",'Other');
		    if($Podnames{$key}) {
			print MML "<Marker <MType 8> <MText `gotolink $key.${doc_ext}:firstpage'>>";
		    }
		    print MML "$key\t$rem";
		    }
		else {
		    process_thing($pod,\$line,"MML",'Other');
		    print MML $line;
		}
	    }
	    if(defined($lines[1]) && $lines[1] =~ /^\s+\w+\t+.*/) {
	        print MML "<HardReturn>\n";
	    } else {
	        print MML "\n<par>\n";
	        print_Body(@depth);
	    }
	}
	elsif($lines[0] =~ /^\s/) {	 # preformatted code
	    # no processing of E<>, B<> etc done here!
	    print_pre(@depth);
	    while(defined($paras[$p])){
		@lines = split(/\n/,$paras[$p]);
		my $firstline = 1;
		foreach $q (@lines) {	# mind your p's and q's here :-)
		    print MML "<HardReturn>" unless($firstline);
		    $firstline = 0;
		    $q =~ s/ /\177/g;	# hide the spaces

		    # Convert tab's to hidden spaces
		    while($q =~  s/\t+/"\177" x (length($&) * 8 - length($`) % 8)/e){
			1;
		    }
		    $q =~ s/\\/\\\\/g;
		    $q =~ s/([<>])/\\$1/g;

		    $q =~ s/\177/<hardspace>/g;	# make all spaces hard.
		    print MML $q;
		}
		print MML "\n\n"; # new paragraph
		last if defined $paras[$p+1] and $paras[$p+1] !~ /^\s/;
		$p++;
	    }
	    print_Body(@depth);
	}
	else {				  # other text
	    process_thing($pod,\$paras[$p],"MML",'Other');
	    @lines = split(/\n/,$paras[$p]);
	    foreach $line (@lines){
		print MML qq{$line\n};
	    }
	}
	print_Body(@depth);
    }
}

sub process_thing {	# process a chunk, order important
    my ($pod,$thing,$htype,$par) = @_;
    pre_escapes($thing);
    find_refs($pod,$thing,$htype,$par);
    post_escapes($thing);
}

sub scan_thing {		# scan a chunk for later references
    my($cmd,$title,$rest,$pod)=@_;

    my $tit = canonify($title);
    return if($tit =~ /L<[^>]*>/); # abort if L<...> is present
    if ($cmd eq "item") {
	$tit =~ s/^([*]|\d+[.]?)\s*//; # strip bullet or digit
	return unless(length($tit)); # skip bullets and skip numbers
	return if defined $A->{$pod}->{"Items"}->{$tit};
	$A->{$pod}->{"Items"}->{$tit} = gensym($pod, $tit);
	$index{$A->{$pod}->{"Items"}->{$tit}} = $tit;
	Debug("items", "item '$tit'\n");

	# Get the first word as additional item
	my $shortkey = $tit;
	1 while($shortkey =~ s/(^|\s)(the|a|an)(\s|$)/$1$3/g);
	$shortkey =~ s/^\s+//; # remove leading whitespace
	$shortkey =~ s/\s.*$//; # remove anything beyond the first whitespace
	if(length($shortkey) && # $shortkey !~ /^[\$\@\%]/ && 
	    !defined $A->{$pod}->{"Items"}->{$shortkey})
	{
	    $A->{$pod}->{"Items"}->{$shortkey} = $A->{$pod}->{"Items"}->{$tit};
	    Debug("items", "item '$shortkey' REF TO '$tit'\n");
	}

	# Get any switches as additional items
	if ($tit =~ /^(-\w+)(?:\s|$)/ && !defined($A->{$pod}->{"Items"}->{$1}))
	{
	    $A->{$pod}->{"Items"}->{$1} = $A->{$pod}->{"Items"}->{$tit};
	    Debug("items", "item '$1' REF TO '$tit;\n");
	}

	# Get any variables as additional items
	while($tit =~ /(?:^|\G|\s)([%\$\@]\S[\w:]*)(\s|$)/g) {
	    if(!defined($A->{$pod}->{"Items"}->{$1})) {
	    	$A->{$pod}->{"Items"}->{$1} = $A->{$pod}->{"Items"}->{$tit};
	    	Debug("items", "item '$1' REF TO '$tit;\n");
	    }
	}

	# This is something weird
	if ( $tit =~ m{^(tr|y|s|m|q[qwx])/.*[^/]} ) {
	    my $pf = $1 . '//';
	    $pf .= "/" if $1 eq "tr" || $1 eq "y" || $1 eq "s";
	    if ($pf ne $tit && !defined($A->{$pod}->{"Items"}->{$pf})) {
		$A->{$pod}->{"Items"}->{$pf} = $A->{$pod}->{"Items"}->{$tit};
		Debug("items", "item '$pf' REF TO '$tit'");
	    }
	}
    }
    elsif ($cmd =~ /^head([12])/) {
	my $head = $1;
	return if defined($A->{$pod}->{"Headers"}->{$tit});
	$A->{$pod}->{"Headers"}->{$tit} = gensym($pod, $tit);
	my $name = $tit;
	if($tit =~ /^NAME/) {
	    # try to get a name from the rest
	    my $try = canonify($rest);
	    if($try =~ s/\s*-.*$// && $try) {
		$name = $try;
		unless(defined($A->{$pod}->{"Headers"}->{$name})) {
		    $A->{$pod}->{"Headers"}->{$name} =
			$A->{$pod}->{"Headers"}->{$tit};
		    Debug("headers", "header '$name' REF TO '$tit'");
		}
	    }
	}

	# save only meaningful headers in index
	unless($head == 1 && $name =~ /^($IgnoreHead1rx)/o) {
	    $index{$A->{$pod}->{"Headers"}->{$tit}} = $name;
	    Debug("headers", "header '$tit' in '$pod', index '$name'\n");
	}
	else {
	    Debug("headers", "header '$tit' in '$pod', no index\n");
	}
    }
    else {
	Debug('internal', "unrecognized header: $cmd");
    }
}

sub picrefs {		# process B<> and friends, find possible links
    my ($pod, $char, $match, $htype) = @_;

    Debug('picrefs',"picrefs: pod=$pod char=$char match=$match htype=$htype\n");

    my ($bigkey,$lilkey) = ($match,'');
    $lilkey = $1 if($match =~ /^\W*?(-?\w*).*$/);

    my ($ref, $podname);
    my $key = '';
    my $marker = '';
    # type the same marker only once and ignore nested strings
    unless($match =~ /[\200-\377]/ || ($htype eq 'NAME' &&
	$picref_seen{"$pod:$match"}++)) {
	PODS2: for $podname (correct_order($pod)) {
	    my $value = '';
	    my ($bk,$lk) = (remap($bigkey),remap($lilkey));
	    INNER: for $ref (qw(Headers Items)) {
		if($ref eq 'Items') {
		    $bk =~ s/^([*]|\d+[.]?)\s*//; # strip bullet or digit
		    $lk = ($match =~ /^\W*?(-?\w*).*$/) ? $1 : '';
		}
		if (defined($A->{$podname}->{$ref}->{$bk})) {
		    $key = $bk;
		    $value = $A->{$podname}->{$ref}->{$key};
		    Debug("picrefs", "bigkey is $bk, value is $value, from $podname\n");
		    last INNER;
		}
		elsif ($lk && defined($A->{$podname}->{$ref}->{$lk})) {
		    $key = $lk;
		    $value = $A->{$podname}->{$ref}->{$key};
		    Debug("picrefs", "lilkey is $lk, value is $value, from $podname\n");
		    last INNER;
		}
	    }
	    if (length($key)) {
		my ($pod2,$num) = recover_sym($value);
		$marker = print_marker($htype, $value, "$pod2.$doc_ext");
		last PODS2;
	    }
	}
    }
    if ($char =~ /[IF]/) {
	return noremap("<italic>") . $marker .  $bigkey. noremap("<noitalic>");
    } elsif($char =~ /C/) {
	return noremap("<family Courier>") . $marker . $bigkey .
	    noremap("<family $Font>");
    } elsif($char =~ /S/) {
	$bigkey =~ s/ /\177/g;	# hide the spaces

	# Convert tab's to hidden spaces
	1 while($bigkey =~ s/\t+/"\177" x (length($&) * 8 - length($`) % 8)/e);

	$bigkey =~ s/\177/noremap("<hardspace>")/eg; # make all spaces hard.
	$bigkey =~ s/([\001-\177]|^)/$marker$1/; # insert marker
	#return $marker . $bigkey;
	return $bigkey;
    } elsif($char =~ /B/) {
	return noremap("<bold>") . $marker . $bigkey . noremap("<nobold>");
    }
    return $marker;
}

sub find_refs {			# process all POD markup commands
    my ($pod,$thing,$htype,$par) = @_;

    my $orig = $$thing;

    # Process links first
    # hide formatting
    1 while($$thing =~ s/[IBSCF]<[^<>]*>/noremap($&)/eg);
    $$thing =~ s/L<([^<>]*)>/lrefs($pod,$1,$htype)/gems;
    # unhide formatting
    my $unhide_rx = '['.noremap('IBSCFE')."]$lt"."[^$lt$gt]*$gt";
    1 while($$thing =~ s:$unhide_rx:remap($&):oeg);
    # Hide entities again
    $$thing =~ s/E<[^<>]*>/noremap($&)/eg;

    # print the marker found in scan_thing here
    if($htype eq 'NAME') {
	my $key = canonify($orig);
	my $marker = picrefs($pod, '', $key, $htype);
	if($marker) {
	    # insert the marker immediately before the first printable
	    # characters
	    $$thing =~ s/^((\s*[IBSCF]<)*)/$1$marker/;
	    Debug('find_refs',"inserted marker for '$key'\n");
	}
    }

    # no additional link destinations in headers!
    if($par eq 'Header') {
    	$htype = 'MML';
    }

    my $loop = 1; # loop as long as there were matches
    while($loop) {
	$loop = 0;

	if($$thing =~ s/X<([^<>]*)>/add_index($1)/gems) {
	    $loop = 1;
	}
	if($$thing =~ /([CIBFS])<([^<>]*)>/) {
	    $$thing =~ s/([CIBFS])<([^<>]*)>/picrefs($pod, $1, $2, $htype)/gems;
	    $loop = 1;
	}
    }

    # find references on variables
    $$thing =~ s/[\$\@%](?!&[gl]t)\S[\w:]*/varrefs($pod,$&,$htype)/gems;

    # find references on ...() (commands)
    $$thing =~ s/\b\w+\(\d*\)/picrefs($pod, "I", $&, 'MML')/gems;

}

# make the string as simple as possible
# L<...> is not considered here!

sub canonify {
    my ($str) = @_;

    trim($str);
    # Hide entities temporarily
    $str =~ s/E<[^<>]*>/noremap($&)/eg;
    # remove formatting
    1 while($str =~ s/[IBSCF]<([^<>]*)>/$1/g);
    # be more cruel in next pass
    1 while($str =~ s/[IBSCF]<([^>]*)>/$1/g);
    $str =~ s/[ZX]<[^>]*>//g;
    # collapse whitespace
    $str =~ s/[\s\n]+/ /g;
    # restore entities
    $str =~ tr/\200-\377/\000-\177/;
    $str;
}

sub add_index {			# add an index marker
    my($entry) = @_;

    Debug('index',"Found index entry '$entry'");
    $index{$entry} = canonify($entry);
    return print_marker('INDEX', $entry, '');
}

sub lrefs {			# process the L<> command
    my($pod, $match, $htype) = @_;

    $match =~ s/\s*\n\s*/ /g; # eliminate linebreaks
    Debug('links', "lref: L<$match> htype=$htype\n");
    my $page = $match;
    trim($page);
    my ($text,$item,$marker) = ('','','');
    # Process L<"..."> correctly
    if($page =~ m:^"(.*)"$:) {
	($page,$item) = ('',$1);
    }
    # split off marker text
    if($page =~ m:^([^|]*)\|(.*)$:) {
	($text,$page) = ($1,$2);
	trim($text,$page);
	if($page =~ m:^"(.*)"$:) {
	    ($page,$item) = ('',$1);
	}
    }
    # split off topic from page
    if($page =~ m:^([^/]*)/(.*)$:) {
	($page,$item) = ($1,$2);
	# strip "" from item
	if($item && $item =~ /^"(.*)"$/) {
	    $item = $1;
	}
	trim($page,$item);
    }
    # split off (n) from page
    my $section = '';
    if($page =~ s/^((?:\w|::)+)\s*(\([^)]*\))$/$1/) {
	$section = $2;
    }
    if(!$item && !$Podnames{$page} && (
	$page !~ /^(\w|::)+$/ ||
	defined($A->{$pod}->{'Headers'}->{$1}) ||
	defined($A->{$pod}->{'Items'}->{$1}))) {
	($item,$page) = ($page,'');
    }
    Debug('links', "...resolved to page '$page' item '$item' text '$text'\n");
    $page = '' if($page eq $pod);
    if($text) {
	$text = noremap("<italic>") . "M<>$text" . noremap("<noitalic>");
    }
    elsif($page) {
	if($item) {
	    $text = "the " . noremap("<italic>") . "M<>$item" .
	    noremap("<noitalic>") . " entry in the " .
	    noremap("<italic>") . "$page$section" . noremap("<noitalic>") . 
	    " manpage";
	}
	else {
	    $text = "the " . noremap("<italic>") . "M<>$page$section" .
	    noremap("<noitalic>") . " manpage";
	}
    }
    else {
	$text = "the section on " . noremap("<italic>") . "M<>$item" .
	noremap("<noitalic>");
    }
    $page = $pod unless($page);
    unless($item) {
	if($Podnames{$page}) {
	    Debug('links',"...have pod '$page', done\n");
	    $marker = print_marker("MML", "firstpage", "$page.${doc_ext}");
	} else {
	    warn "Warning: L<$page> unresolved\n";
	}
    } else {
    	my $ref = canonify(remap($item));
    	PODS1: for my $podname (correct_order($pod)) {
	    Debug('links',"scanning '$podname' for '$ref'\n");
	    my ($value,$pod2,$num) = ('','','');
	    if (defined($value = $A->{$podname}->{'Headers'}->{$ref})) {
	    	Debug('links',"...found Header: $value, done\n");
	    	($pod2,$num) = recover_sym($value);
	    	$marker = print_marker( ($pod eq $pod2) ? $htype : "MML",
		    $value, "$pod2.$doc_ext");
		last PODS1;
	    } elsif (defined($value = $A->{$podname}->{'Items'}->{$ref})) {
	    	Debug('links',"...found Item: $value, done\n");
	    	($pod2,$num) = recover_sym($value);
	    	$marker = print_marker( ($pod eq $pod2) ? $htype : "MML",
		    $value, "$pod2.$doc_ext");
		last PODS1;
	    }
        }
	warn "Warning: L<$page/$ref> unresolved\n"
	    unless(length($marker));
    }
    $text =~ s/M<>/$marker/g; # insert marker at appropriate position
    return $text;
}

sub varrefs {			# find references on perl variables
    my ($pod,$var,$htype) = @_;

    return $var if($htype eq 'NAME');
    my $value = '';
    for my $podname (correct_order($pod)) {
	if ($value = $A->{$podname}->{"Items"}->{$var}) {
	    my ($pod2,$num) = recover_sym($value);
	    Debug("vars", "'$var' REF TO '$value'\n");
	    return noremap('<italic>') . print_marker( ($pod eq $pod2) ?
		$htype : "MML", $value, "$pod2.$doc_ext") . $var .
		noremap('<noitalic>');
	}
    }
    return $var;
}

my %sawsym = ();
sub gensym {			# generate a unique symbol from some text
    my ($podname, $key) = @_;

    $key =~ s/\s.*//;
    $key =~ s/E<[^<>]>/_/g;
    ($key = lc($key)) =~ tr/a-z/_/cs;
    $key = '_special' if(!$key || $key eq '_');
    $key .= '_0';
    $key =~ s/__/_/g;
    my $name = "${podname}/$key";
    while ($sawsym{$name}++) {
	$name =~ s/_?(\d+)$/'_' . ($1 + 1)/e;
    }
    return $name;
}

sub recover_sym {
    my ($value) = @_;

    my @parts = split(m:/:,$value,2);
    @parts;
}

sub pre_escapes {   # twiddle these, and stay up late  :-)
    my ($thing) = @_;
    # Return empty string if $$thing is undefined
    unless(defined($$thing)) {
	$$thing = '';
	return '';
    }
    # Remove the Z<> character
    $$thing =~ s/Z<>//g;

    # Hide entities
    $$thing =~ s/E<[^<>]*>/noremap($&)/eg;

    # Return result
    $$thing;
}

sub noremap {	# adding translator for hibit chars soon
    my $hide = $_[0];
    $hide =~ tr/\000-\177/\200-\377/;
    $hide;
}

sub remap {
    my $show = $_[0];
    $show =~ tr/\200-\377/\000-\177/;
    $show;
}

sub trunc {	# undo hiding
    my $show = $_[0];
    $show =~ tr/\200-\377/\000-\177/;
    $show = substr($show,0,55).'...';
    $show;
}

sub post_escapes { # cosmetics end E<> expansion here
    my ($thing) = @_;

    # Escape backslashes
    $$thing =~ s/\\/noremap("\\\\")/eg;

    # convert -- to long dash (m-dash)
    $$thing =~ s/(^|[\s\w])--($|[\s\w])/$1 . noremap("\\xd1 ") . $2/eg;

    # remove all opening garbage left
    $$thing =~ s/[IBSCFLXZE]</do {
	warn "Warning: error near $& in par '".trunc($$thing)."'\n";
	''}/eg;

    # escape all angle brackets left
    1 while($$thing=~s/(^|[^\\])([<>])/do {
	Debug('strict', "unescaped $2 found in '".trunc($$thing)."'\n");
	$1.noremap("\\$2")}/eg);

    # escape quotes
    $$thing=~s/`/\\xd4 /g;
    $$thing=~s/'/\\xd5 /g;

    # Expand previously hidden E<> entities
    # E<[^<>]>
    $$thing =~ s/\305\274([\200-\273\275\277-\377]*)\276/
	do {
	    my $ent = remap($1);
	    exists $HTML_Escapes{$ent}
		? do { $HTML_Escapes{$ent} }
		: do { warn "Warning: Unknown E<$ent> in par '".trunc($$thing)."'\n";
		"E\\<$ent\\>"; }
	}/oegx;

    # undo the noremap characters
    $$thing=~tr/\200-\377/\000-\177/;

    $$thing;
}

sub Debug {
    my $level = shift;
    my $str = remap(join(' ',@_));
    warn "$level: $str" if defined $opt_debug{$level};
}

sub dumptable  {
    my $t = shift;
    print STDERR "TABLE DUMP $t\n";
    foreach my $k (sort keys %$t) {
	printf STDERR "%-20s <%s>\n", $t->{$k}, $k;
    }
}

sub trim {
    for (@_) {
	s/^[\s\n]+//;
	s/[\s\n]+$//;
    }
}

# return consecutive numbers
my $draw_num = 1;
sub draw_a_number {
    return($draw_num++);
}

# ensure that PODs are scanned in the correct way of preference
sub correct_order {
    my ($vip) = @_;

    my %seen = ($vip => 1);
    my @list = sort {$Podnames{$a} <=> $Podnames{$b}}
		grep(!$seen{$_}++,keys %Podnames);
    return($vip,@list);
}

BEGIN {

# Create "Safe" '<' and '>' for use in hypertext markers.

$gt = noremap(">");
$lt = noremap("<");

%HTML_Escapes = (
    amp		=> '&',	#   ampersand
    'lt'	=> "\\<",	#   left chevron, less-than
    'gt'	=> "\\>",	#   right chevron, greater-than
    quot	=> '"',	#   double quote

    Aacut	=> "${lt}Character \\xe7 ${gt}",	#   capital A, acute accent
    aacute	=> "${lt}Character \\x87 ${gt}",	#   small a, acute accent
    Acirc	=> "${lt}Character \\xe5 ${gt}",	#   capital A, circumflex accent
    acirc	=> "${lt}Character \\x89 ${gt}",	#   small a, circumflex accent
    AElig	=> "${lt}Character \\xae ${gt}",	#   capital AE diphthong (ligature)
    aelig	=> "${lt}Character \\xbe ${gt}",	#   small ae diphthong (ligature)
    Agrave	=> "${lt}Character \\xcb ${gt}",	#   capital A, grave accent
    agrave	=> "${lt}Character \\x88 ${gt}",	#   small a, grave accent
    Aring	=> "${lt}Character \\x81 ${gt}",	#   capital A, ring
    aring	=> "${lt}Character \\x8c ${gt}",	#   small a, ring
    Atilde	=> "${lt}Character \\xcc ${gt}",	#   capital A, tilde
    atilde	=> "${lt}Character \\x8b ${gt}",	#   small a, tilde
    Auml	=> "${lt}Character \\x80 ${gt}",	#   capital A, dieresis or umlaut mark
    auml	=> "${lt}Character \\x8a ${gt}",	#   small a, dieresis or umlaut mark
    Ccedil	=> "${lt}Character \\x82 ${gt}",	#   capital C, cedilla
    ccedil	=> "${lt}Character \\x8d ${gt}",	#   small c, cedilla
    Eacute	=> "${lt}Character \\x83 ${gt}",	#   capital E, acute accent
    eacute	=> "${lt}Character \\x8e ${gt}",	#   small e, acute accent
    Ecirc	=> "${lt}Character \\xe6 ${gt}",	#   capital E, circumflex accent
    ecirc	=> "${lt}Character \\x90 ${gt}",	#   small e, circumflex accent
    Egrave	=> "${lt}Character \\xe9 ${gt}",	#   capital E, grave accent
    egrave	=> "${lt}Character \\x8f ${gt}",	#   small e, grave accent
    eth		=> "${lt}Character \\xb6 ${gt}",	#   partial diff sign, similar to icelandic eth
    Euml	=> "${lt}Character \\xe8 ${gt}",	#   capital E, dieresis or umlaut mark
    euml	=> "${lt}Character \\x91 ${gt}",	#   small e, dieresis or umlaut mark
    Iacute	=> "${lt}Character \\xea ${gt}",	#   capital I, acute accent
    iacute	=> "${lt}Character \\x92 ${gt}",	#   small i, acute accent
    Icirc	=> "${lt}Character \\xeb ${gt}",	#   capital I, circumflex accent
    icirc	=> "${lt}Character \\x90 ${gt}",	#   small i, circumflex accent
    Igrave	=> "${lt}Character \\xe9 ${gt}",	#   capital I, grave accent
    igrave	=> "${lt}Character \\x93 ${gt}",	#   small i, grave accent
    Iuml	=> "${lt}Character \\xec ${gt}",	#   capital I, dieresis or umlaut mark
    iuml	=> "${lt}Character \\x95 ${gt}",	#   small i, dieresis or umlaut mark
    Ntilde	=> "${lt}Character \\x84 ${gt}",	#   capital N, tilde
    ntilde	=> "${lt}Character \\x96 ${gt}",	#   small n, tilde
    Oacute	=> "${lt}Character \\xee ${gt}",	#   capital O, acute accent
    oacute	=> "${lt}Character \\x97 ${gt}",	#   small o, acute accent
    Ocirc	=> "${lt}Character \\xef ${gt}",	#   capital O, circumflex accent
    ocirc	=> "${lt}Character \\x99 ${gt}",	#   small o, circumflex accent
    Ograve	=> "${lt}Character \\xf1 ${gt}",	#   capital O, grave accent
    ograve	=> "${lt}Character \\x98 ${gt}",	#   small o, grave accent
    Oslash	=> "${lt}Character \\xaf ${gt}",	#   capital O, slash
    oslash	=> "${lt}Character \\xbf ${gt}",	#   small o, slash
    Otilde	=> "${lt}Character \\xcd ${gt}",	#   capital O, tilde
    otilde	=> "${lt}Character \\x9b ${gt}",	#   small o, tilde
    Ouml	=> "${lt}Character \\x85 ${gt}",	#   capital O, dieresis or umlaut mark
    ouml	=> "${lt}Character \\x9a ${gt}",	#   small o, dieresis or umlaut mark
    szlig	=> "${lt}Character \\xa7 ${gt}",	#   german ss (similar to greek beta)
    Uacute	=> "${lt}Character \\xf2 ${gt}",	#   capital U, acute accent
    uacute	=> "${lt}Character \\x9c ${gt}",	#   small u, acute accent
    Ucirc	=> "${lt}Character \\xf3 ${gt}",	#   capital U, circumflex accent
    ucirc	=> "${lt}Character \\x9e ${gt}",	#   small u, circumflex accent
    Ugrave	=> "${lt}Character \\xf4 ${gt}",	#   capital U, grave accent
    ugrave	=> "${lt}Character \\x9d ${gt}",	#   small u, grave accent
    Uuml	=> "${lt}Character \\x86 ${gt}",	#   capital U, dieresis or umlaut mark
    uuml	=> "${lt}Character \\x9f ${gt}",	#   small u, dieresis or umlaut mark
    yuml	=> "${lt}Character \\xd8 ${gt}",	#   small y, dieresis or umlaut mark
);

# If a =head1 starts with one of these strings, ignore it for the index
$IgnoreHead1rx = join('|',
	'NAME',
	'SYNOPSIS',
	'DESCRIPTION',
	'OPTION',
	'TARGET',
	'RETURN VALUE',
	'ERROR',
	'EXAMPLE',
	'ENVIRONMENT',
	'FILE',
	'SEE ALSO',
	'NOTE',
	'CAVEAT',
	'WARNING',
	'DIAGNOSTIC',
	'BUG',
	'RESTRICTION',
	'AUTHOR',
	'HISTORY',
	'DATE'
	);
}

sub mml_header { qq(
<MML>
<Comment \$Id\$ >
<Comment \$Log\$ >
<Comment "Paragraph Format Definition Section">
<!DefinePar pod_Body
    <LeftIndent $BodyLeft">
    <FirstIndent $BodyIndent">
    <WithNext No>
    <SpaceBefore 6pt>
    <SpaceAfter 6pt>
    <BlockSize 2>
    <pts 12>
>
<!DefinePar pod_TITLE
    <LeftIndent 0">
    <FirstIndent 0">
    <WithNext Yes>
    <SpaceBefore 12pt>
    <SpaceAfter 8pt>
    <pts 14>
    <bold>
>
<!DefinePar pod_head1
    <pts 14>
    <WithNext Yes>
    <SpaceBefore 12pt>
    <SpaceAfter 8pt>
    <bold>
>
<!DefinePar pod_head2
    <pts 14>
    <WithNext Yes>
    <SpaceBefore 12pt>
    <SpaceAfter 8pt>
    <bold>
>
<!DefinePar pod_ol
    <pts 12>
    <WithNext No>
    <SpaceBefore 6pt>
    <SpaceAfter 6pt>
    <nobold>
    <LeftIndent $BodyLeft">
    <FirstIndent $BodyLeft">
    <AutoNumber Yes>
    <NumberFormat "+.\\t">
    <TabStops
        <TabStop $ListTab[0]">
        <TabStop $ListTab[1]">
        <TabStop $ListTab[2]">
    >
>
<!DefinePar pod_ul
    <pts 12>
    <WithNext No>
    <SpaceBefore 6pt>
    <SpaceAfter 6pt>
    <nobold>
    <LeftIndent $BodyLeft">
    <FirstIndent $BodyLeft">
    <AutoNumber Yes>
    <NumberFormat "    \\xa5 \\t">
    <TabStops
        <TabStop $ListTab[0]">
        <TabStop $ListTab[1]">
        <TabStop $ListTab[2]">
    >
>
<!DefinePar pod_il
    <pts 12>
    <WithNext No>
    <SpaceBefore 3pt>
    <SpaceAfter 3pt>
    <nobold>
    <LeftIndent $ilLeft">
    <FirstIndent $ilIndent">
    <AutoNumber No>
    <TabStops
        <TabStop $ilTab[0]">
        <TabStop $ilTab[1]">
        <TabStop $ilTab[2]">
    >
>
<!DefinePar pod_dl
    <family $Font>
    <pts 12>
    <WithNext No>
    <SpaceBefore 6pt>
    <SpaceAfter 6pt>
    <LeftIndent $dlLeft">
    <FirstIndent $dlIndent">
    <AutoNumber Yes>
    <NumberFormat "\\xa5  ">
>
<!DefinePar pod_hi
    <family $Font>
    <pts 12>
    <WithNext No>
    <SpaceBefore 6pt>
    <SpaceAfter 6pt>
    <LeftIndent $BodyLeft">
    <FirstIndent $BodyLeft">
    <AutoNumber No>
    <TabStops
        <TabStop $BodyLeft">
    >
>
<!DefinePar pod_pre
    <family Courier>
    <pts 10>
    <AutoNumber No>
    <LeftIndent $BodyLeft">
    <FirstIndent $BodyLeft">
    <WithNext No>
    <SpaceBefore 0pt>
    <SpaceAfter 0pt>
>

<Comment "Document Layout Section">
<TopMargin $TopMargin>
<BottomMargin $BottomMargin>
<LeftMargin $LeftMargin>
<RightMargin $RightMargin>
<RightFooter "Page #">

<Comment "Document Text Section">
);
}

