"Fossies" - the Fresh Open Source Software Archive

Member "latex2html-2021.2/latex2html.pin" (1 Jul 2021, 626840 Bytes) of package /linux/www/latex2html-2021.2.tar.gz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "latex2html.pin": 2021_vs_2021.2.

    1 #- -*- perl -*-
    2 #
    3 # Comprises patches and revisions by various authors:
    4 #   See Changes, the log file of LaTeX2HTML.
    5 #
    6 # Original Copyright notice:
    7 #
    8 # LaTeX2HTML by Nikos Drakos <nikos@cbl.leeds.ac.uk>
    9 
   10 # ****************************************************************
   11 # LaTeX To HTML Translation **************************************
   12 # ****************************************************************
   13 # LaTeX2HTML is a Perl program that translates LaTeX source
   14 # files into HTML (HyperText Markup Language). For each source
   15 # file given as an argument the translator will create a
   16 # directory containing the corresponding HTML files.
   17 #
   18 # The man page for this program is included at the end of this file
   19 # and can be viewed using "perldoc latex2html"
   20 #
   21 # For more information on this program and some examples of its
   22 # capabilities visit 
   23 #
   24 #          http://www.latex2html.org/
   25 #
   26 # or see the accompanying documentation in the docs/  directory
   27 #
   28 # Original code written by Nikos Drakos, July 1993.
   29 #
   30 # Address: Computer Based Learning Unit
   31 #          University of Leeds
   32 #          Leeds,  LS2 9JT
   33 #
   34 # Copyright (c) 1993-95. All rights reserved.
   35 #
   36 #
   37 # Extensively modified by Ross Moore, Herb Swan and others
   38 #
   39 # Address: Mathematics Department
   40 #          Macquarie University
   41 #          Sydney, Australia, 2109 
   42 #
   43 # Copyright (c) 1996-2001. All rights reserved.
   44 #
   45 # See general license in the LICENSE file.
   46 #
   47 ##########################################################################
   48 
   49 use 5.003; # refuse to work with old and buggy perl version
   50 #use strict;
   51 #use diagnostics;
   52 
   53 # include some perl packages; these come with the standard distribution
   54 use Getopt::Long;
   55 use Fcntl;
   56 use AnyDBM_File;
   57 use POSIX;						# for ceil()
   58 use Encode qw(decode_utf8 encode_utf8);			# for russian UTF-8 hack
   59 
   60 # The following are global variables that also appear in some modules
   61 use vars qw($LATEX2HTMLDIR $LATEX2HTMLPLATDIR $SCRIPT
   62             %Month %used_icons $inside_tabbing $TABLE_attribs
   63             %mathentities $date_name $outer_math $TABLE__CELLPADDING_rx);
   64 
   65 #- NOTE: This file contains a sort of preprocessor information, similar
   66 #- to C's #define statement, so please be careful when removing comments!
   67 #-
   68 #- The (texlive) wrapper sets these values
   69 #- or it is stored in the enviroment
   70 #-
   71 #unless @wrapper@ || @texlive@
   72 BEGIN {
   73   # print "scanning for l2hdir\n";
   74   if($ENV{'LATEX2HTMLDIR'}) {
   75     $LATEX2HTMLDIR = $ENV{'LATEX2HTMLDIR'};
   76   } else {
   77     $ENV{'LATEX2HTMLDIR'} = $LATEX2HTMLDIR = '@LATEX2HTMLDIR@';
   78   }
   79 
   80   if($ENV{'LATEX2HTMLPLATDIR'}) {
   81     $LATEX2HTMLPLATDIR = $ENV{'LATEX2HTMLPLATDIR'};
   82   } else {
   83     $LATEX2HTMLPLATDIR = '@LATEX2HTMLPLATDIR@'||$LATEX2HTMLDIR;
   84     $ENV{'LATEX2HTMLPLATDIR'} = $LATEX2HTMLPLATDIR;
   85   }
   86   if(-d $LATEX2HTMLPLATDIR) {
   87     push(@INC,$LATEX2HTMLPLATDIR);
   88   }
   89 
   90   if(-d $LATEX2HTMLDIR) {
   91     push(@INC,$LATEX2HTMLDIR);
   92   } else {
   93     die qq{Fatal: Directory "$LATEX2HTMLDIR" does not exist.\n};
   94   }
   95 }
   96 #fi
   97 
   98 use L2hos; # Operating system dependent routines
   99 
  100 # $^W = 1; # turn on warnings
  101 
  102 my $RELEASE = '@distver@';
  103 my $REVISION = '@release_date@';
  104 
  105 # The key, which delimts expressions defined in the environment
  106 # depends on the operating system. 
  107 $envkey = L2hos->pathd();
  108 
  109 # $dd is the directory delimiter character
  110 $dd = L2hos->dd();
  111 
  112 # make sure the $LATEX2HTMLDIR is on the search-path for forked processes
  113 if($ENV{'PERL5LIB'}) {
  114   $ENV{'PERL5LIB'} .= "$envkey$LATEX2HTMLDIR"
  115     unless($ENV{'PERL5LIB'} =~ m|\Q$LATEX2HTMLDIR\E|o);
  116 } else {
  117   $ENV{'PERL5LIB'} = $LATEX2HTMLDIR;
  118 }
  119 
  120 # Local configuration, read at runtime
  121 # Read the $CONFIG_FILE  (usually l2hconf.pm )
  122 if($ENV{'L2HCONFIG'}) {
  123   require $ENV{'L2HCONFIG'} ||
  124     die "Fatal (require $ENV{'L2HCONFIG'}): $!";
  125 } else {
  126   eval 'use l2hconf';
  127   if($@) {
  128     die "Fatal (use l2hconf): $@\n";
  129   }
  130 }
  131 
  132 # MRO: Changed this to global value in config/config.pl
  133 # change these whenever you do a patch to this program and then
  134 # name the resulting patch file accordingly
  135 # $TVERSION = "@distver@";
  136 #$TPATCHLEVEL = " beta";
  137 #$TPATCHLEVEL = " release";
  138 #$RELDATE = "(March 30, 1999)";
  139 #$TEX2HTMLV_SHORT = $TVERSION . $TPATCHLEVEL;
  140 
  141 $TEX2HTMLV_SHORT = $RELEASE;
  142 $TEX2HTMLVERSION = "$TEX2HTMLV_SHORT ($REVISION)";
  143 $TEX2HTMLADDRESS = "http://www.latex2html.org/";
  144 
  145 # Set $HOME to what the system considers the home directory
  146 $HOME = L2hos->home();
  147 push(@INC,$HOME);
  148 
  149 # flush stdout with every print -- gives better feedback during
  150 # long computations
  151 $| = 1;
  152 
  153 # set Perl's subscript separator to LaTeX's illegal character.
  154 # (quite defensive but why not)
  155 $; = "\000";
  156 
  157 # No arguments!!
  158 unless(@ARGV) {
  159   die "Error: No files to process!\n";
  160 }
  161 
  162 # Image prefix
  163 #if @texlive@
  164 $IMAGE_PREFIX = L2hos->plat() eq 'dos' ? 'ps' : '_image';
  165 #else
  166   #if @plat@ eq 'dos'
  167 $IMAGE_PREFIX = 'ps';
  168   #else
  169 $IMAGE_PREFIX = '_image';
  170   #fi
  171 #fi - texlive
  172 
  173 # Partition prefix 
  174 $PARTITION_PREFIX = 'part_' unless $PARTITION_PREFIX;
  175 
  176 # Author address - contains user name and date - not used by default
  177 @address_data = &address_data('ISO');
  178 $ADDRESS = "";
  179 
  180 # ensure non-zero defaults
  181 $MAX_SPLIT_DEPTH = 4 unless ($MAX_SPLIT_DEPTH);
  182 $MAX_LINK_DEPTH = 4 unless ($MAX_LINK_DEPTH);
  183 $TOC_DEPTH = 4 unless ($TOC_DEPTH);
  184 
  185 # A global value may already be set in the $CONFIG_FILE
  186 $INIT_FILE_NAME = $ENV{'L2HINIT_NAME'} || '.latex2html-init'
  187    unless $INIT_FILE_NAME;
  188 
  189 # Read the $HOME/$INIT_FILE_NAME if one is found
  190 if (-f "$HOME$dd$INIT_FILE_NAME" && -r _) {
  191     print "Note: Loading $HOME$dd$INIT_FILE_NAME\n";
  192     require("$HOME$dd$INIT_FILE_NAME");
  193     $INIT_FILE = "$HOME$dd$INIT_FILE_NAME";
  194     # _MRO_TODO_: Introduce a version to be checked?
  195     die "Error: You have an out-of-date " . $HOME .
  196 	"$dd$INIT_FILE_NAME file.\nPlease update or delete it.\n"
  197 	if ($DESTDIR eq '.');
  198 }
  199 
  200 # Read the $INIT_FILE_NAME file if one is found in current directory
  201 if ( L2hos->Cwd() ne $HOME && -f ".$dd$INIT_FILE_NAME" && -r _) {
  202     $INIT_FILE = ".$dd$INIT_FILE_NAME";
  203     print "Note: Loading $INIT_FILE\n";
  204     require($INIT_FILE);
  205 }
  206 die "Error: '.' is an incorrect setting for DESTDIR.\n" .
  207     "Please check your $INIT_FILE_NAME file.\n"
  208     if ($DESTDIR eq '.');
  209 
  210 # User home substitutions
  211 $LATEX2HTMLSTYLES =~ s/~([$dd$dd$envkey]|$)/$HOME$1/go;
  212 # the next line fails utterly on non-UNIX systems
  213 $LATEX2HTMLSTYLES =~ s/~([^$dd$dd$envkey]+)/L2hos->home($1)/geo;
  214 
  215 #absolutise the paths
  216 $LATEX2HTMLSTYLES = join($envkey,
  217                         map(L2hos->Make_directory_absolute($_),
  218                                 split(/$envkey/o, $LATEX2HTMLSTYLES)));
  219 
  220 #HWS:  That was the last reference to HOME.  Now set HOME to $LATEX2HTMLDIR,
  221 #	to enable dvips to see that version of .dvipsrc!  But only if we
  222 #	have DVIPS_MODE not set - yes - this is a horrible nasty kludge
  223 # MRO: The file has to be updated by configure _MRO_TODO_
  224 
  225 if ($PK_GENERATION && ! $DVIPS_MODE) {
  226     $ENV{HOME} =  $LATEX2HTMLDIR;
  227     delete $ENV{PRINTER}; # Overrides .dvipsrc
  228 }
  229 
  230 # language of the DTD specified in the <DOCTYPE...> tag
  231 $ISO_LANGUAGE = 'en' unless $ISO_LANGUAGE;
  232 
  233 # Save the command line arguments, quote where necessary
  234 $argv = join(' ', map {/[\s#*!\$%]/ ? "'$_'" : $_ } @ARGV);
  235 
  236 # Pre-process the command line for backward compatibility
  237 foreach(@ARGV) {
  238   s/^--?no_/-no/; # replace e.g. no_fork by nofork
  239   # s/^[+](\d+)$/$1/; # remove + in front of integers
  240 }
  241 
  242 # Process command line options
  243 my %opt;
  244 unless(GetOptions(\%opt, # all non-linked options go into %opt
  245         # option                linkage (optional)
  246         'help|h',
  247         'version|V',
  248         'split=s',
  249         'link=s',
  250         'toc_depth=i',          \$TOC_DEPTH,
  251         'toc_stars!',           \$TOC_STARS,
  252         'short_extn!',          \$SHORTEXTN,
  253         'iso_language=s',       \$ISO_LANGUAGE,
  254         'validate!',            \$HTML_VALIDATE,
  255         'latex!',
  256         'djgpp!',               \$DJGPP,
  257         'fork!',                \$CAN_FORK,
  258         'external_images!',     \$EXTERNAL_IMAGES,
  259         'ascii_mode!',          \$ASCII_MODE,
  260         'lcase_tags!',          \$LOWER_CASE_TAGS,
  261         'ps_images!',           \$PS_IMAGES,
  262         'font_size=s',          \$FONT_SIZE,
  263         'tex_defs!',            \$TEXDEFS,
  264         'navigation!',
  265         'top_navigation!',      \$TOP_NAVIGATION,
  266         'bottom_navigation!',   \$BOTTOM_NAVIGATION,
  267         'auto_navigation!',     \$AUTO_NAVIGATION,
  268         'index_in_navigation!', \$INDEX_IN_NAVIGATION,
  269         'contents_in_navigation!', \$CONTENTS_IN_NAVIGATION,
  270         'next_page_in_navigation!', \$NEXT_PAGE_IN_NAVIGATION,
  271         'previous_page_in_navigation!', \$PREVIOUS_PAGE_IN_NAVIGATION,
  272         'footnode!',
  273         'numbered_footnotes!',  \$NUMBERED_FOOTNOTES,
  274         'prefix=s',             \$PREFIX,
  275         'auto_prefix!',         \$AUTO_PREFIX,
  276         'long_titles=i',        \$LONG_TITLES,
  277         'custom_titles!',       \$CUSTOM_TITLES,
  278         'title|t=s',            \$TITLE,
  279         'rooted!',              \$ROOTED,
  280         'rootdir=s',
  281         'dir=s',                \$FIXEDDIR,
  282         'mkdir',                \$MKDIR,
  283         'use_dvipng!',          \$USE_DVIPNG,
  284         'dvipng_dpi=s',         \$DVIPNG_DPI,
  285         'use_pdftex!',          \$USE_PDFTEX,
  286         'use_luatex!',          \$USE_LUATEX,
  287         'use_luadvi!',          \$USE_LUADVI,
  288         'address=s',            \$ADDRESS,
  289         'noaddress',
  290         'subdir!',
  291         'info=s',               \$INFO,
  292         'noinfo',
  293         'auto_link!',
  294         'reuse=i',              \$REUSE,
  295         'noreuse',
  296         'antialias_text!',      \$ANTI_ALIAS_TEXT,
  297         'antialias!',           \$ANTI_ALIAS,
  298         'transparent!',         \$TRANSPARENT_FIGURES,
  299         'white!',               \$WHITE_BACKGROUND,
  300         'discard!',             \$DISCARD_PS,
  301         'image_type=s',         \$IMAGE_TYPE,
  302         'images!',
  303         'accent_images=s',      \$ACCENT_IMAGES,
  304         'noaccent_images',
  305         'style=s',              \$STYLESHEET,
  306         'parbox_images!',
  307         'math!',
  308         'math_parsing!',
  309         'latin!',
  310         'entities!',            \$USE_ENTITY_NAMES,
  311         'local_icons!',         \$LOCAL_ICONS,
  312         'scalable_fonts!',      \$SCALABLE_FONTS,
  313         'images_only!',         \$IMAGES_ONLY,
  314         'cut_ref_num!',         \$CUT_REF_NUM,
  315         'add_ref_name!',        \$ADD_REF_NAME,
  316         'show_section_numbers!',\$SHOW_SECTION_NUMBERS,
  317         'show_init!',           \$SHOW_INIT_FILE,
  318         'init_file=s',          \$INIT_FILE,
  319         'up_url=s',             \$EXTERNAL_UP_LINK,
  320         'up_title=s',           \$EXTERNAL_UP_TITLE,
  321         'down_url=s',           \$EXTERNAL_DOWN_LINK,
  322         'down_title=s',         \$EXTERNAL_DOWN_TITLE,
  323         'prev_url=s',           \$EXTERNAL_PREV_LINK,
  324         'prev_title=s',         \$EXTERNAL_PREV_TITLE,
  325         'index=s',              \$EXTERNAL_INDEX,
  326         'biblio=s',             \$EXTERNAL_BIBLIO,
  327         'contents=s',           \$EXTERNAL_CONTENTS,
  328         'external_file=s',      \$EXTERNAL_FILE,
  329         'short_index!',         \$SHORT_INDEX,
  330         'unsegment!',           \$UNSEGMENT,
  331         'debug!',               \$DEBUG,
  332         'tmp=s',                \$TMP,
  333         'ldump!',               \$LATEX_DUMP,
  334         'timing!',              \$TIMING,
  335         'verbosity=i',          \$VERBOSITY,
  336         'html_version=s',       \$HTML_VERSION,
  337         'strict!',              \$STRICT_HTML,
  338         'xbit!',                \$XBIT_HACK,
  339         'ssi!',                 \$ALLOW_SSI,
  340         'php!',                 \$ALLOW_PHP,
  341         'test_mode!' # undocumented switch
  342        )) {
  343     &usage();
  344     exit 1;
  345 }
  346 
  347 # interpret options, check option consistency
  348 if(defined $opt{'split'}) {
  349     if ($opt{'split'} =~ /^(\+?)(\d+)$/) {
  350         $MAX_SPLIT_DEPTH = $2;
  351         if ($1) { $MAX_SPLIT_DEPTH *= -1; $REL_DEPTH = 1; }
  352     } else { 
  353         &usage;
  354         die "Error: Unrecognised value for -split: $opt{'split'}\n";
  355     }
  356 }
  357 if(defined $opt{'link'}) {
  358     if ($opt{'link'} =~ /^(\+?)(\d+)$/) {
  359         $MAX_LINK_DEPTH = $2;
  360         if ($1) { $MAX_LINK_DEPTH *= -1 }
  361     } else { 
  362         &usage;
  363         die "Error: Unrecognised value for -link: $opt{'link'}\n";
  364     }
  365 }
  366 if ($HTML_VALIDATE && !$HTML_VALIDATOR) {
  367     die "Error: Need a HTML_VALIDATOR when -validate is specified.\n";
  368 }
  369 &set_if_false($NOLATEX,$opt{latex}); # negate the option...
  370 if ($ASCII_MODE || $PS_IMAGES) {
  371     $EXTERNAL_IMAGES = 1;
  372 }
  373 if ($FONT_SIZE && $FONT_SIZE !~ /^\d+pt$/) {
  374     die "Error: Font size (-font_size) must end with 'pt': $FONT_SIZE\n"
  375 }
  376 &set_if_false($NO_NAVIGATION,$opt{navigation});
  377 &set_if_false($NO_FOOTNODE,$opt{footnode});
  378 if (defined $TITLE && !length($TITLE)) {
  379     die "Error: Empty title (-title).\n";
  380 }
  381 $LONG_LINKPOINT = $TITLE if (defined $TITLE && $LONG_TITLES && $LINKPOINT);
  382 if ($opt{rootdir}) {
  383     $ROOTED = 1;
  384     $FIXEDDIR = $opt{rootdir};
  385 }
  386 if ($FIXEDDIR && !-d $FIXEDDIR) {
  387     if ($MKDIR) {
  388 	print "\n *** creating directory: $FIXEDDIR ";
  389 	die "Failed: $!\n" unless (mkdir($FIXEDDIR, 0755));
  390         # _TODO_ use File::Path to create a series of directories
  391     } else {
  392 	&usage;
  393 	die "Error: Specified directory (-rootdir, -dir) does not exist.\n";
  394     }
  395 }
  396 &set_if_false($NO_SUBDIR, $opt{subdir});
  397 &set_if_false($NO_AUTO_LINK, $opt{auto_link});
  398 if ($opt{noreuse}) {
  399     $REUSE = 0;
  400 }
  401 unless(grep(/^\Q$IMAGE_TYPE\E$/o, @IMAGE_TYPES)) {
  402     die <<"EOF";
  403 Error: No such image type '$IMAGE_TYPE'.
  404        This installation supports (first is default): @IMAGE_TYPES
  405 EOF
  406 }
  407 &set_if_false($NO_IMAGES, $opt{images});
  408 if ($opt{noaccent_images}) {
  409     $ACCENT_IMAGES = '';
  410 }
  411 if($opt{noaddress}) {
  412     $ADDRESS = '';
  413 }
  414 if($opt{noinfo}) {
  415     $INFO = 0;
  416 }
  417 if($ACCENT_IMAGES && $ACCENT_IMAGES !~ /^[a-zA-Z,]+$/) {
  418     die "Error: Single word or comma-list of style words needed for -accent_images, not: $_\n";
  419 }
  420 &set_if_false($NO_PARBOX_IMAGES, $opt{parbox_images});
  421 &set_if_false($NO_SIMPLE_MATH, $opt{math});
  422 if (defined $opt{math_parsing}) {
  423     $NO_MATH_PARSING = !$opt{math_parsing};
  424     $NO_SIMPLE_MATH = !$opt{math_parsing} unless(defined $opt{math});
  425 }
  426 &set_if_false($NO_ISOLATIN, $opt{latin});
  427 if ($INIT_FILE) {
  428     # if ($INIT_FILE !~ /^[.$dd$dd]/) {	# should start with / or .
  429     # 2019-12-18 shige: 2-43)
  430     if ($INIT_FILE !~ /^\./ && !L2hos->is_absolute_path($INIT_FILE)) {
  431 	$INIT_FILE = ".$dd$INIT_FILE";	# so that value of @INC has no effect
  432     }
  433     if (-f $INIT_FILE && -r _) {
  434         print "Note: Initialising with file: $INIT_FILE\n"
  435             if ($DEBUG || $VERBOSITY);
  436         require($INIT_FILE);
  437     } else {
  438         die "Error: Could not find file (-init_file): $INIT_FILE\n";
  439     }
  440 }
  441 foreach($EXTERNAL_UP_LINK, $EXTERNAL_DOWN_LINK, $EXTERNAL_PREV_LINK,
  442         $EXTERNAL_INDEX, $EXTERNAL_BIBLIO, $EXTERNAL_CONTENTS) {
  443     $_ ||= ''; # initialize
  444     s/~/&#126;/g; # protect `~'
  445 }
  446 if($TMP && !(-d $TMP && -w _)) {
  447     die "Error: '$TMP' not usable as temporary directory.\n";
  448 }
  449 if ($opt{help}) {
  450     L2hos->perldoc($SCRIPT);
  451     exit 0;
  452 }
  453 if ($opt{version}) {
  454     &banner();
  455     exit 0;
  456 }
  457 if ($opt{test_mode}) {
  458     $TITLE = 'LaTeX2HTML Test Document';
  459     $TEXEXPAND = "$PERL @srcdir@${dd}texexpand@scriptext@";
  460     $PSTOIMG   = "$PERL @srcdir@${dd}pstoimg@scriptext@";
  461     $ICONSERVER = L2hos->path2URL("@srcdir@${dd}icons");
  462     $TEST_MODE  = 1;
  463     $RGBCOLORFILE = "@srcdir@${dd}styles${dd}rgb.txt";
  464     $CRAYOLAFILE = "@srcdir@${dd}styles${dd}crayola.txt";
  465 }
  466 if (!$ICONSERVER) {	# if we don't have a url to find icons on the web,
  467     $LOCAL_ICONS = 1;	# copy them into the directory for this document
  468 }
  469 if($DEBUG) {
  470     # make the OS-dependent functions more chatty, too
  471     $L2hos::Verbose = 1;
  472 }
  473 
  474 undef %opt; # not needed any more
  475 
  476 #unless @have_images@
  477 print "Warning: This system does not support generation of images\n"
  478   unless($NO_IMAGES);
  479 $NO_IMAGES = 1;
  480 #fi
  481 
  482 $FIXEDDIR = $FIXEDDIR || $DESTDIR || '';  # for backward compatibility
  483 
  484 if ($EXTERNAL_UP_TITLE xor $EXTERNAL_UP_LINK) {
  485     warn "Warning (-up_url, -up_title): Need to specify both a parent URL and a parent title!\n";
  486     $EXTERNAL_UP_TITLE = $EXTERNAL_UP_LINK = "";
  487 }
  488 
  489 if ($EXTERNAL_DOWN_TITLE xor $EXTERNAL_DOWN_LINK) {
  490     warn "Warning (-down_url, -down_title): Need to specify both a parent URL and a parent title!\n";
  491     $EXTERNAL_DOWN_TITLE = $EXTERNAL_DOWN_LINK = "";
  492 }
  493 
  494 # $NO_NAVIGATION = 1 unless $MAX_SPLIT_DEPTH;	#  Martin Wilck
  495 
  496 if ($MAX_SPLIT_DEPTH && $MAX_SPLIT_DEPTH < 0) {
  497     $MAX_SPLIT_DEPTH *= -1; $REL_DEPTH = 1;
  498 }
  499 if ($MAX_LINK_DEPTH && $MAX_LINK_DEPTH < 0) {
  500     $MAX_LINK_DEPTH *= -1; $LEAF_LINKS = 1;
  501 }
  502 
  503 $FOOT_FILENAME = 'footnode' unless ($FOOT_FILENAME);
  504 $NO_FOOTNODE = 1 unless ($MAX_SPLIT_DEPTH || $NO_FOOTNODE);
  505 $NO_SPLIT = 1 unless $MAX_SPLIT_DEPTH; # _MRO_TODO_: is this needed at all?
  506 $SEGMENT = $SEGMENTED = 0;
  507 $NO_MATH_MARKUP = 1;
  508 
  509 # specify the filename extension to use with the generated HTML files
  510 if ($SHORTEXTN) { $EXTN = ".htm"; }	# for HTML files on CDROM
  511 elsif ($ALLOW_PHP) { $EXTN = ".php"; }  # has PHP dynamic includes
  512 	# with server-side includes (SSI) :
  513 elsif ($ALLOW_SSI && !$XBIT_HACK) { $EXTN = ".shtml"; }
  514 	# ordinary names, valid also for SSI with XBit hack :
  515 else { $EXTN = ".html"; }
  516 
  517 $NODE_NAME = 'node' unless (defined $NODE_NAME);
  518 
  519 # space for temporary files
  520 # different to the $TMPDIR for image-generation
  521 # MRO: No directory should end with $dd!
  522 $TMP_ = "TMP";
  523 
  524 $TMP_PREFIX = "l2h" unless ($TMP_PREFIX);
  525 
  526 # This can be set to 1 when using a version of dvips that is safe
  527 # from the "dot-in-name" bug.
  528 # _TODO_ this should be determined by configure
  529 $DVIPS_SAFE = 1;
  530 
  531 $CHARSET = $charset || 'utf-8';
  532 
  533 # This will be set to 1 by polyglossia.perl to mark its own presence
  534 $POLYGLOSSIA = 0;
  535 
  536 $DVIPNG_DPI=200 unless $DVIPNG_DPI;
  537 ####################################################################
  538 #
  539 # If possible, use icons of the same type as generated images
  540 #
  541 if ($IMAGE_TYPE && %{"icons_$IMAGE_TYPE"}) {
  542     %icons = %{"icons_$IMAGE_TYPE"};
  543 }
  544 
  545 ####################################################################
  546 #
  547 # Figure out what options we need to pass to DVIPS and store that in
  548 # the $DVIPSOPT variable.  Also, scaling is taken care of at the
  549 # dvips level if PK_GENERATION is set to 1, so adjust SCALE_FACTORs
  550 # accordingly.
  551 #
  552 if ($SCALABLE_FONTS) {
  553     $PK_GENERATION = 0;
  554     $DVIPS_MODE = '';
  555 }
  556 
  557 if ($PK_GENERATION) {
  558     if ($MATH_SCALE_FACTOR <= 0) { $MATH_SCALE_FACTOR = 1; }
  559     if ($FIGURE_SCALE_FACTOR <= 0) { $FIGURE_SCALE_FACTOR = 1; }
  560     my $saveMSF = $MATH_SCALE_FACTOR;
  561     my $saveFSF = $FIGURE_SCALE_FACTOR;
  562     my $desired_dpi = int($MATH_SCALE_FACTOR*75);
  563     $FIGURE_SCALE_FACTOR = ($METAFONT_DPI / 72) *
  564 	($FIGURE_SCALE_FACTOR / $MATH_SCALE_FACTOR) ;
  565     $MATH_SCALE_FACTOR = $METAFONT_DPI / 72;
  566     $dvi_mag = int(1000 * $desired_dpi / $METAFONT_DPI);
  567     if ($dvi_mag > 1000) {
  568 	&write_warnings(
  569 	    "WARNING: Your SCALE FACTOR is too large for PK_GENERATION.\n" .
  570 	    "         See $CONFIG_FILE for more information.\n");
  571     }
  572 
  573     # RRM: over-sized scaling, using dvi-magnification
  574     if ($EXTRA_IMAGE_SCALE) {
  575 	print "\n *** Images at $EXTRA_IMAGE_SCALE times resolution of displayed size ***\n";
  576 	$desired_dpi = int($EXTRA_IMAGE_SCALE * $desired_dpi+.5);
  577 	print "    desired_dpi = $desired_dpi  METAFONT_DPI = $METAFONT_DPI\n"
  578             if $DEBUG;
  579 	$dvi_mag = int(1000 * $desired_dpi / $METAFONT_DPI);
  580 	$MATH_SCALE_FACTOR = $saveMSF;
  581 	$FIGURE_SCALE_FACTOR = $saveFSF;
  582     }
  583     # no space after "-y", "-D", "-e" --- required by DVIPS under DOS !
  584     my $mode_switch = "-mode $DVIPS_MODE" if $DVIPS_MODE;
  585     $DVIPSOPT .= " -y$dvi_mag -D$METAFONT_DPI $mode_switch -e5 ";
  586 } else { # no PK_GENERATION
  587 #    if ($EXTRA_IMAGE_SCALE) {
  588 #	&write_warnings(
  589 #	   "the \$EXTRA_IMAGE_SCALE feature requires either \$PK_GENERATION=1"
  590 #			. " or the '-scalable_fonts' option");
  591 #	$EXTRA_IMAGE_SCALE = '';
  592 #    }
  593     # MRO: shifted to l2hconf
  594     #$DVIPSOPT .= ' -M';
  595 } # end PK_GENERATION
  596 
  597 # The mapping from numbers to accents.
  598 # These are required to process the \accent command, which is found in
  599 # tables of contents whenever there is an accented character in a
  600 # caption or section title.  Processing the \accent command makes
  601 # $encoded_*_number work properly (see &extract_captions) with
  602 # captions that contain accented characters.
  603 # I got the numbers from the plain.tex file, version 3.141.
  604 
  605 # Missing entries should be looked up by a native speaker.
  606 # Have a look at generate_accent_commands and $iso_8859_1_character_map.
  607 
  608 # MEH: added more accent types
  609 # MRO: only uppercase needed!
  610 %accent_type = (
  611    '18' => 'grave',		# \`
  612    '19' => 'acute',		# `'
  613    '20' => 'caron',		# \v
  614    '21' => 'breve',		# \u
  615    '22' => 'macr',		# \=
  616    '23' => 'ring',		#
  617    '24' => 'cedil',		# \c
  618    '94' => 'circ',		# \^
  619    '95' => 'dot',		# \.
  620    '7D' => 'dblac',		# \H
  621    '7E' => 'tilde',		# \~
  622    '7F' => 'uml',		# \"
  623 );
  624 
  625 &driver;
  626 
  627 exit 0; # clean exit, no errors
  628 
  629 ############################ Subroutines ##################################
  630 
  631 #check that $TMP is writable, if so create a subdirectory
  632 sub make_tmp_dir {
  633     &close_dbm_database if $DJGPP; # to save file-handles
  634 
  635 #if @texlive@
  636     $TMP = "$DESTDIR$dd$TMP_";
  637     unless(-d $TMP) {
  638         mkdir($TMP,0755);
  639     }
  640 #fi
  641     # determine a suitable temporary path
  642     #
  643     $TMPDIR = '';
  644     my @tmp_try = ();
  645     push(@tmp_try, $TMP) if($TMP);
  646     push(@tmp_try, "$DESTDIR$dd$TMP_") if($TMP_);
  647     push(@tmp_try, $DESTDIR) if($DESTDIR);
  648     push(@tmp_try, L2hos->Cwd());
  649 
  650     my $try;
  651     TempTry: foreach $try (@tmp_try) {
  652       next unless(-d $try && -w _);
  653       my $tmp = "$try$dd$TMP_PREFIX$$";
  654       if(mkdir($tmp,0755)) {
  655         $TMPDIR=$tmp;
  656 	last TempTry;
  657       } else {
  658         warn "Warning: Cannot create temporary directory '$tmp': $!\n";
  659       }
  660     }
  661 
  662     $dvips_warning = <<"EOF";
  663 
  664 Warning: There is a '.' in \$TMPDIR, $DVIPS will probably fail.
  665 Set \$TMP to use a /tmp directory, or rename the working directory.
  666 EOF
  667     die ($dvips_warning . "\n\$TMPDIR=$TMPDIR  ***\n\n")
  668 	if ($TMPDIR =~ /\./ && $DVIPS =~ /dvips/ && !$DVIPS_SAFE);
  669 
  670     &open_dbm_database if $DJGPP;
  671 }
  672 
  673 # MRO: set first parameter to the opposite of the second if second parameter is defined
  674 sub set_if_false {
  675     $_[0] = !$_[1] if(defined $_[1]);
  676 }
  677 
  678 sub check_for_dots {
  679     local($file) = @_;
  680     if ($file =~ /\.[^.]*\./ && !$DVIPS_SAFE) {
  681 	die "\n\n\n *** Fatal Error --- but easy to fix ***\n"
  682 	    . "\nCannot have '.' in file-name prefix, else dvips fails on images"
  683 	    . "\nChange the name from  $file  and try again.\n\n";
  684     }
  685 }
  686 
  687 # Process each file ...
  688 sub driver {
  689     local($FILE, $orig_cwd, %unknown_commands, %dependent, %depends_on
  690 	  , %styleID, %env_style, $bbl_cnt, $dbg, %numbered_section);
  691     # MRO: $texfilepath has to be global!
  692     local(%styles_loaded);
  693     $orig_cwd = L2hos->Cwd();
  694 
  695     print "\n *** initialise *** " if ($VERBOSITY > 1);
  696     &initialise;		# Initialise some global variables
  697 
  698     print "\n *** check modes *** " if ($VERBOSITY > 1);
  699     &ascii_mode if $ASCII_MODE;	# Must come after initialization
  700     &titles_language($TITLES_LANGUAGE);
  701     &make_numbered_footnotes if ($NUMBERED_FOOTNOTES);
  702     $dbg = $DEBUG ? "-debug" : "";
  703     $dbg .= (($VERBOSITY>2) ? " -verbose" : "");
  704 
  705     #use the same hashes for all files in a batch
  706     local(%cached_env_img, %id_map, %symbolic_labels, %latex_labels)
  707 	if ($FIXEDDIR && $NO_SUBDIR);
  708 
  709     local($MULTIPLE_FILES,$THIS_FILE);
  710     $MULTIPLE_FILES = 1+$#ARGV if $ROOTED;
  711     print "\n *** $MULTIPLE_FILES file".($MULTIPLE_FILES ? 's: ' : ': ')
  712     	. join(',',@ARGV) . " *** " if ($VERBOSITY > 1);
  713 
  714     local(%section_info, %toc_section_info, %cite_info, %ref_files);
  715     
  716     foreach $FILE (@ARGV) {
  717 	&check_for_dots($FILE) unless $DVIPS_SAFE;
  718 	++$THIS_FILE if $MULTIPLE_FILES;
  719 	do {
  720 	    %section_info = ();
  721 	    %toc_section_info = ();
  722 	    %cite_info = ();
  723 	    %ref_files = ();
  724 	} unless $MULTIPLE_FILES;
  725 	local($bbl_nr) = 1;
  726 
  727 	# The number of reused images and those in images.tex
  728 	local($global_page_num) = (0) unless($FIXEDDIR && $NO_SUBDIR);
  729 	# The number of images in images.tex
  730 	local($new_page_num) = (0); # unless($FIXEDDIR && $NO_SUBDIR);
  731 	local($pid, $sections_rx,
  732 	    , $outermost_level, %latex_body, $latex_body
  733 	    , %encoded_section_number
  734 	    , %verbatim, %new_command, %new_environment
  735 	    , %provide_command, %renew_command, %new_theorem
  736 	    , $preamble, $aux_preamble, $prelatex, @preamble);
  737 
  738 	# must retain these when all files are in the same directory
  739 	# else the images.pl and labels.pl files get clobbered
  740 	unless ($FIXEDDIR && $NO_SUBDIR) {
  741 	    print "\nResetting image-cache" if ($#ARGV);
  742 	    local(%cached_env_img, %id_map, %symbolic_labels, %latex_labels)
  743 	}
  744 
  745 ## AYS: Allow extension other than .tex and make it optional
  746 	($EXT = $FILE) =~ s/.*\.([^\.]*)$/$1/;
  747 	if ( $EXT eq $FILE ) {
  748 	    $EXT = "tex";
  749 	    $FILE =~ s/$/.tex/;
  750 	}
  751 
  752 	#RRM: allow user-customisation, dependent on file-name
  753 	# e.g. add directories to $TEXINPUTS named for the file
  754 	# --- idea due to Fred Drake <fdrake@acm.org>
  755 	&custom_driver_hook($FILE) if (defined &custom_driver_hook);
  756 
  757 # JCL(jcl-dir)
  758 # We need absolute paths for TEXINPUTS here, because
  759 # we change the directory
  760 	if ($orig_cwd eq $texfilepath) {
  761 	    &deal_with_texinputs($orig_cwd);
  762 	} else {
  763 	    &deal_with_texinputs($orig_cwd, $texfilepath);
  764 	}
  765 
  766 	($texfilepath, $FILE) = &get_full_path($FILE);
  767 	$texfilepath = '.' unless($texfilepath);
  768 
  769 	die "Cannot read $texfilepath$dd$FILE \n"
  770 	    unless (-f "$texfilepath$dd$FILE");
  771 
  772 
  773 # Tell texexpand which files we *don't* want to look at.
  774 	$ENV{'TEXE_DONT_INCLUDE'} = $DONT_INCLUDE if $DONT_INCLUDE;
  775 # Tell texexpand which files we *do* want to look at, e.g.
  776 # home-brew style files
  777 	$ENV{'TEXE_DO_INCLUDE'} = $DO_INCLUDE if $DO_INCLUDE;
  778 
  779 	$FILE =~ s/\.[^\.]*$//; ## AYS
  780 	$DESTDIR = ''; # start at empty
  781 	if ($FIXEDDIR) {
  782 	    $DESTDIR = $FIXEDDIR unless ($FIXEDDIR eq '.');
  783 	    if (($ROOTED)&&!($texfilepath eq $orig_cwd)) {
  784 		$DESTDIR .= $dd . $FILE unless $NO_SUBDIR;
  785 	    };
  786 	} elsif ($texfilepath eq $orig_cwd) {
  787 	    $DESTDIR = ($NO_SUBDIR ? '.' : $FILE);
  788 	} else {
  789 	    $DESTDIR = $ROOTED ? '.' : $texfilepath;
  790 	    $DESTDIR .= $dd . $FILE unless $NO_SUBDIR;
  791 	}
  792 	$PREFIX  = "$FILE-" if $AUTO_PREFIX;
  793 
  794 	print "\nOPENING $texfilepath$dd$FILE.$EXT \n"; ## AYS
  795 
  796 	next unless (&new_dir($DESTDIR,''));
  797         # establish absolute path to $DESTDIR
  798 	$DESTDIR = L2hos->Make_directory_absolute($DESTDIR);
  799 #        &make_tmp_dir;
  800 #        print "\nNote: Working directory is $DESTDIR\n";
  801 #        print "Note: Images will be generated in $TMPDIR\n\n";
  802 
  803 # Need to clean up a bit in case there's garbage left
  804 # from former runs.
  805 	if ($DESTDIR) { chdir($DESTDIR) || die "$!\n"; }
  806 	if (opendir (TMP,$TMP_)) {
  807 	    foreach (readdir TMP) {
  808 		L2hos->Unlink("TMP_$dd$_") unless (/^\.\.?$/);
  809 	    }
  810 	    closedir TMP; 
  811 	}
  812 	&cleanup(1);
  813         &make_tmp_dir;
  814         print "\nNote: Working directory is $DESTDIR\n";
  815         print "Note: Images will be generated in $TMPDIR\n\n";
  816 	unless(-d $TMP_) {
  817 	    mkdir($TMP_, 0755) ||
  818 	      die "Cannot create directory '$TMP_': $!\n";
  819 	}
  820 	chdir($orig_cwd);
  821 
  822 # RRM 14/5/98  moved this to occur earlier
  823 ## JCL(jcl-dir)
  824 ## We need absolute paths for TEXINPUTS here, because
  825 ## we change the directory
  826 #	if ($orig_cwd eq $texfilepath) {
  827 #	    &deal_with_texinputs($orig_cwd);
  828 #	} else {
  829 #	    &deal_with_texinputs($orig_cwd, $texfilepath);
  830 #	}
  831 
  832 
  833 # This needs $DESTDIR to have been created ...
  834 	print " *** calling  `texexpand' ***" if ($VERBOSITY > 1);
  835 	local($unseg) = ($UNSEGMENT ? "-unsegment " : "");
  836 
  837 # does DOS need to check these here ?
  838 #	die "File $TEXEXPAND does not exist or is not executable\n"
  839 #	    unless (-x $TEXEXPAND);
  840 	L2hos->syswait("$TEXEXPAND $dbg -auto_exclude $unseg"
  841 		 . "-save_styles \"$DESTDIR$dd$TMP_${dd}styles\" "
  842 		 . ($TEXINPUTS ? "-texinputs \"$TEXINPUTS\" " : '' )
  843 		 . (($VERBOSITY >2) ? "-verbose " : '' )
  844 		 . "-out \"$DESTDIR$dd$TMP_$dd$FILE\" "
  845 		 . "\"$texfilepath$dd$FILE.$EXT\"")
  846 	    && die " texexpand  failed: $!\n";
  847 	print STDOUT "\n ***  `texexpand' done ***\n" if ($VERBOSITY > 1);
  848 
  849 	chdir($DESTDIR) if $DESTDIR;
  850 	$SIG{'INT'} = 'handler';
  851 
  852 	&open_dbm_database;
  853 	&initialise_sections;
  854 	print STDOUT "\n ***  database open ***\n" if ($VERBOSITY > 1);
  855 
  856 	if ($IMAGES_ONLY) {
  857 	    &make_off_line_images;
  858 	} else {
  859 	    &rename_image_files;
  860 	    &load_style_file_translations;
  861 	    &make_language_rx;
  862 	    &make_raw_arg_cmd_rx;
  863 #	    &make_isolatin1_rx unless ($NO_ISOLATIN);
  864 	    &translate_titles;
  865 	    &make_sections_rx;
  866 	    print "\nReading ...";
  867 	    if ($SHORT_FILENAME) {
  868 		L2hos->Rename ("$TMP_$dd$FILE" ,"$TMP_$dd$SHORT_FILENAME" );
  869 		&slurp_input_and_partition_and_pre_process(
  870 		      "$TMP_$dd$SHORT_FILENAME");
  871 	    } else {
  872 		&slurp_input_and_partition_and_pre_process("$TMP_$dd$FILE");
  873 	    }
  874 	    &add_preamble_head;
  875 	    # Create a regular expressions
  876 	    &set_depth_levels;
  877 	    &make_sections_rx;
  878 	    &make_order_sensitive_rx;
  879 	    &add_document_info_page if ($INFO && !(/\\htmlinfo/));
  880 	    &add_bbl_and_idx_dummy_commands;
  881 	    &translate;	# Destructive!
  882 	}
  883 	&style_sheet;
  884 	&close_dbm_database;
  885 	&cleanup();
  886 
  887 #JCL: read warnings from file to $warnings
  888 	local($warnings) = &get_warnings;
  889 	print "\n\n*********** WARNINGS ***********  \n$warnings"
  890 	    if ($warnings || $NO_IMAGES || $IMAGES_ONLY);
  891 	&image_cache_message if ($NO_IMAGES || $IMAGES_ONLY);
  892 	&image_message if ($warnings =~ /Failed to convert/io);
  893 	undef $warnings;
  894 
  895 # JCL - generate directory index entry.
  896 # Yet, a hard link, cause Perl lacks symlink() on some systems.
  897 	do {
  898 	    local($EXTN) = $EXTN;
  899 	    $EXTN =~ s/_\w+(\.html?)/$1/ if ($frame_main_name);
  900 	    local($from,$to) = (eval($LINKPOINT),eval($LINKNAME));
  901 	    $from = &make_long_title($LONG_LINKPOINT) . $EXTN
  902 		if ($LONG_TITLES && $LONG_LINKPOINT);
  903 	    if (length($from) && length($to) && ($from ne $to)) {
  904 		#frames may have altered $EXTN
  905 		$from =~ s/$frame_main_name(\.html?)/$1/ if ($frame_main_name);
  906 		$to =~ s/$frame_main_name(\.html?)/$1/ if ($frame_main_name);
  907 		L2hos->Unlink($to);
  908 		L2hos->Link($from,$to);
  909 	    }
  910 	} unless ($NO_AUTO_LINK || !($LINKPOINT) || !($LINKNAME));
  911 
  912 	&html_validate if ($HTML_VALIDATE && $HTML_VALIDATOR);
  913 
  914 # Go back to the source directory
  915 	chdir($orig_cwd);
  916         $TEST_MODE = $DESTDIR if($TEST_MODE); # save path
  917 	$DESTDIR = '';
  918 	$OUT_NODE = 0 unless $FIXEDDIR;
  919 	$STYLESHEET = '' if ($STYLESHEET =~ /^\Q$FILE./);
  920     }
  921     print "\nUnknown commands: " . join(" ", sort keys %unknown_commands)
  922 	if %unknown_commands;
  923 ###MEH -- math support
  924     print "\nMath commands outside math: " .
  925 	join(" ", sort keys %commands_outside_math) .
  926 	    "\n  Output may look weird or may be faulty!\n"
  927 		if %commands_outside_math;
  928     print "\nDone.\n";
  929     if($TEST_MODE) {
  930       $TEST_MODE =~ s:[$dd$dd]+$::;
  931       print "\nTo view the results, point your browser at:\n",
  932         L2hos->path2URL(L2hos->Make_directory_absolute($TEST_MODE).$dd.
  933         "index$EXTN"),"\n";
  934     }
  935     $end_time = time; 
  936     $total_time = $end_time - $start_time;
  937     print STDOUT join(' ',"Timing:",$total_time,"seconds\n")
  938 	if ($TIMING||$DEBUG||($VERBOSITY > 2));
  939     $_;
  940 }
  941 
  942 sub open_dbm_database {
  943     # These are DBM (unix DataBase Management) arrays which are actually
  944     # stored in external files. They are used for communication between
  945     # the main process and forked child processes;
  946     print STDOUT "\n"; # this mysteriously prevents a core dump !
  947 
  948     dbmopen(%verb, "$TMP_${dd}verb",0755);
  949 #    dbmopen(%verbatim, "$TMP_${dd}verbatim",0755);
  950     dbmopen(%verb_delim, "$TMP_${dd}verb_delim",0755);
  951     dbmopen(%verb_lstopt, "$TMP_${dd}verb_lstopt",0755);
  952     dbmopen(%expanded,"$TMP_${dd}expanded",0755);
  953 # Holds max_id, verb_counter, verbatim_counter, eqn_number
  954     dbmopen(%global, "$TMP_${dd}global",0755);
  955 # Hold style sheet information
  956     dbmopen(%env_style, "$TMP_${dd}envstyles",0755);
  957     dbmopen(%txt_style, "$TMP_${dd}txtstyles",0755);
  958     dbmopen(%styleID, "$TMP_${dd}styleIDs",0755);
  959 
  960 # These next two are used during off-line image conversion
  961 # %new_id_map maps image id's to page_numbers of the images in images.tex
  962 # %image_params maps image_ids to conversion parameters for that image
  963     dbmopen(%new_id_map, "$TMP_${dd}ID_MAP",0755);
  964     dbmopen(%img_params, "$TMP_${dd}IMG_PARAMS",0755);
  965     dbmopen(%orig_name_map, "$TMP_${dd}ORIG_MAP",0755);
  966 
  967     $global{'max_id'} = ($global{'max_id'} | 0);
  968     &read_mydb(\%verbatim, "verbatim");
  969     $global{'verb_counter'} = ($global{'verb_counter'} | 0);
  970     $global{'verbatim_counter'} = ($global{'verbatim_counter'} | 0);
  971 
  972     &read_mydb(\%new_command, "new_command");
  973     &read_mydb(\%renew_command, "renew_command");
  974     &read_mydb(\%provide_command, "provide_command");
  975     &read_mydb(\%new_theorem, "new_theorem");
  976     &read_mydb(\%new_environment, "new_environment");
  977     &read_mydb(\%dependent, "dependent");
  978 #    &read_mydb(\%env_style, "env_style");
  979 #    &read_mydb(\%styleID, "styleID");
  980     # MRO: Why should we use read_mydb instead of catfile?
  981     $preamble = &catfile(&_dbname("preamble"),1) || '';
  982     $prelatex = &catfile(&_dbname("prelatex"),1) || '';
  983     $aux_preamble = &catfile(&_dbname("aux_preamble"),1) || '';
  984     &restore_critical_variables;
  985 }
  986 
  987 sub close_dbm_database {
  988     &save_critical_variables;
  989     dbmclose(%verb); undef %verb;
  990 #    dbmclose(%verbatim); undef %verbatim;
  991     dbmclose(%verb_delim); undef %verb_delim;
  992     dbmclose(%verb_lstopt); undef %verb_lstopt;
  993     dbmclose(%expanded); undef %expanded;
  994     dbmclose(%global); undef %global;
  995     dbmclose(%env_style); undef %env_style;
  996     dbmclose(%style_id); undef %style_id;
  997     dbmclose(%new_id_map); undef %new_id_map;
  998     dbmclose(%img_params); undef %img_params;
  999     dbmclose(%orig_name_map); undef %orig_name_map;
 1000     dbmclose(%txt_style); undef %txt_style;
 1001     dbmclose(%styleID); undef %styleID;
 1002 }
 1003 
 1004 sub clear_images_dbm_database {
 1005     # <Added calls to dbmclose dprhws>
 1006     # %new_id_map will be used by the off-line image conversion process
 1007     #
 1008     dbmclose(%new_id_map);
 1009     dbmclose(%img_params);
 1010     dbmclose(%orig_name_map);
 1011     undef %new_id_map;
 1012     undef %img_params;
 1013     undef %orig_name_map;
 1014     dbmopen(%new_id_map, "$TMP_${dd}ID_MAP",0755);
 1015     dbmopen(%img_params, "$TMP_${dd}IMG_PARAMS",0755);
 1016     dbmopen(%orig_name_map, "$TMP_${dd}ORIG_MAP",0755);
 1017 }
 1018 
 1019 sub initialise_sections {
 1020     local($key);
 1021     foreach $key (keys %numbered_section) {
 1022 	$global{$key} = $numbered_section{$key}}
 1023 }
 1024 
 1025 sub save_critical_variables {
 1026     $global{'math_markup'} = $NO_MATH_MARKUP;
 1027     $global{'charset'} = $CHARSET;
 1028     $global{'charenc'} = $charset;
 1029     $global{'language'} = $default_language;
 1030     $global{'isolatin'} = $ISOLATIN_CHARS;
 1031     $global{'unicode'} = $UNICODE_CHARS;
 1032     if ($UNFINISHED_ENV) {
 1033 	$global{'unfinished_env'} = $UNFINISHED_ENV;
 1034 	$global{'replace_end_env'} = $REPLACE_END_ENV;
 1035     }
 1036     $global{'unfinished_comment'} = $UNFINISHED_COMMENT;
 1037     if (@UNMATCHED_OPENING) {
 1038 	$global{'unmatched'} = join(',',@UNMATCHED_OPENING);
 1039     }
 1040 }
 1041 
 1042 sub restore_critical_variables {
 1043     $NO_MATH_MARKUP = ($global{'math_markup'}|
 1044 	(defined $NO_MATH_MARKUP ? $NO_MATH_MARKUP:1));
 1045     $CHARSET = ($global{'charset'}| $CHARSET);
 1046     $charset = ($global{'charenc'}| $charset);
 1047     $default_language = ($global{'language'}|
 1048 	(defined $default_language ? $default_language:'english'));
 1049     $ISOLATIN_CHARS = ($global{'isolatin'}|
 1050 	(defined $ISOLATIN_CHARS ? $ISOLATIN_CHARS:0));
 1051     $UNICODE_CHARS = ($global{'unicode'}|
 1052 	(defined $UNICODE_CHARS ? $UNICODE_CHARS:0));
 1053     if ($global{'unfinished_env'}) {
 1054 	$UNFINISHED_ENV = $global{'unfinished_env'};
 1055 	$REPLACE_END_ENV = $global{'replace_end_env'};
 1056     }
 1057     $UNFINISHED_COMMENT = $global{'unfinished_comment'};
 1058     if ($global{'unmatched'}) {
 1059 	@UNMATCHED_OPENING = split(',',$global{'unmatched'});
 1060     }
 1061 
 1062     # undef any renewed-commands...
 1063     # so the new defs are read from %new_command
 1064     local($cmd,$key,$code,$dum1,$dum2);
 1065     foreach $key (sort keys %renew_command) {
 1066 	($dum1, $dum2) = ($key, '');
 1067 	$dum1 = $key unless ($dum1 = &normalize($dum1, $dum2));
 1068 	$cmd = "do_cmd_$dum1";
 1069 	$code = "undef \&$cmd"; eval($code) if (defined &$cmd);
 1070 	if ($@) { print "\nundef \&do_cmd_$dum1 failed" }
 1071     }
 1072 }
 1073 
 1074 #JCL: The warnings should have been handled within the DBM database.
 1075 # Unfortunately if the contents of an array are more than ~900 (system
 1076 # dependent) chars long then dbm cannot handle it and gives error messages.
 1077 sub write_warnings { #clean
 1078     my ($str) = @_;
 1079     $str .= "\n" unless($str =~ /\n$/);
 1080     print STDOUT "\n *** Warning: $str" if ($VERBOSITY > 1);
 1081     my $warnings = '';
 1082     if(-f 'WARNINGS') {
 1083         $warnings = &catfile('WARNINGS') || '';
 1084     }
 1085     return () if ($warnings =~ /\Q$str\E/);
 1086     if(open(OUT,">>WARNINGS")) {
 1087         print OUT $str;
 1088         close OUT;
 1089     } else {
 1090         print "\nError: Cannot append to 'WARNINGS': $!\n";
 1091     }
 1092 }
 1093 
 1094 sub get_warnings {
 1095     return &catfile('WARNINGS',1) || '';
 1096 }
 1097 
 1098 # MRO: Standardizing
 1099 sub catfile {
 1100     my ($file,$ignore) = @_;
 1101     unless(open(CATFILE,"<$file")) {
 1102         print "\nError: Cannot read '$file': $!\n"
 1103             unless($ignore);
 1104         return undef;
 1105     }
 1106     local($/) = undef; # slurp in whole file
 1107     my $contents = <CATFILE>;
 1108     close(CATFILE);
 1109     $contents;
 1110 }
 1111 
 1112 
 1113 sub html_validate {
 1114     my ($extn) = $EXTN;
 1115     if ($EXTN !~ /^\.html?$/i) {
 1116 	$extn =~ s/^[^\.]*(\.html?)$/$1/;
 1117     }
 1118     print "\n *** Validating ***\n";
 1119     my @htmls = glob("*$extn");
 1120     my $file;
 1121     foreach $file (@htmls) {
 1122       system("$HTML_VALIDATOR $file");
 1123     }
 1124 }
 1125 
 1126 sub lost_argument {
 1127     local($cmd) = @_;
 1128     &write_warnings("\nincomplete argument to command: \\$cmd");
 1129 }
 1130 
 1131 #-----------------------------------------------------------------------------
 1132 
 1133 # These subroutines should have been handled within the DBM database.
 1134 # Unfortunately if the contents of an array are more than ~900 (system
 1135 # dependent) chars long then dbm cannot handle it and gives error messages.
 1136 # So here we save and then read the contents explicitly.
 1137 sub write_mydb {
 1138     my ($db, $key, $str) = @_;
 1139     &write_mydb_simple($db, "\n$mydb_mark#$key#$str");
 1140 }
 1141 
 1142 # generate the DB file name from the DB name
 1143 sub _dbname {
 1144     "$TMP_$dd$_[0]";
 1145 }
 1146 
 1147 sub write_mydb_simple {
 1148     my ($db, $str) = @_;
 1149     my $file = &_dbname($db);
 1150     if(open(DB,">>$file")) {
 1151         print DB $str;
 1152         close DB;
 1153     } else {
 1154         print "\nError: Cannot append to '$file': $!\n";
 1155     }
 1156 }
 1157 
 1158 sub clear_mydb {
 1159     my ($db) = @_;
 1160     my $file = &_dbname($db);
 1161     if(open(DB,">$file")) {
 1162         close DB;
 1163     } else {
 1164         print "\nError: Cannot clear '$file': $!\n";
 1165     }
 1166 }
 1167 
 1168 # Assumes the existence of a DB file which contains
 1169 # sequences of e.g. verbatim counters and verbatim contents.
 1170 sub read_mydb {
 1171     my ($dbref,$name) = @_;
 1172     my $contents = &catfile(&_dbname($name),1);
 1173     return '' unless(defined $contents);
 1174     my @tmp = split(/\n$mydb_mark#([^#]*)#/, $contents);
 1175     my $i = 1;	# Ignore the first element at 0
 1176     print "\nDBM: $name open..." if ($VERBOSITY > 2);
 1177     while ($i < scalar(@tmp)) {
 1178 	my $tmp1 = $tmp[$i];
 1179         my $tmp2 = $tmp[++$i];
 1180 	$$dbref{$tmp1} = defined $tmp2 ? $tmp2 : '';
 1181 	++$i;
 1182     };
 1183     $contents;
 1184 }
 1185 
 1186 #-----------------------------------------------------------------------------
 1187 
 1188 # Reads in a latex generated file (e.g. .bbl or .aux)
 1189 # It returns success or failure
 1190 # ****** and binds $_ in the caller as a side-effect ******
 1191 sub process_ext_file {
 1192     local($ext) = @_;
 1193     local($found, $extfile,$dum,$texpath);
 1194     $extfile =  $EXTERNAL_FILE||$FILE;
 1195     local($file) = &fulltexpath("$extfile.$ext");
 1196     $found = 0;
 1197     &write_warnings(
 1198 	    "\n$extfile.$EXT is newer than $extfile.$ext: Please rerun latex" . ## AYS
 1199 	    (($ext =~ /bbl/) ? " and bibtex.\n" : ".\n"))
 1200 	if ( ($found = (-f $file)) &&
 1201 	    &newer(&fulltexpath("$extfile.$EXT"), $file)); ## AYS
 1202     if ((!$found)&&($extfile =~ /\.$EXT$/)) {
 1203 	$file = &fulltexpath("$extfile");
 1204 	&write_warnings(
 1205 	    "\n$extfile is newer than $extfile: Please rerun latex" . ## AYS
 1206 	    (($ext =~ /bbl/) ? " and bibtex.\n" : ".\n"))
 1207 	    if ( ($found = (-f $file)) &&
 1208 		&newer(&fulltexpath("$extfile"), $file)); ## AYS
 1209     }
 1210 
 1211     # check in other directories on the $TEXINPUTS paths
 1212     if (!$found) {
 1213 	foreach $texpath (split /$envkey/, $TEXINPUTS ) {
 1214 	    $file = "$texpath$dd$extfile.$ext";
 1215 	    last if ($found = (-f $file));
 1216 	}
 1217     }
 1218     if ( $found ) {
 1219 	print "\nReading $ext file: $file ...";
 1220 	# must allow @ within control-sequence names
 1221 	$dum = &do_cmd_makeatletter();
 1222 	&slurp_input($file);
 1223 	if ($ext =~ /bbl/) {
 1224 	    # remove the \newcommand{\etalchar}{...} since not needed
 1225 	    s/^\\newcommand\{\\etalchar\}[^\n\r]*[\n\r]+//s;
 1226 	}
 1227 	&pre_process;
 1228 	# remove hyperref specific redefinitions
 1229 	s/^.*?\\(ifx|else|fi|gdef|let|global ?\\let)\b.*?\n//mg
 1230 	    if ($ext eq 'aux');
 1231 	&substitute_meta_cmds if (%new_command || %new_environment);
 1232 	if ($ext eq "aux") {
 1233             my $latex_pathname = L2hos->path2latex($file);
 1234 	    $aux_preamble .=
 1235 		"\\AtBeginDocument{\\makeatletter\n\\input $latex_pathname\n\\makeatother\n}\n";
 1236 	    local(@extlines) = split ("\n", $_);
 1237 	    print " translating ".(0+@extlines). " lines " if ($VERBOSITY >1);
 1238 	    local($eline,$skip_to); #$_ = '';
 1239 	    foreach $eline (@extlines) {
 1240 		if ($skip_to) { next unless ($eline =~ s/$O$skip_to$C//) }
 1241 		$skip_to = '';
 1242 		# skip lines added for pdfTeX/hyperref compatibility
 1243 		next if ($eline =~ /^\\(ifx|else|fi|global ?\\let|gdef|AtEndDocument|let)/);
 1244 		# remove \index and \label commands, else invalid links may result
 1245 		$eline =~ s/\\(index|label)\s*($O\d+$C).*\2//g;
 1246 		if ($eline =~ /\\(old)?contentsline/) {
 1247 		    do { local($_,$save_AUX) = ($eline,$AUX_FILE);
 1248 		    $AUX_FILE = 0;
 1249 		    &wrap_shorthand_environments;
 1250 		    #footnote markers upset the numbering
 1251 		    s/\\footnote(mark|text)?//g;
 1252 		    $eline = &translate_environments($_);
 1253 		    $AUX_FILE = $save_AUX;
 1254 		    undef $_ };
 1255 		} elsif ($eline =~ /\\(old)?newlabel/) {
 1256 		    # also get rid of footnotes in labels
 1257 		    $eline =~ s/\\footnote(mark|text)?//g;
 1258 		} elsif ($eline =~ s/^\\\@input//) {
 1259 		    &do_cmd__at_input($eline);
 1260 		    $eline = '';
 1261 		} elsif ($eline =~ s/^\\\@setckpt$O(\d+)$C//) {
 1262 		    $skip_to = $1; next;
 1263 		}
 1264 #	    $eline =~ s/$image_mark#([^#]+)#/print "\nIMAGE:",$img_params{$1},"\n";''/e;
 1265 #		$_ .= &translate_commands(&translate_environments($eline));
 1266 		$_ .= &translate_commands($eline) if $eline;
 1267 	    }
 1268 	    undef @extlines;
 1269 	} elsif ($ext =~ /$caption_suffixes/) {
 1270 	    local(@extlines) = split ("\n", $_);
 1271 	    print " translating ".(0+@extlines). " lines "if ($VERBOSITY >1);
 1272 	    local($eline); $_ = '';
 1273 	    foreach $eline (@extlines) {
 1274 		# remove \index and \label commands, else invalid links may result
 1275 		$eline =~ s/\\(index|label)\s*($O\d+$C).*\2//gso;
 1276                 if ($eline =~ /\\(old)?contentsline/) {
 1277 		    do { local($_,$save_PREAMBLE) = ($eline,$PREAMBLE);
 1278 		    $PREAMBLE = 0;
 1279                     &wrap_shorthand_environments;
 1280                     $eline = &translate_environments($_);
 1281 		    $PREAMBLE = $save_PREAMBLE;
 1282                     undef $_ };
 1283                 }
 1284 		$_ .= &translate_commands($eline);
 1285 	    }
 1286 	    undef @extlines;
 1287 	} else {
 1288 	    print " wrapping " if ($VERBOSITY >1);
 1289 	    &wrap_shorthand_environments;
 1290 	    $_ = &translate_commands(&translate_environments($_));
 1291 	    print " translating " if ($VERBOSITY >1);
 1292 	}
 1293 	print "\n processed size: ".length($_)."\n" if($VERBOSITY>1);
 1294 	$dum = &do_cmd_makeatother();
 1295     } else { 
 1296 	print "\n*** Could not find file: $file ***\n" if ($DEBUG)
 1297     };
 1298     $found;
 1299 }
 1300 
 1301 sub deal_with_texinputs {
 1302 # The dot precedes all, this let's local files override always.
 1303 # The dirs we want are given as parameter list.
 1304     if(!$TEXINPUTS) { $TEXINPUTS = '.' }
 1305     elsif ($TEXINPUTS =~ /^$envkey/) {
 1306 	$TEXINPUTS = '.'.$TEXINPUTS
 1307     };
 1308     if ($ROOTED) {$TEXINPUTS .= "$envkey$FIXEDDIR"}
 1309     $TEXINPUTS = &absolutize_path($TEXINPUTS);
 1310     $ENV{'TEXINPUTS'} = join($envkey,".",@_,$TEXINPUTS,$ENV{'TEXINPUTS'});
 1311 }
 1312 
 1313 # provided by Fred Drake
 1314 sub absolutize_path {
 1315     my ($path) = @_;
 1316     my $npath = '';
 1317     foreach $dir (split /$envkey/o, $path) {
 1318         $npath .= L2hos->Make_directory_absolute($dir) . $envkey;
 1319     }
 1320     $npath =~ s/$envkey$//;
 1321     $npath;
 1322 }
 1323 
 1324 sub add_document_info_page {
 1325     # Uses $outermost_level
 1326     # Nasty race conditions if the next two are done in parallel
 1327     local($X) = ++$global{'max_id'};
 1328     local($Y) = ++$global{'max_id'};
 1329     ###MEH -- changed for math support: no underscores in commandnames
 1330     $_ = join('', $_
 1331 	      , (($MAX_SPLIT_DEPTH <= $section_commands{$outermost_level})?
 1332 		 "\n<HR>\n" : '')
 1333 	      , "\\$outermost_level", "*"
 1334 	      , "$O$X$C$O$Y$C\\infopagename$O$Y$C$O$X$C\n",
 1335 	      , " \\textohtmlinfopage");
 1336 }
 1337 
 1338 
 1339 # For each style file name in TMP_styles (generated by texexpand) look for a
 1340 # perl file in $LATEX2HTMLDIR/styles and load it.
 1341 sub load_style_file_translations {
 1342     local($_, $style, $options, $dir);
 1343     print "\n";
 1344     if ($TEXDEFS) {
 1345 	foreach $dir (split(/$envkey/,$LATEX2HTMLSTYLES)) {
 1346 	    if (-f ($_ = "$dir${dd}texdefs.perl")) {
 1347 		print "\nLoading $_...";
 1348 		require ($_);
 1349 		$styles_loaded{'texdefs'} = 1;
 1350 		last;
 1351 	    }
 1352 	}
 1353     }
 1354 
 1355     # packages automatically implemented
 1356     local($auto_styles) = $AUTO_STYLES;
 1357     $auto_styles .= 'array|' if ($HTML_VERSION > 3.1);
 1358     $auto_styles .= 'tabularx|' if ($HTML_VERSION > 3.1);
 1359     $auto_styles .= 'theorem|';
 1360 
 1361     # these are not packages, but can appear as if class-options
 1362     $auto_styles .= 'psamsfonts|';
 1363     $auto_styles .= 'noamsfonts|';
 1364 
 1365     $auto_styles =~ s/\|$//;
 1366 
 1367     if(open(STYLES, "<$TMP_${dd}styles")) {
 1368         while(<STYLES>) {
 1369             if(s/^\s*(\S+)\s*(.*)$/$style = $1; $options = $2;/eo) {
 1370                 &do_require_package($style);
 1371 	        $_ = $DONT_INCLUDE;
 1372 	        s/:/|/g;
 1373 	        &write_warnings("No implementation found for style \`$style\'\n")
 1374 		    unless ($styles_loaded{$style} || $style =~ /^($_)$/
 1375 			|| $style =~ /$auto_styles/);
 1376 
 1377                 # MRO: Process options for packages
 1378                 &do_package_options($style,$options) if($options);
 1379             }
 1380         }
 1381         close(STYLES);
 1382     } else {
 1383         print "\nError: Cannot read '$TMP_${dd}styles': $!\n";
 1384     }
 1385 }
 1386 
 1387 ################## Weird Special case ##################
 1388 
 1389 # The new texexpand can be told to leave in \input and \include
 1390 # commands which contain code that the translator should simply pass
 1391 # to latex, such as the psfig stuff.  These should still be seen by
 1392 # TeX, so we add them to the preamble ...
 1393 
 1394 sub do_include_lines {
 1395     while (s/$include_line_rx//o) {
 1396 	local($include_line) = &revert_to_raw_tex($&);
 1397 	&add_to_preamble ('include', $include_line);
 1398     }
 1399 }
 1400 
 1401 ########################## Preprocessing ############################
 1402 
 1403 # JCL(jcl-verb)
 1404 # The \verb declaration and the verbatim environment contain simulated
 1405 # typed text and should not be processed. Characters such as $,\,{,and }
 1406 # loose their special meanings and should not be considered when marking
 1407 # brackets etc. To achieve this \verb declarations and the contents of
 1408 # verbatim environments are replaced by markers. At the end the original
 1409 # text is put back into the document.
 1410 # The markers for verb and verbatim are different so that these commands
 1411 # can be restored to what the raw input was just in case they need to
 1412 # be passed to latex.
 1413 
 1414 sub pre_process {
 1415     # Modifies $_;
 1416     #JKR: We need support for some special environments.
 1417     # This has to be here, because  they might contain
 1418     # structuring commands like \section etc.
 1419     local(%comments);
 1420     &pre_pre_process if (defined &pre_pre_process);
 1421     s/\\\\/\\\\ /go;		# Makes it unnecessary to look for escaped cmds
 1422     &replace_html_special_chars;
 1423     # Remove fake environment which should be invisible to LaTeX2HTML.
 1424     s/\001//m;
 1425     s/[%]end\s*{latexonly}/\001/gom;
 1426     s/[%]begin\s*{latexonly}([^\001]*)\001/%/gos;
 1427     s/\001//m;
 1428 
 1429     &preprocess_alltt if defined(&preprocess_alltt);
 1430 
 1431     $KEEP_FILE_MARKERS = 1;
 1432     if ($KEEP_FILE_MARKERS) {
 1433 #	if (s/%%% TEXEXPAND: \w+ FILE( MARKER)? (\S*).*/
 1434 #	    '<tex2html_'.($1?'':'end').'file>'.qq|#$2#|."\n"/em) {
 1435 #	    $_ = "<tex2html_file>#$2#\n". $_ };
 1436 	#RRM: ignore \n at end of included file, else \par may result
 1437 	if (s/(\n{1,2})?%%% TEXEXPAND: \w+ FILE( MARKER)? (\S*).*\n?/
 1438 	    ($2?$1:"\n").'<tex2html_'.($2?'':'end').'file>'.qq|#$3#|."\n"/em) {
 1439 	    $_ = "<tex2html_file>#$3#\n". $_ };
 1440     } else {
 1441 	s/%%% TEXEXPAND[^\n]*\n//gm;
 1442     }
 1443 
 1444     # Move all LaTeX comments into a local list
 1445     s/(^|\G|[^\\])(%.*(\n[ \t]*|$))/print "%";
 1446 	$comments{++$global{'verbatim_counter'}} = "$2";
 1447 	&write_mydb("verbatim", $global{'verbatim_counter'}, $2);
 1448 	"$1$comment_mark".$global{'verbatim_counter'}."\n"/mge;
 1449     # Remove the htmlonly-environment
 1450     s/\\begin\s*{htmlonly}\s*\n?//gom;
 1451     s/\\end\s*{htmlonly}\s*\n?//gom;
 1452     # Remove enviroments which should be invisible to LaTeX2HTML.
 1453     s/\n[^%\n]*\\end\s*{latexonly}\s*\n?/\001/gom;
 1454     s/((^|\n)[^%\n]*)\\begin\s*{latexonly}([^\001]*)\001/$1/gom;
 1455     s/\\end\s*{comment}\s*\n?/\001/gom;
 1456     s/\\begin\s*{comment}([^\001]*)\001//gom;
 1457 
 1458     # this used to be earlier, but that can create problems with comments
 1459     &wrap_other_environments if (%other_environments);
 1460 
 1461 #    s/\\\\/\\\\ /go;		# Makes it unnecessary to look for escaped cmds
 1462     local($next, $esc_del);
 1463     &normalize_language_changes;
 1464     # Patches by #JKR, #EI#, #JCL(jcl-verb)
 1465 
 1466     #protect \verb|\begin/end....|  parts, for LaTeX documentation
 1467     s/(\\verb\*?(.))\\(begin|end)/$1\003$3/g;
 1468 
 1469     local(@processedV);
 1470     local($opt, $style_info,$before, $contents, $after, $env);
 1471     while (($UNFINISHED_COMMENT)||
 1472   (/\\begin\s*($opt_arg_rx)?\s*\{($verbatim_env_rx|$keepcomments_rx)\}/o)) {
 1473 	($opt, $style_info) = ($1,$2);
 1474 	$before=$contents=$after=$env='';
 1475 	if ($UNFINISHED_COMMENT) {
 1476 	    $UNFINISHED_COMMENT =~ s/([^:]*)::(\d+)/$env=$1;$after=$_;
 1477 	        $before = join("",$unfinished_mark,$env,$2,"#");''/e;
 1478 	    print "\nfound the lost \\end{$env}\n";
 1479 	}
 1480 	#RRM: can we avoid copying long strings here ?
 1481 	#     maybe this loop can be an  s/.../../s  with (.*?)
 1482 	#
 1483 	($before, $after, $env) = ($`, $', $3) unless ($env);
 1484 	if (!($before =~ 
 1485      /\\begin(\s*\[[^\]]*\]\s*)?\{($verbatim_env_rx|$keepcomments_rx)\}/)) {
 1486 	    push(@processedV,$before);
 1487 	    print "'";$before = '';
 1488 	}
 1489  	if ($after =~ /\s*\\end\{$env[*]?\}/) { # Must NOT use the s///o option!!!
 1490 	    ($contents, $after) = ($`, $');
 1491  	    $contents =~ s/^\n+/\n/s;
 1492 # 	    $contents =~ s/\n+$//s;
 1493 
 1494 	    # re-insert comments
 1495 	    $contents =~ s/$comment_mark(\d+)\n?/$comments{$1}/g;
 1496 #	    $contents =~ s/$comment_mark(\d+)/$verbatim{$1}/g;
 1497 
 1498 	    # revert '\\ ' -> '\\' only once 
 1499 	    if ($env =~ /rawhtml|$keepcomments_rx/i) {
 1500 		$contents = &revert_to_raw_tex($contents);
 1501 	    } else {
 1502 		$contents =~ s/([^\\](?:\\\\)*\\)([$html_escape_chars])/$1.&special($2)/geos;
 1503 		$contents =~ s/\\\\ /\\\\/go;
 1504 	    }
 1505 
 1506 	    if ($env =~/$keepcomments_rx/) {
 1507 		$verbatim{++$global{'verbatim_counter'}} = "$contents";
 1508 	    } else {
 1509 		&write_mydb("verbatim", ++$global{'verbatim_counter'}, $contents);
 1510 	    }
 1511 #	    $verbatim{$global{'verbatim_counter'}} = "$contents" if ($env =~/$keepcomments_rx/);
 1512 #	    $verbatim{$global{'verbatim_counter'}} = "$contents";
 1513 
 1514 	    if ($env =~ /rawhtml|$keepcomments_rx/i) {
 1515 		if ($before) {
 1516 		    $after = join("",$verbatim_mark,$env
 1517 			      ,$global{'verbatim_counter'},"#",$after);
 1518 		} else {
 1519 		    push (@processedV, join("",$verbatim_mark,$env
 1520 			   ,$global{'verbatim_counter'},"#"));
 1521 		}
 1522 	    } elsif ($env =~ /tex2html_code/) {
 1523 		if ($before) {
 1524 		    $after = join("","\\begin", $opt, "\{verbatim_code\}"
 1525 			  , $verbatim_mark,$env
 1526 			  , $global{'verbatim_counter'},"#"
 1527 			  , "\\end\{verbatim_code\}",$after);
 1528 		} else {
 1529 		    push (@processedV
 1530 			  , join("","\\begin", $opt, "\{verbatim_code\}"
 1531 				 , $verbatim_mark,$env
 1532 				 , $global{'verbatim_counter'},"#"
 1533 				 , "\\end\{verbatim_code\}"));
 1534 		}
 1535 	    } else {
 1536 		if ($before) {
 1537 		    $after = join("","\\begin", $opt, "\{tex2html_preform\}"
 1538 			  , $verbatim_mark,$env
 1539 			  , $global{'verbatim_counter'},"#"
 1540 			  , "\\end\{tex2html_preform\}",$after);
 1541 		} else {
 1542 		    push (@processedV
 1543 			  , join("","\\begin", $opt, "\{tex2html_preform\}"
 1544 				 , $verbatim_mark,$env
 1545 				 , $global{'verbatim_counter'},"#"
 1546 				 , "\\end\{tex2html_preform\}" ));
 1547 		}
 1548 	    }
 1549 	} else {
 1550 	    print "Cannot find \\end{$env}\n";
 1551 	    $after =~ s/$comment_mark(\d+)\n?/$comments{$1}/g;
 1552 #	    $after =~ s/$comment_mark(\d+)/$verbatim{$1}/g;
 1553 	    if ($env =~ /rawhtml|$keepcomments_rx/i) {
 1554                 $after = &revert_to_raw_tex($contents);
 1555 	    } else {
 1556 		$after =~ s/([^\\](?:\\\\)*\\)([$html_escape_chars])/$1.&special($2)/geos;
 1557                 $after =~ s/\\\\ /\\\\/go;
 1558 	    }
 1559 	    if ($env =~/$keepcomments_rx/) {
 1560                 $verbatim{++$global{'verbatim_counter'}} = "$after";
 1561 	    } else {
 1562                 &write_mydb("verbatim", ++$global{'verbatim_counter'}, $after );
 1563 	    }
 1564 	    $after = join("",$unfinished_mark,$env
 1565 			  ,$global{'verbatim_counter'},"#");
 1566 	}
 1567 	$_ = join("",$before,$after);
 1568     }
 1569     print STDOUT "\nsensitive environments found: ".(int(0+@processedV/2))." "
 1570 	if((@processedV)&&($VERBOSITY > 1));
 1571     $_ = join('',@processedV, $_); undef @processedV;
 1572 
 1573     #restore \verb|\begin/end....|  parts, for LaTeX documentation
 1574 #    $_ =~ s/(\\verb\W*?)\003(begin|end)/$1\\$2/g;
 1575     $_ =~ s/(\\verb(;SPM\w+;|\W*?))\003(begin|end)/$1\\$3/g;
 1576 
 1577     # Now do the \verb declarations
 1578     # Patches by: #JKR, #EI#, #JCL(jcl-verb)
 1579     # Tag \verb command and legal opening delimiter with unique number.
 1580     # Replace tagged ones and its contents with $verb_mark & id number if the
 1581     # closing delimiter can be found. After no more \verb's are to tag, revert
 1582     # tagged one's to the original pattern.
 1583     local($del,$contents,$verb_rerun);
 1584     local($id) = $global{'verb_counter'};
 1585     # must tag only one alternation per loop
 1586     ##RRM: can this be speeded up using a list ??
 1587     my $vbmark = $verb_mark;
 1588     while (s/\\verb(\t*\*\t*)(\S)/"<verb$1".++$id.">$2"/e ||
 1589 	    s/\\verb()(\;SPM\w+\;|[^a-zA-Z*\s])/"<verb$1".++$id.">$2"/e ||
 1590 	    s/\\verb(\t\t*)([^*\s])/"<verb$1".++$id.">$2"/e ||
 1591 	    s/\\(lstinline)\s*(\[[^]]*\])?\s*(\;SPM\w+\;|[^a-zA-Z*\s])/"<verb$1".++$id.">$3"/e ||
 1592 	    s/\\(lstinline)\s*(\[[^]]*\])?\s*([^*\s])/"<verb$1".++$id.">$3"/e) {
 1593 
 1594 	if ($1 eq 'lstinline') {
 1595 	    #SGE: retain knowledge and options of \lstinline
 1596 	    $del = $3;
 1597 	    $vb_mark = $verblst_mark;
 1598 	    $verb_lstopt{$id} = $2;
 1599 	} else {
 1600 	    $del = $2;
 1601 	    #RRM: retain knowledge of whether \verb* or \verb
 1602 	    $vb_mark = ($1 =~/^\s*\*/? $verbstar_mark : $verb_mark);
 1603 	}
 1604 	$esc_del = &escape_rx_chars($del);
 1605 	$esc_del = '' if (length($del) > 2);
 1606 
 1607 	# try to find closing delimiter and substitute the complete
 1608 	# statement with $verb_mark or $verbstar_mark or $verblst_mark
 1609 #	s/(<verb[^\d>]*$id>[\Q$del\E])([^$esc_del\n]*)([\Q$del\E]|$comment_mark(\d+)\n?)/
 1610 	s/(<verb[^\d>]*$id>\Q$del\E)([^$esc_del]*?)(\Q$del\E|$comment_mark(\d+)\n?)/
 1611 	    $contents=$2;
 1612 	    if ($4) { $verb_rerun = 1;
 1613 		join('', "\\verb$del", $contents, $comments{$4})
 1614 	    } else {
 1615 		$contents =~ s|\\\\ |\\\\|g;
 1616 		$contents =~ s|\n| |g;
 1617 		$verb{$id}=$contents;
 1618 		$verb_delim{$id}=$del;
 1619 		join('',$vb_mark,$id,$verb_mark)
 1620 	    }
 1621 	/e;
 1622 	# evtl revert inserted space after '\\' if '\' was our delimiter
 1623 	s/($vb_mark$id$verb_mark\\) /$1/e if ($del eq "\\");
 1624     }
 1625     $global{'verb_counter'} = $id;
 1626     # revert changes to fake verb statements
 1627     s/<verb([^\d>]*)\d+>/\\verb$1/g;
 1628 
 1629     #JKR: the comments include the linebreak and the following whitespace
 1630 #   s/([^\\]|^)(%.*\n[ \t]*)+/$1/gom; # Remove Comments but not % which may be meaningful
 1631     s/((^|\n)$comment_mark(\d+))+//gom; # Remove comment markers on new lines, but *not* the trailing \n
 1632     s/(\\\w+|(\W?))($comment_mark\d*\n?)/($2)? $2.$3:($1? $1.' ':'')/egm; # Remove comment markers, not after braces
 1633 #    s/(\W?)($comment_mark\d*\n?)/($1)? $1.$2:''/egm; # Remove comment markers, not after braces
 1634     # Remove comment markers, but *not* the trailing \n
 1635 #  HWS:  Correctly remove multiple %%'s.
 1636 #
 1637     s/\\%/\002/gm;
 1638 #    s/(%.*\n[ \t]*)//gm;
 1639     s/(%[^\n]*\n)[ \t]*/$comment_mark\n/gm;
 1640 
 1641     s/\002/\\%/gm;
 1642 
 1643     local($tmp1,$tmp2);
 1644     s/^$unfinished_mark$keepcomments_rx(\d+)#\n?$verbatim_mark$keepcomments_rx(\d+)#/
 1645 	$verbatim{$4}."\n\\end{$1}"/egm; # Raw TeX
 1646     s/$verbatim_mark$keepcomments_rx(\d+)#/
 1647 	$tmp1 = $1;
 1648 	$tmp2 = &protect_after_comments($verbatim{$2});
 1649 	$tmp2 =~ s!\n$!!s;
 1650 	join ('', "\\begin{$tmp1}"
 1651 		, $tmp2
 1652 		, "\n\\end{$tmp1}"
 1653 		)/egm; # Raw TeX
 1654     s/$unfinished_mark$keepcomments_rx(\d+)#/$UNFINISHED_COMMENT="$1::$2";
 1655 	"\\begin{$1}\n".$verbatim{$2}/egm; # Raw TeX
 1656 
 1657     $KEEP_FILE_MARKERS = 1;
 1658     if ($KEEP_FILE_MARKERS) {
 1659 	s/%%% TEXEXPAND: \w+ FILE( MARKER) (\S*).*\n/
 1660 	    '<tex2html_'.($1?'':'end').'file>'.qq|#.$2#\n|/gem;
 1661     } else {
 1662 	s/%%% TEXEXPAND[^\n]*\n//gm;
 1663     }
 1664 
 1665     &mark_string($_);
 1666 
 1667 
 1668     # attempt to remove the \html \latex and \latexhtml commands
 1669     s/\\latex\s*($O\d+$C)(.*)\1//gm;
 1670     s/\\latexhtml\s*($O\d+$C)(.*)\1\s*($O\d+$C)(.*)\3/$4/sg;
 1671     s/\\html\s*($O\d+$C)(.*)\1/$2/sg;
 1672     s/\\html\s*($O\d+$C)//gm;
 1673 
 1674 #    &make_unique($_);
 1675 }
 1676 
 1677 # RRM:  When comments are retained, then ensure that they are benign
 1678 # by removing \s and escaping braces, 
 1679 # so that environments/bracing cannot become unbalanced.
 1680 sub protect_after_comments {
 1681     my ($verb_text) = @_;
 1682 #    $verb_text =~ s/\%(.*)/'%'.&protect_helper($1)/eg;
 1683     $verb_text =~ s/(^|[^\\])(\\\\)*\%(.*)/$1.$2.'%'.&protect_helper($3)/emg;
 1684     $verb_text;
 1685 }
 1686 
 1687 sub protect_helper {
 1688     my ($text) = @_;
 1689     $text =~ s/\\/ /g;
 1690     $text =~ s/(\{|\})/\\$1/g;
 1691     $text;
 1692 }
 1693 
 1694 sub make_comment {
 1695     local($type,$_) = @_;
 1696     $_ =~ s/\\(index|label)\s*(($O|$OP)\d+($C|$CP)).*\2//sg;
 1697     $_ = &revert_to_raw_tex($_);  s/^\n+//m;
 1698     $_ =~ s/\\(index|label)\s*\{.*\}//sg;
 1699     s/\-\-/- -/g; s/\-\-/- -/g; # cannot have -- inside a comment
 1700     $_ = join('', '<!-- ', $type , "\n ", $_ , "\n -->" );
 1701     $verbatim{++$global{'verbatim_counter'}} = $_;
 1702     &write_mydb('verbatim', $global{'verbatim_counter'}, $_ );
 1703     join('', $verbatim_mark, 'verbatim' , $global{'verbatim_counter'},'#')
 1704 }
 1705 
 1706 sub wrap_other_environments {
 1707     local($key, $env, $start, $end, $opt_env, $opt_start);
 1708     foreach $key (sort keys %other_environments) {
 1709 	# skip bogus entries
 1710 	next unless ($env = $other_environments{$key});
 1711 	$key =~ s/:/($start,$end)=($`,$');':'/e;
 1712 
 1713 	if (($end =~ /^\#$/m) && ($start =~ /^\#/m)) {
 1714 	    # catch Indica pre-processor language switches
 1715 	    $opt_start = $';
 1716 	    if ($env =~ s/\[(\w*)\]//o) {
 1717 		$opt_env = join('','[', ($1 ? $1 : $opt_start ), ']');
 1718 	    }
 1719 	    local($next);
 1720 	    while ($_ =~ /$start\b/) {
 1721 		push(@pre_wrapped, $`, "\\begin\{pre_$env\}", $opt_env );
 1722 		$_=$';
 1723 		if (/(\n*)$end/) {
 1724 		    push(@pre_wrapped, $`.$1,"\\end\{pre_$env\}$1");
 1725 		    $_ = $';
 1726 		    if (!(s/^N(IL)?//o)) {$_ = '#'.$_ }
 1727 		} else {
 1728 		    print "\n *** unclosed $start...$end chunk ***\n";
 1729 		    last;
 1730 		}
 1731 	    }
 1732 	    $_ = join('', @pre_wrapped, $_);
 1733 	    undef @pre_wrapped;
 1734 
 1735 	} elsif (($end=~/^\n$/) && ($start =~ /^\#/)) {
 1736 	    # catch ITRANS pre-processor language info;  $env = 'nowrap';
 1737 	    local($ilang) = $start; $ilang =~ s/^\#//m;
 1738 	    s/$start\s*\=([^<\n%]*)\s*($comment_mark\d*|\n|%)/\\begin\{tex2html_$env\}\\ITRANSinfo\{$ilang\}\{$1\}\n\\end\{tex2html_$env\}$2/g;
 1739 
 1740 	} elsif (!$end &&($start =~ /^\#/m)) {
 1741 	    # catch Indica pre-processor input-mode switches
 1742 	    s/$start(.*)\n/\\begin\{tex2html_$env\}$&\\end\{tex2html_$env\}\n/g;
 1743 
 1744 	} elsif (($start eq $end)&&(length($start) == 1)) {
 1745 	    $start =~ s/(\W)/\\$1/; $end = $start;
 1746 	    s/([^$end])$start([^$end]+)$end/$1\\begin\{pre_$env\}$2\\end\{pre_$env\}/mg;
 1747 	} elsif ($start eq $end) {
 1748 	    if (!($start =~ /\#\#/)) {
 1749 		$start =~ s/(\W)/\\$1/g; $end = $start; }
 1750 	    local (@pre_wrapped);
 1751 	    local($opt); $opt = '[indian]' if ($start =~ /^\#\#$/m);
 1752 	    while ($_ =~ /$start/s) {
 1753 		push(@pre_wrapped, $` , "\\begin\{pre_$env\}$opt");
 1754 		$_=$';
 1755 		if (/$end/s) {
 1756 		    push(@pre_wrapped, $`, "\\end\{pre_$env\}");
 1757 		    $_ = $';
 1758 		} else {
 1759 		    print "\n *** unclosed $start...$end chunk ***\n";
 1760 		    last;
 1761 		}
 1762 	    }
 1763 	    $_ = join('', @pre_wrapped, $_);
 1764 	    undef @pre_wrapped;
 1765 	} elsif ($start && ($env =~ /itrans/)) {
 1766 	    # ITRANS is of this form
 1767 	    local($indic); if($start =~ /\#(\w+)$/m) {$indic = $1}
 1768 	    #include the language-name as an optional parameter
 1769 	    s/$start\b/\\begin\{pre_$env\}\[$indic\]/sg;
 1770 	    s/$end\b/\\end\{pre_$env\}/sg;
 1771 	} elsif (($start)&&($end)) {
 1772 	    s/$start\b/\\begin\{pre_$env\}/sg;
 1773 	    s/$end\b/\\end\{pre_$env\}/sg;
 1774 	}
 1775     }
 1776     $_;
 1777 }
 1778 
 1779 #################### Marking Matching Brackets ######################
 1780 
 1781 # Reads the entire input file and performs pre_processing operations
 1782 # on it before returning it as a single string. The pre_processing is
 1783 # done on separate chunks of the input file by separate Unix processes
 1784 # as determined by LaTeX \include commands, in order to reduce the memory
 1785 # requirements of LaTeX2HTML.
 1786 sub slurp_input_and_partition_and_pre_process {
 1787     local($file) = @_;
 1788     local(%string, @files, $pos);
 1789     local ($count) =  1;
 1790 
 1791     unless(open(SINPUT,"<$file")) {
 1792         die "\nError: Cannot read '$file': $!\n";
 1793     }
 1794     local(@file_string);
 1795     print STDOUT "$file" if ($VERBOSITY >1);
 1796     while (<SINPUT>) {
 1797 	if (/TEXEXPAND: \\include FILE MARKER (\S*)/) {
 1798 	    # Forking seems to screw up the rest of the input stream
 1799 	    # We save the current position ...
 1800 	    $pos = tell SINPUT;
 1801 	    print STDOUT " fork at offset $pos " if ($VERBOSITY >1);
 1802             $string{'STRING'} = join('',@file_string); @file_string = ();
 1803 	    &write_string_out($count);
 1804 	    delete $string{'STRING'};
 1805 	    # ... so that we can return to it
 1806 	    seek(SINPUT, $pos, 0);
 1807 	    print STDOUT "\nDoing $1 ";
 1808 	    ++$count}
 1809 	else {
 1810 #	    $string{'STRING'} .= $_
 1811 	    push(@file_string,$_);
 1812 	}
 1813     }
 1814     $string{'STRING'} = join('',@file_string); @file_string = ();
 1815     &write_string_out($count);
 1816     delete $string{'STRING'};
 1817     close SINPUT;
 1818     @files = ();
 1819     if(opendir(DIR, $TMP_)) {
 1820         @files = sort grep(/^\Q$PARTITION_PREFIX\E\d+/, readdir(DIR));
 1821         closedir(DIR);
 1822     }
 1823 
 1824     unless(@files) {
 1825         die "\nFailed to read in document parts.\n".
 1826 	     "Look up section Globbing in the troubleshooting manual.\n";
 1827     }
 1828 
 1829     $count = 0;
 1830     foreach $file (@files) {
 1831 	print STDOUT "\nappending file: $TMP_$dd$file " if ($VERBOSITY > 1);
 1832         $_ .= (&catfile("$TMP_$dd$file") || '');
 1833 	print STDOUT "\ntotal length: ".length($_)." characters\n" if ($VERBOSITY > 1);
 1834     }
 1835     die "\nFailed to read in document parts (out of memory?).\n"
 1836 	unless length($_);
 1837     print STDOUT "\ntotal length: ".length($_)." characters\n" if ($VERBOSITY > 1);
 1838 }
 1839 
 1840 sub write_string_out {
 1841     local($count) = @_;
 1842     if ($count < 10) {$count = '00'.$count}
 1843     elsif ($count < 100) {$count = '0'.$count}
 1844     local($pid);
 1845     # All open unflushed streams are inherited by the child. If this is
 1846     # not set then the parent will *not* wait
 1847     $| = 1;
 1848     # fork returns 0 to the child and PID to the parent
 1849     &write_mydb_simple("prelatex", $prelatex);
 1850     &close_dbm_database;
 1851     unless ($CAN_FORK) {
 1852 	&do_write_string_out;
 1853     } else {
 1854 	unless ($pid = fork) {
 1855 	    &do_write_string_out;
 1856 	    exit 0;
 1857 	};
 1858 	waitpid($pid,0);
 1859     }
 1860     &open_dbm_database;
 1861 }
 1862 
 1863 sub do_write_string_out {
 1864     local($_);
 1865     close (SINPUT) if($CAN_FORK);
 1866     &open_dbm_database;
 1867     $_ = delete $string{'STRING'};
 1868     # locate blank-lines, for paragraphs.
 1869     # Replace verbatim environments etc.
 1870     &pre_process;
 1871     # locate the blank lines for \par s
 1872     &substitute_pars;
 1873     # Handle newcommand, newenvironment, newcounter ...
 1874     &substitute_meta_cmds;
 1875     &wrap_shorthand_environments;
 1876     print STDOUT "\n *** End-of-partition ***" if ($VERBOSITY > 1);
 1877     if(open(OUT, ">$TMP_$dd$PARTITION_PREFIX$count")) {
 1878         print OUT $_;
 1879         close(OUT);
 1880     } else {
 1881         print "\nError: Cannot write '$TMP_$dd$PARTITION_PREFIX$count': $!\n";
 1882     }
 1883     print STDOUT $_ if ($VERBOSITY > 9);
 1884     $preamble = join("\n",$preamble,@preamble); # undef @preamble;
 1885     &write_mydb_simple("preamble", $preamble);
 1886     # this was done earlier; it should not be repeated
 1887     #&write_mydb_simple("prelatex", $prelatex);
 1888     &write_mydb_simple("aux_preamble", $aux_preamble);
 1889     &close_dbm_database;
 1890 }
 1891 
 1892 # Reads the entire input file into a
 1893 # single string.
 1894 sub slurp_input  {
 1895     local($file) = @_;
 1896     local(%string);
 1897     if(open(INPUT,"<$file")) {
 1898         local(@file_string);
 1899         while (<INPUT>) {
 1900 	    push(@file_string, $_ );
 1901         }
 1902         $string{'STRING'} = join('',@file_string);
 1903         close INPUT;
 1904         undef @file_string;
 1905     } else {
 1906         print "\nError: Cannot read '$file': $!\n";
 1907     }
 1908     $_ = delete $string{'STRING'}; # Blow it away and return the result
 1909 }
 1910 
 1911 # MRO: make them more efficient
 1912 sub special {
 1913     $html_specials{$_[0]} || $_[0];
 1914 }
 1915 
 1916 sub special_inv {
 1917     $html_specials_inv{$_[0]} || $_[0];
 1918 }
 1919 
 1920 sub special_html {
 1921     $html_special_entities{$_[0]} || $_[0];
 1922 }
 1923 
 1924 sub special_html_inv {
 1925     $html_spec_entities_inv{$_[0]} || $_[0];
 1926 }
 1927 
 1928 # Mark each matching opening and closing bracket with a unique id.
 1929 sub mark_string {
 1930     # local (*_) = @_; # Modifies $_ in the caller;
 1931     # -> MRO: changed to $_[0] (same effect)
 1932     # MRO: removed deprecated $*, replaced by option /m
 1933     $_[0] =~ s/(^|[^\\])\\\{/$1tex2html_escaped_opening_bracket/gom;
 1934     $_[0] =~ s/(^|[^\\])\\\{/$1tex2html_escaped_opening_bracket/gom; # repeat this
 1935     $_[0] =~ s/(^|[^\\])\\}/$1tex2html_escaped_closing_bracket/gom;
 1936     $_[0] =~ s/(^|[^\\])\\}/$1tex2html_escaped_closing_bracket/gom; # repeat this
 1937     my $id = $global{'max_id'};
 1938     my $prev_id = $id;
 1939     # mark all balanced braces
 1940     # MRO: This should in fact mark all of them as the hierarchy is
 1941     # processed inside-out.
 1942     1 while($_[0] =~ s/{([^{}]*)}/join("",$O,++$id,$C,$1,$O,$id,$C)/geo);
 1943     # What follows seems esoteric...
 1944     my @processedB = ();
 1945     # Take one opening brace at a time
 1946     while ($_[0] =~ /\{/) { 
 1947 	my ($before,$after) = ($`,$');
 1948         my $change = 0;
 1949 	while (@UNMATCHED_OPENING && $before =~ /\}/) {
 1950             my $this = pop(@UNMATCHED_OPENING);
 1951             print "\n *** matching brace \#$this found ***\n";
 1952             $before =~ s/\}/join("",$O,$this,$C)/eo;
 1953             $change = 1;
 1954         }
 1955         $_[0] = join('',$before,"\{",$after) if($change);
 1956         # MRO: mark one opening brace
 1957 	if($_[0] =~ s/^([^{]*)\{/push(@processedB,$1);join('',$O,++$id,$C)/eos) {
 1958 	    $before=''; $after=$';
 1959         }
 1960         if ($after =~ /\}/) { 
 1961 	    $after =~ s/\}/join("",$O,$id,$C)/eo;
 1962 	    $_[0] = join('',$before,$O,$id,$C,$after);
 1963 	} else {
 1964 	    print "\n *** opening brace \#$id  is unmatched ***\n";
 1965 	    $after =~ /^(.+\n)(.+\n)?/;
 1966 	    print " preceding: $after \n";
 1967 	    push (@UNMATCHED_OPENING,$id);
 1968 	}
 1969     }
 1970     $_[0] = join('',@processedB,$_[0]); undef(@processedB);
 1971     print STDOUT "\nInfo: bracketings found: ", $id - $prev_id,"\n"
 1972         if ($VERBOSITY > 1);
 1973     # process remaining closing braces
 1974     while (@UNMATCHED_OPENING && $_[0] =~ /\}/) {
 1975         my $this = pop(@UNMATCHED_OPENING);
 1976         print "\n *** matching brace \#$this found ***\n";
 1977 	$_[0] =~ s/\}/join("",$O,$this,$C)/eo;
 1978     }
 1979 
 1980     while ($_[0] =~ /\}/) {
 1981         print "\n *** there was an unmatched closing \} ";
 1982         my ($beforeline,$prevline,$afterline) = ($`, $`.$& , $');
 1983         $prevline =~ /\n([^\n]+)\}$/m;
 1984         if ($1) {
 1985 	    print "at the end of:\n" . $1 . "\}\n\n";
 1986         } else {
 1987 	    $afterline =~ /^([^\n]+)\n/m;
 1988 	    if ($1) {
 1989 	        print "at the start of:\n\}" . $1 ."\n\n";
 1990 	    } else {
 1991 	        $prevline =~ /\n([^\n]+)\n\}$/m;
 1992 	        print "on a line by itself after:\n" . $1 . "\n\}\n\n";
 1993 	    }
 1994         }
 1995         $_[0] =  $beforeline . $afterline;
 1996     }
 1997     $global{'max_id'} = $id;
 1998 
 1999     # restore escaped braces
 2000     $_[0] =~ s/tex2html_escaped_opening_bracket/\\{/go;
 2001     $_[0] =~ s/tex2html_escaped_closing_bracket/\\}/go;
 2002 }
 2003 
 2004 sub replace_html_special_chars {
 2005     # Replaces html special characters with markers unless preceded by "\"
 2006     s/([^\\])(<|>|&|\"|``|'')/&special($1).&special($2)/geom;
 2007     # MUST DO IT AGAIN JUST IN CASE THERE ARE CONSECUTIVE HTML SPECIALS
 2008     s/([^\\])(<|>|&|\"|``|'')/&special($1).&special($2)/geom;
 2009     s/^(<|>|&|\"|``|'')/&special($1)/geom;
 2010 }
 2011 
 2012 #  used in \verbatiminput only:   $html_escape_chars = '<>&';
 2013 sub replace_all_html_special_chars { s/([$html_escape_chars])/&special($1)/geom; }
 2014 
 2015 # The bibliography and the index should be treated as separate sections
 2016 # in their own HTML files. The \bibliography{} command acts as a sectioning command
 2017 # that has the desired effect. But when the bibliography is constructed
 2018 # manually using the thebibliography environment, or when using the
 2019 # theindex environment it is not possible to use the normal sectioning
 2020 # mechanism. This subroutine inserts a \bibliography{} or a dummy
 2021 # \textohtmlindex command just before the appropriate environments
 2022 # to force sectioning.
 2023 sub add_bbl_and_idx_dummy_commands {
 2024     local($id) = $global{'max_id'};
 2025 
 2026     s/([\\]begin\s*$O\d+$C\s*thebibliography)/$bbl_cnt++; $1/eg;
 2027     ## if ($bbl_cnt == 1) {
 2028 	s/([\\]begin\s*$O\d+$C\s*thebibliography)/$id++; "\\bibliography$O$id$C$O$id$C $1"/geo;
 2029     #}
 2030     $global{'max_id'} = $id;
 2031     s/([\\]begin\s*$O\d+$C\s*theindex)/\\textohtmlindex $1/o;
 2032     s/[\\]printindex/\\textohtmlindex /o;
 2033     &lib_add_bbl_and_idx_dummy_commands() if defined(&lib_add_bbl_and_idx_dummy_commands);
 2034 }
 2035 
 2036 
 2037 # Uses and modifies $default_language
 2038 # This would be straight-forward except when there are
 2039 #  \MakeUppercase, \MakeLowercase  or \uppercase , \lowercase commands
 2040 # present in the source. The cases have to be adjusted before the
 2041 # ISO-character code is set; e.g. with "z --> "Z  in  german.perl
 2042 #
 2043 sub convert_iso_latin_chars {
 2044     local($_) = @_;
 2045     local($next_language, $pattern);
 2046     local($xafter, $before, $after, $funct, $level, $delim);
 2047     local(@case_processed);
 2048     while (/$case_change_rx/) {
 2049 	$xafter = $2;
 2050 #	$before .= $`;
 2051 	push(@case_processed, $`);
 2052 	$funct = $3;
 2053 	$after = '';
 2054 	$_ = $';
 2055 	if ($xafter =~ /noexpand/) { $before .= "\\$funct"; next; }
 2056 
 2057 	s/^[\s%]*(.)/$delim=$1;''/eo;
 2058 	if ($delim =~ /{/ ) {
 2059             # brackets not yet numbered...
 2060 #	    $before .= $funct . $delim;
 2061 	    push(@case_processed, $funct . $delim);
 2062 	    $level = 1;
 2063 	    $after = $delim;
 2064 	    while (($level)&&($_)&&(/[\{\}]/)) {
 2065 		$after .= $` . $&;
 2066 		$_ = $';
 2067 		if ( "$&" eq "\{" ) {$level++}
 2068 		elsif ( "$&" eq "\}" ) { $level-- }
 2069 		else { print $_ }
 2070 		print "$level";
 2071 	    } 
 2072 #	    $before .= $after;
 2073 	    push(@case_processed, $after);
 2074 	} elsif ($delim eq "<") {
 2075             # brackets numbered, but maybe not processed...
 2076 	    s/((<|#)(\d+)(>|#)>).*\1//;
 2077 	    $after .= $delim . $&;
 2078 	    $_ = $';
 2079 	    print STDOUT "\n<$2$funct$4>" if ($VERBOSITY > 2);
 2080 	    $funct =~ s/^\\//o;
 2081 	    local($cmd) = "do_cmd_$funct";
 2082 	    $after = &$cmd($after);
 2083 #	    $before .= $after;
 2084 	    push(@case_processed, $after);
 2085 	} elsif (($xafter)&&($delim eq "\\")) {
 2086 	    # preceded by \expandafter ...
 2087 	    # ...so expand the following macro first
 2088 	    $funct =~ s/^\\//o;
 2089 	    local($case_change) = $funct;
 2090 	    s/^(\w+|\W)/$funct=$1;''/eo;
 2091 	    local($cmd) = $funct;
 2092 	    local($thiscmd) = "do_cmd_$funct";
 2093 	    if (defined &$thiscmd) { $_ = &$thiscmd($_) }
 2094 	    elsif ($new_command{$funct}) { 
 2095 		local($argn, $body, $opt) = split(/:!:/, $new_command{$funct});
 2096 		do { ### local($_) = $body;
 2097 		     &make_unique($body);
 2098 		} if ($body =~ /$O/);
 2099 		if ($argn) {
 2100 		    do { 
 2101 			local($before) = '';
 2102 			local($after) = "\\$funct ".$_;
 2103 			$after = &substitute_newcmd;   # may change $after
 2104 			$after =~ s/\\\@#\@\@/\\/o ;
 2105 		    }
 2106 		} else { $_ = $body . $_; }
 2107 	    } else { print "\nUNKNOWN COMMAND: $cmd "; }
 2108 
 2109 	    $cmd = $case_change;
 2110 	    $case_change = "do_cmd_$cmd";
 2111 	    if (defined &$case_change) { $_ = &$case_change($_) }
 2112 	} else {
 2113             # this should not happen, but just in case...
 2114 	    $funct =~ s/^\\//o;
 2115 	    local($cmd) = "do_cmd_$funct";
 2116 	    print STDOUT "\n\n<$delim$funct>" if ($VERBOSITY > 2);
 2117 	    $_ = join('', $delim , $_ );
 2118 	    if (defined &$cmd) { $_ = &$cmd($_) }
 2119 	}
 2120     }
 2121 #   $_ = join('', $before, $_) if ($before);
 2122     $_ = join('', @case_processed, $_) if (@case_processed);
 2123 
 2124     # ...now do the conversions
 2125     ($before, $after, $funct) = ('','','');
 2126     @case_processed = ();
 2127     if (/$language_rx/) { # Must NOT use the //o option!!!
 2128 	($next_language, $pattern, $before, $after) = (($2||$1), $&, $`, $');
 2129 	$before = &convert_iso_latin_chars($before) if ($before);
 2130 #	push(@case_processed, $pattern, $before);
 2131 	local($br_id) = ++$global{'max_id'};
 2132 	$pattern = join('' , '\selectlanguage', $O.$br_id.$C
 2133 	    , (($pattern =~ /original/) ? $TITLES_LANGUAGE : $next_language )
 2134 	    , $O.$br_id.$C );
 2135 	push(@case_processed, $before, $pattern);
 2136 	push(@language_stack, $default_language);
 2137 	$default_language = $next_language;
 2138 	$_ = &convert_iso_latin_chars($after);
 2139 	$default_language = pop @language_stack;
 2140     } else {
 2141 	$funct = $language_translations{$default_language};
 2142 	(defined(&$funct) ? $_ = &$funct($_) :
 2143 	 do {   &write_warnings(
 2144 		"\nCould not find translation function for $default_language.\n\n")
 2145 	    }
 2146 	);
 2147     }
 2148     $_ = join('', @case_processed, $_); undef(@case_processed);
 2149     $_;
 2150 }
 2151 
 2152 # May need to add something here later
 2153 sub english_translation { $_[0] }
 2154 
 2155 # This replaces \setlanguage{\language} with \languageTeX
 2156 # This makes the identification of language chunks easier.
 2157 sub normalize_language_changes {
 2158     s/$setlanguage_rx/\\$2TeX/gs;
 2159 }
 2160 
 2161 sub get_current_language {
 2162     return () if ($default_language eq $TITLES_LANGUAGE);
 2163     local($lang,$lstyle) = ' LANG="';
 2164     $lang_code = $iso_languages{$default_language};
 2165     if (%styled_languages) {
 2166 	$lstyle = $styled_languages{$default_language};
 2167 	$lstyle = '" CLASS="'.$lstyle  if $lstyle;
 2168     }
 2169     ($lang_code ? $lang.$lang_code.$lstyle.'"' : '');
 2170 }
 2171 
 2172 %styled_languages = ();
 2173 
 2174 sub do_cmd_htmllanguagestyle {
 2175     local($_) = @_;
 2176     local($class) = &get_next_optional_argument;
 2177     local($lang) = &missing_braces unless (
 2178 	(s/$next_pair_pr_rx/$lang=$2;''/e)
 2179 	||(s/$next_pair_rx/$lang=$2;''/e));
 2180     return ($_) unless $lang;
 2181     local($class) = $iso_languages{$lang} unless $class;
 2182     if ($USING_STYLES && $class) {
 2183 	print "\nStyling language: $lang = \"$class\" ";
 2184     	$styled_languages{"$lang"} = $class;
 2185     }
 2186     $_;
 2187 }
 2188 
 2189 # General translation mechanism:
 2190 #
 2191 #
 2192 # The main program latex2html calls texexpand with the document name
 2193 # in order to expand some of its \input and \include statements, here
 2194 # also called 'merging', and to write a list of sensitized style, class,
 2195 # input, or include file names.
 2196 # When texexpand has finished, all is contained in one file, TMP_foo.
 2197 # (assumed foo.tex is the name of the document to translate).
 2198 #
 2199 # In this version, texexpand cares for following environments
 2200 # that may span include files / section boundaries:
 2201 # (For a more technical description, see texexpand.)
 2202 #  a) \begin{comment}
 2203 #  b) %begin{comment}
 2204 #  c) \begin{any}  introduced with \excludecomment
 2205 #  d) %begin{any}
 2206 #  e) \begin{verbatim}
 2207 #  f) \begin{latexonly}
 2208 #  g) %begin{latexonly}
 2209 # 
 2210 # a)-d) cause texexpand to drop its contents, it will not show up in the
 2211 # output file. You can use this to 'comment out' a bunch of files, say.
 2212 # 
 2213 # e)-g) prevent texexpand from expanding input files, but the environment
 2214 # content goes fully into the output file.
 2215 # 
 2216 # Together with each merging of \input etc. there are so-called %%%texexpand
 2217 # markers accompanying the boundary.
 2218 #
 2219 # When latex2html reads in the output file, it uses these markers to write
 2220 # each part to a separate file, and process them further.
 2221 #
 2222 #
 2223 # If you have, for example:
 2224 #
 2225 # a) preample
 2226 # b) \begin{document}
 2227 # c) text
 2228 # d) \include{chapter}
 2229 # e) more text
 2230 # f) \end{document}
 2231 #
 2232 # you end up in two parts, part 1 is a)-c), part 2 is the rest.
 2233 # Regardless of environments spanning input files or sections.
 2234 #
 2235 #
 2236 # What now starts is meta command substitution:
 2237 # Therefore, latex2html forks a child process on the first part and waits
 2238 # until it finished, then forks another on the next part and so forth
 2239 # (see also &slurp_input_and_partition_and_preprocess).
 2240 #
 2241 # Here's what each child is doing:
 2242 # Each child process reads the new commands translated so far by the previous
 2243 # child from the TMP_global DBM database.
 2244 # After &pre_processing, it substitutes the meta commands (\newcommand, \def,
 2245 # and the like) it finds, and adds the freshly retrieved new commands to the
 2246 # list so far.
 2247 # This is done *only on its part* of the document; this saves upwards of memory.
 2248 # Finally, it writes its list of new commands (synopsis and bodies) to the
 2249 # DBM database, and exits.
 2250 # After the last child finished, latex2html reads in all parts and
 2251 # concatenates them.
 2252 #
 2253 #
 2254 # So, at this point in time (start of &translate), it again has the complete
 2255 # document, but now preprocessed and with new commands substituted.
 2256 # This has several disadvantages: an amount of commands is substituted (in
 2257 # TeX lingo, expanded) earlier than the rest.
 2258 # This causes trouble if commands really must get expanded at the point
 2259 # in time they show up.
 2260 #
 2261 #
 2262 # Then, still in &translate, latex2html uses the list of section commands to
 2263 # split the complete document into chunks.
 2264 # The chunks are not written to files yet. They are retained in the @sections
 2265 # list, but each chunk is handled separately.
 2266 # latex2html puts the current chunk to $_ and processes it with
 2267 # &translate_environments etc., then fetches the next chunk, and so on.
 2268 # This prevents environments that span section boundaries from getting
 2269 # translated, because \begin and \end cannot find one another, to say it this
 2270 # way.
 2271 #
 2272 #
 2273 # After the chunk is translated to HTML, it is written to a file.
 2274 # When all chunks are done, latex2html rereads each file to get cross
 2275 # references right, replace image markers with the image file names, and
 2276 # writes index and bibliography.
 2277 #
 2278 #
 2279 sub translate {
 2280     &normalize_sections;	# Deal with the *-form of sectioning commands
 2281 
 2282     # Split the input into sections, keeping the preamble together
 2283     # Due to the regular expression, each split will create 5 more entries.
 2284     # Entry 1 and 2: non-letter/letter sectioning command,
 2285     # entry 4: the delimiter (may be empty)
 2286     # entry 5: the text.
 2287     local($pre_section, @sections);
 2288     if (/\\(startdocument|begin\s*($O\d+$C)\s*document\s*\2)/) {
 2289 	$pre_section = $`.$&; $_ = $';
 2290     }
 2291     @sections = split(/$sections_rx/, $_);
 2292     $sections[0] = $pre_section.$sections[0] if ($pre_section);
 2293     undef $pre_section;
 2294     local($sections) = int(scalar(@sections) / 5);
 2295 
 2296     # Initialises $curr_sec_id to a list of 0's equal to
 2297     # the number of sectioning commands.
 2298     local(@curr_sec_id) = split(' ', &make_first_key);
 2299     local(@segment_sec_id) = @curr_sec_id;
 2300     local($i, $j, $current_depth) = (0,0,0);
 2301     local($curr_sec) = $SHORT_FILENAME||$FILE;
 2302     local($top_sec) = ($SEGMENT ? '' : 'top of ');
 2303 #    local(%section_info, %toc_section_info, $CURRENT_FILE, %cite_info, %ref_files);
 2304     local($CURRENT_FILE);
 2305     # These filenames may be set when translating the corresponding commands.
 2306     local($tocfile, $loffile, $lotfile, $nomfile, $footfile, $citefile, $idxfile,
 2307 	  $figure_captions, $table_captions, $footnotes, $citations, %font_size, %index,
 2308 	  %done, $t_title, $t_author, $t_date, $t_address, $t_affil, $changed);
 2309     local(@authors,@affils,@addresses,@emails,@authorURLs);
 2310     local(%index_labels, %index_segment, $preindex, %footnotes, %citefiles);
 2311     local($segment_table_captions, $segment_figure_captions);
 2312     local($dir,$nosave) = ('','');
 2313     local($del,$close_all,$open_all,$toc_sec_title,$multiple_toc);
 2314     local($open_tags_R) = [];
 2315     local(@save_open_tags)= ();
 2316     local(@language_stack) = ();
 2317     push (@language_stack, $default_language);
 2318 
 2319 #    $LATEX_FONT_SIZE = '10pt' unless ($LATEX_FONT_SIZE);
 2320     &process_aux_file 
 2321 	if $SHOW_SECTION_NUMBERS || /\\(caption|(html|hyper)?((eq)?ref|cite))/;
 2322 
 2323     if (-f "${PREFIX}internals.pl") {
 2324 	my $file = "${PREFIX}internals.pl";
 2325 	if (!L2hos->is_absolute_path($file)) {
 2326 	    $file = ".$dd$file";
 2327 	}
 2328 	require ($file);
 2329     }
 2330 #JCL(jcl-del)
 2331     &make_single_cmd_rx;
 2332 #
 2333     $tocfile = $EXTERNAL_CONTENTS;
 2334     $idxfile = $EXTERNAL_INDEX;
 2335     $citefile = $EXTERNAL_BIBLIO; $citefile =~ s/#.*$//;
 2336     $citefiles{1} = $citefile if ($citefile);
 2337     print "\nTranslating ...";
 2338 
 2339     while ($i <= @sections) {
 2340         undef $_;
 2341 	$_ = $sections[$i];
 2342 	s/^[\s]*//;		# Remove initial blank lines
 2343 
 2344 	# The section command was removed when splitting ...
 2345 	s/^/\\$curr_sec$del/  if ($i > 0); # ... so put it back
 2346 	if ($current_depth < $MAX_SPLIT_DEPTH)  {
 2347 	    if (($footnotes)&&($NO_FOOTNODE)&&( $current_depth < $MAX_SPLIT_DEPTH)) {
 2348 		local($thesenotes) = &make_footnotes ;
 2349 		print OUTPUT $thesenotes;
 2350 	    }
 2351 	    $CURRENT_FILE = &make_name($curr_sec, join('_',@curr_sec_id));
 2352 	    
 2353 	    open(OUTPUT, ">$CURRENT_FILE")
 2354 		|| die "Cannot write '$CURRENT_FILE': $!\n";
 2355 	    if ($XBIT_HACK) { # use Apache's XBit hack
 2356 		chmod 0744, $CURRENT_FILE;
 2357 		&check_htaccess;
 2358 	    } else {
 2359 		chmod 0644, $CURRENT_FILE;
 2360 	    }
 2361 
 2362 	    if ($MULTIPLE_FILES && $ROOTED) {
 2363 	        if ($DESTDIR =~ /^\Q$FIXEDDIR\E[$dd$dd]?([^$dd$dd]+)/)
 2364 	            { $CURRENT_FILE = "$1$dd$CURRENT_FILE" };
 2365 	    }
 2366 	}
 2367 	&remove_document_env;
 2368 #        &wrap_shorthand_environments;    #RRM  Is this needed ?
 2369 	print STDOUT "\n" if ($VERBOSITY);
 2370 	print STDOUT "\n" if ($VERBOSITY > 2);
 2371 	print $i/5,"/$sections";
 2372 	print ":$top_sec$curr_sec:" if ($VERBOSITY);
 2373 
 2374 	# Must do this early ... It also sets $TITLE
 2375 	&process_command($sections_rx, $_) if (/^$sections_rx/);
 2376 	# reset tags saved from the previous section
 2377 	$open_tags_R = [ @save_open_tags ];
 2378 	@save_open_tags = ();
 2379 
 2380 	local($curr_sec_tex);
 2381 	if ((! $TITLE) || ($TITLE eq $default_title)) {
 2382 	    eval '$TITLE = '.$default_title;
 2383 	    $TITLE = $default_title if $@;
 2384 	    $curr_sec_tex = ($top_sec ? '' :
 2385 		  join('', '"', &revert_to_raw_tex($curr_sec), '"'));
 2386 	    print STDOUT "$curr_sec_tex for $CURRENT_FILE\n" if ($VERBOSITY);
 2387 	} else { 
 2388 	    local($tmp) = &purify($TITLE,1);
 2389 	    $tmp = &revert_to_raw_tex($tmp);
 2390 	    print STDOUT "\"$tmp\" for $CURRENT_FILE\n" if ($VERBOSITY); 
 2391 	}
 2392 
 2393 	if (/\\(latextohtmlditchpreceding|startdocument)/m) {
 2394  	    local($after) = $';
 2395  	    local($before) = $`.$&;
 2396 	    $SEGMENT = 1 if ($1 =~ /startdocument/);
 2397 	    print STDOUT "\n *** translating preamble ***\n" if ($VERBOSITY);
 2398 	    $_ = &translate_preamble($before);
 2399 	    s/\n\n//g; s/<BR>//g;	# remove redundant blank lines and breaks
 2400 #
 2401 #	    &process_aux_file  if $AUX_FILE_NEEDED;
 2402 #
 2403 	    print STDOUT "\n *** preamble done ***\n" if ($VERBOSITY);
 2404 	    $PREAMBLE = 0;
 2405  	    $NESTING_LEVEL=0;
 2406 	    &do_AtBeginDocument;
 2407 	    $after =~ s/^\s*//m;
 2408 	    print STDOUT (($VERBOSITY >2)? "\n*** Translating environments ***" : ";");
 2409 	    $after = &translate_environments($after);
 2410 	    print STDOUT (($VERBOSITY >2)? "\n*** Translating commands ***" : ";");
 2411 	    $_ .= &translate_commands($after);
 2412 #            $_ = &translate_commands($after);
 2413  	} else {
 2414 	    &do_AtBeginDocument;
 2415 	    $PREAMBLE = 0;
 2416  	    $NESTING_LEVEL=0;
 2417 	    print STDOUT (($VERBOSITY >2)? "\n*** Translating environments ***" : ";");
 2418  	    $_ = &translate_environments($_);
 2419 	    print STDOUT (($VERBOSITY >2)? "\n*** Translating commands ***" : ";");
 2420  	    $_ = &translate_commands($_);
 2421  	}
 2422 
 2423 	# close any tags that remain open
 2424 	if (@$open_tags_R) {
 2425 	    ($close_all,$open_all) = &preserve_open_tags();
 2426 	    $_ .= $close_all; 
 2427 	    @save_open_tags = @$open_tags_R; $open_tags_R = [];
 2428 	} else { ($close_all,$open_all) = ('','') }
 2429 
 2430 	print STDOUT (($VERBOSITY >2)? "\n*** Translations done ***" : "\n");
 2431 #	if (($footnotes)&&($NO_FOOTNODE)&&( $current_depth < $MAX_SPLIT_DEPTH)) {
 2432 #	    $_ .= &make_footnotes
 2433 #	}
 2434 	print OUTPUT $_;
 2435 
 2436 	# Associate each id with the depth, the filename and the title
 2437 	###MEH -- starred sections don't show up in TOC ...
 2438 	# RRM:  ...unless $TOC_STARS is set
 2439 #	$toc_sec_title = &simplify($toc_sec_title);
 2440 #	$toc_sec_title = &purify($toc_sec_title);# if $SEGMENT;
 2441 	$toc_sec_title = $TITLE unless ($toc_sec_title);
 2442 
 2443 	if ($TOC_STARS) {
 2444 	    $toc_section_info{join(' ',@curr_sec_id)} =
 2445 		"$current_depth$delim$CURRENT_FILE$delim$toc_sec_title"
 2446 #		    if ($current_depth <= $MAX_SPLIT_DEPTH + $MAX_LINK_DEPTH);
 2447 		    if ($current_depth <= $TOC_DEPTH);
 2448 	} else {
 2449 	    $toc_section_info{join(' ',@curr_sec_id)} =
 2450 		"$current_depth$delim$CURRENT_FILE$delim$toc_sec_title"
 2451 		. ($curr_sec =~ /star$/ ? "$delim<tex2html_star_mark>" : "")
 2452 #		    if ($current_depth <= $MAX_SPLIT_DEPTH + $MAX_LINK_DEPTH);
 2453 		    if ($current_depth <= $TOC_DEPTH);
 2454 	}
 2455 
 2456 	# include $BODYTEXT in the section_info, when starting a new page
 2457 	$section_info{join(' ',@curr_sec_id)} =
 2458 	    "$current_depth$delim$CURRENT_FILE$delim$TITLE$delim"
 2459 		. (($current_depth < $MAX_SPLIT_DEPTH)? $BODYTEXT: "");
 2460 
 2461 	# Get type of section (see also the split above)
 2462 	$curr_sec = $sections[$i+1].$sections[$i+2];
 2463 	$del = $sections[$i+4];
 2464 
 2465 	# Get the depth of the current section;
 2466 #	$curr_sec = $outermost_level unless $curr_sec;
 2467 	$current_depth = $section_commands{$curr_sec};
 2468 	if ($after_segment) {
 2469 	    $current_depth = $after_segment;
 2470             $curr_sec_id[$after_segment] += $after_seg_num;
 2471             ($after_segment,$after_seg_num) = ('','');
 2472 	    for($j=1+$current_depth; $j <= $#curr_sec_id; $j++) {
 2473 		$curr_sec_id[$j] = 0;
 2474 	    }
 2475 	}
 2476 	if ($SEGMENT||$SEGMENTED) {
 2477 	    for($j=1; $j <= $#curr_sec_id; $j++) {
 2478 		$curr_sec_id[$j] += $segment_sec_id[$j];
 2479 		$segment_sec_id[$j] = 0;
 2480 	    }
 2481 	}; 
 2482 
 2483 
 2484 	# this may alter the section-keys
 2485 	$multiple_toc = 1 if ($MULTIPLE_FILES && $ROOTED && (/$toc_mark/));
 2486 
 2487 
 2488 	#RRM : Should this be done here, or in \stepcounter ?
 2489 	@curr_sec_id = &new_level($current_depth, @curr_sec_id);
 2490 
 2491 	$toc_sec_title = $TITLE = $top_sec = '';
 2492 	$i+=5; #skip to next text section
 2493     }
 2494     $open_tags_R = [];
 2495     $open_all = '';
 2496 
 2497     $_ = undef;
 2498     $_ = &make_footnotes if ($footnotes);
 2499     $CURRENT_FILE = '';
 2500     print OUTPUT;
 2501     close OUTPUT;
 2502     
 2503 
 2504 #    # this may alter the section-keys
 2505 #    &adjust_root_keys if $multiple_toc;
 2506 
 2507     if ($PREPROCESS_IMAGES) { &preprocess_images }
 2508     else { &make_image_file }
 2509     print STDOUT "\n *** making images ***" if ($VERBOSITY > 1);
 2510     &make_images;
 2511 
 2512     # Link sections, add head/body/address do cross-refs etc
 2513     print STDOUT "\n *** post-process ***" if ($VERBOSITY > 1);
 2514     &post_process;
 2515 
 2516     if (defined &document_post_post_process) {
 2517     	#BRM: extra document-wide post-processing
 2518 	print STDOUT "\n *** post-processing Document ***" if ($VERBOSITY > 1);
 2519 	&document_post_post_process();
 2520     }
 2521 
 2522     print STDOUT "\n *** post-processed ***" if ($VERBOSITY > 1);
 2523     &copy_icons if $LOCAL_ICONS;
 2524     if ($SEGMENT || $DEBUG || $SEGMENTED) {
 2525 	&save_captions_in_file("figure",  $figure_captions) if $figure_captions;
 2526 	&save_captions_in_file("table",  $table_captions) if $table_captions;
 2527 #	&save_array_in_file ("captions", "figure_captions", 0, %figure_captions) if %figure_captions;
 2528 #	&save_array_in_file ("captions", "table_captions", 0, %table_captions) if %table_captions;
 2529 	&save_array_in_file ("index", "index", 0, %index);
 2530 	&save_array_in_file ("sections", "section_info", 0, %section_info);
 2531 	&save_array_in_file ("contents", "toc_section_info", 0,%toc_section_info);
 2532 	&save_array_in_file ("index", "sub_index", 1, %sub_index) if %sub_index;
 2533 	&save_array_in_file ("index", "index_labels", 1, %index_labels) if %index_labels;
 2534 	&save_array_in_file ("index", "index_segment", 1, %index_segment) if %index_segment;
 2535 	&save_array_in_file ("index", "printable_key", 1, %printable_key) 
 2536 	    if (%printable_key || %index_segment);
 2537     }
 2538     elsif ($MULTIPLE_FILES && $ROOTED) {
 2539 	&save_array_in_file ("sections", "section_info", 0, %section_info);
 2540 	&save_array_in_file ("contents", "toc_section_info", 0, %toc_section_info);
 2541     }
 2542     &save_array_in_file ("internals", "ref_files", 0, %ref_files) if $changed;
 2543     &save_array_in_file ("labels", "external_labels", 0, %ref_files);
 2544     &save_array_in_file ("labels", "external_latex_labels", 1, %latex_labels);
 2545     &save_array_in_file ("images", "cached_env_img", 0, %cached_env_img);
 2546 }
 2547 
 2548 # RRM:
 2549 sub translate_preamble {
 2550     local($_) = @_;
 2551     $PREAMBLE = 1;
 2552     $NESTING_LEVEL=0;   #counter for TeX group nesting level
 2553     # remove some artificially inserted constructions
 2554     s/\n${tex2html_deferred_rx}\\par\s*${tex2html_deferred_rx2}\n/\n/gm;
 2555     s/\\newedcommand(<<\d+>>)([A-Za-z]+|[^A-Za-z])\1(\[\d+\])?(\[[^]]*\])?(<<\d+>>)[\w\W\n]*\5($comment_mark\d*)?//gm;
 2556     s/\n{2,}/\n/ogm;
 2557 
 2558     if (/\\htmlhead/) {
 2559         print STDOUT "\nPREAMBLE: discarding...\n$`" if ($VERBOSITY > 4);
 2560         local($after) = $&.$';
 2561 	# translate segment preamble preceding  \htmlhead
 2562 	&translate_commands(&translate_environments($`));
 2563 	# translate \htmlhead  and rest of preamble
 2564 	$_=&translate_commands(&translate_environments($after));
 2565         print STDOUT "\nPREAMBLE: retaining...\n$_" if ($VERBOSITY > 4);
 2566     } else {
 2567 	# translate only preamble here (metacommands etc.)
 2568 	# there should be no textual results, if so, discard them
 2569 	&translate_commands(&translate_environments($_));
 2570         print STDOUT "\nPREAMBLE: discarding...\n$_" if ($VERBOSITY > 4);
 2571 	$_="";
 2572     };
 2573     $_ = &do_AtBeginDocument($_);
 2574     if (! $SEGMENT) { $_ = ''} # segmented documents have a heading already
 2575     $_;
 2576 }
 2577 
 2578 ############################ Processing Environments ##########################
 2579 
 2580 sub wrap_shorthand_environments {
 2581     # This wraps a dummy environment around environments that do not use
 2582     # the begin-end convention. The wrapper will force them to be
 2583     # evaluated by Latex rather than them being translated.
 2584     # Wrap a dummy environment around matching TMPs.
 2585     # s/^\$\$|([^\\])\$\$/{$1.&next_wrapper('tex2html_double_dollar')}/ge;
 2586     # Wrap a dummy environment around matching $s.
 2587     # s/^\$|([^\\])\$/{$1.&next_wrapper('$')}/ge;
 2588     # s/tex2html_double_dollar/\$\$/go;
 2589     # Do \(s and \[s
 2590     #
 2591     local($wrapper) = "tex2html_wrap_inline";	# \ensuremath wrapper
 2592     print STDOUT "\n *** wrapping environments ***\n" if ($VERBOSITY > 3);
 2593 
 2594     # MRO: replaced $* with /m
 2595     print STDOUT "\\(" if ($VERBOSITY > 3);
 2596     s/(^\\[(])|([^\\])(\\[(])/{$2.&make_any_wrapper(1,'',$wrapper).$1.$3}/geom;
 2597     print STDOUT "\\)" if ($VERBOSITY > 3);
 2598     s/(^\\[)]|[^\\]\\[)])/{$1.&make_any_wrapper(0,'',$wrapper)}/geom;
 2599 
 2600     print STDOUT "\\[" if ($VERBOSITY > 3);
 2601     s/(^\\[[])|([^\\])(\\[[])/{$2.&make_any_wrapper(1,1,"displaymath")}/geom;
 2602     print STDOUT "\\]" if ($VERBOSITY > 3);
 2603     s/(^\\[\]])|([^\\])(\\[\]])/{$2.&make_any_wrapper(0,1,"displaymath")}/geom;
 2604 
 2605     print STDOUT "\$" if ($VERBOSITY > 3);
 2606     s/$enspair/print "\$";
 2607        {&make_any_wrapper(1,'',$wrapper).$&.&make_any_wrapper(0,'',$wrapper)}/geom;
 2608 
 2609     $double_dol_rx = '(^|[^\\\\])\\$\\$';
 2610     $single_dol_rx = '(^|[^\\\\])\\$';
 2611     print STDOUT "\$" if ($VERBOSITY > 3);
 2612 
 2613     local($dollars_remain) = 0;
 2614     $_ = &wrap_math_environment;
 2615     $_ = &wrap_raw_arg_cmds;
 2616 }
 2617 
 2618 sub wrap_math_environment {
 2619 
 2620     # This wraps math-type environments
 2621     # The trick here is that the opening brace is the same as the close,
 2622     # but they *can* still nest, in cases like this:
 2623     #
 2624     # $ outer stuff ... \hbox{ ... $ inner stuff $ ... } ... $
 2625     #
 2626     # Note that the inner pair of $'s is nested within a group.  So, to
 2627     # handle these cases correctly, we need to make sure that the outer
 2628     # brace-level is the same as the inner. --- rst
 2629     #tex2html_wrap
 2630     # And yet another problem:  there is a scungy local idiom to do
 2631     # this:  $\_$ for a boldfaced underscore.  xmosaic can't display the
 2632     # resulting itty-bitty bitmap, for some reason; even if it could, it
 2633     # would probably come out as an overbar because of the floating-
 2634     # baseline problem.  So, we have to special case this.  --- rst again.
 2635 
 2636     local ($processed_text, @processed_text, $before, $end_rx, $delim, $ifclosed);
 2637     local ($underscore_match_rx) = "^\\s*\\\\\\_\\s*\\\$";
 2638     local ($wrapper);
 2639     print STDOUT "\nwrap math:" if ($VERBOSITY > 3);
 2640 
 2641     #find braced dollars, in tabular-specs
 2642     while (/((($O|$OP)\d+($C|$CP))\s*)\$(\s*\2)/) {
 2643         push (@processed_text, $`, $1.$dol_mark.$5);
 2644         $_ = $';
 2645     }
 2646     $_ = join('',@processed_text, $_) if (@processed_text);
 2647     undef @processed_text;
 2648 
 2649     $dollars_remain = 0;
 2650     while (/$single_dol_rx/) {
 2651 	$processed_text .= $`.$1;
 2652 	$_ = $';
 2653 	$wrapper = "tex2html_wrap_inline";
 2654 	$end_rx = $single_dol_rx; # Default, unless we begin with $$.
 2655 	$delim = "\$";
 2656 
 2657         if (/^\$/ && (! $`)) {
 2658 	    s/^\$//;
 2659 	    $end_rx = $double_dol_rx;
 2660 	    $delim = "";	# Cannot say "\$\$" inside displaymath
 2661 	    $wrapper = "displaymath";
 2662 
 2663         } elsif (/$underscore_match_rx/ && (! $`)) {
 2664 
 2665             # Special case for $\_$ ...
 2666 
 2667             s/$underscore_match_rx//;
 2668             $processed_text .= '\\_';
 2669             next;
 2670         }
 2671 
 2672         # Have an opening $ or $$.  Find matching close, at same bracket level
 2673 #	$processed_text .= &make_any_wrapper(1,'',$wrapper).$delim;
 2674 
 2675 	print STDOUT "\$" if ($VERBOSITY > 3);
 2676 	$ifclosed = 0;
 2677 	local($thismath);
 2678         while (/$end_rx/) {
 2679 	    # Forget the $$ if we are going to replace it with "displaymath"
 2680             $before = $` . (($wrapper eq "displaymath")? "$1" : $&);
 2681 	    last if ($before =~ /\\(sub)*(item|section|chapter|part|paragraph)(star)?\b/);
 2682 	    $thismath .= $before;
 2683             $_ = $';
 2684 	    s/^( [^\n])/\\space$1/s;  #make sure a trailing space doesn't get lost.
 2685 
 2686             # Found dollar sign inside open subgroup ... now see if it's
 2687             # at the same brace-level ...
 2688 
 2689             local ($losing, $br_rx) = (0, '');
 2690 	    print STDOUT "\$" if ($VERBOSITY > 3);
 2691             while ($before =~ /$begin_cmd_rx/) {
 2692                 $br_rx = &make_end_cmd_rx($1);  $before = $';
 2693 
 2694                 if ($before =~ /$br_rx/) { $before = $'; }
 2695                 else { $losing = 1; last; }
 2696             }
 2697             do { $ifclosed = 1; last } unless $losing;
 2698 
 2699             # It wasn't ... find the matching close brace farther on; then
 2700             # keep going.
 2701 
 2702             /$br_rx/;
 2703 
 2704             $thismath .= $`.$&;
 2705 
 2706 	    #RRM: may now contain unprocessed $s e.g. $\mbox{...$...$...}$
 2707 	    # the &do_cmd_mbox uses this specially to force an image
 2708 	    # ...but there may be other situations; e.g. \hbox
 2709 	    # so set a flag:
 2710 	    $dollars_remain = 1;
 2711 
 2712             $_ = $';
 2713         }
 2714 
 2715         # Got to the end.  Whew!
 2716 	if ($ifclosed) {
 2717 	    # also process any nested math
 2718 	    while (($dollars_remain)&&($delim eq "\$")) {
 2719 		local($saved) = $_;
 2720                 $thismath =~ s/\$$//;
 2721                 $_ = $thismath;
 2722 		$thismath =  &wrap_math_environment;
 2723 		$thismath .= "\$";
 2724 		$_ = $saved;
 2725 	    }
 2726 	    $processed_text .= &make_any_wrapper(1,'',$wrapper) . $delim 
 2727 		. $thismath . &make_any_wrapper(0,'',$wrapper);
 2728 	} else {
 2729 	    print STDERR "\n\n *** Error: unclosed math or extra `\$', before:\n$thismath\n\n";
 2730 #	    # remove a $ to try to recover as much as possible.
 2731 #	    $thismath =~ s/([^\\]\\\\|[^\\])\$/$1\%\%/;
 2732 #	    $_ = $thismath . $_; $thismath = "";
 2733 	print "\n$thismath\n\n\n$_\n\n\n"; die;
 2734 	    
 2735 	}
 2736     }
 2737     $processed_text . $_;
 2738 }
 2739 
 2740 sub translate_environments {
 2741     local ($_) = @_;
 2742     local($tmp, $capenv);
 2743 #   print "\nTranslating environments ...";
 2744     local($after, @processedE);
 2745     local ($contents, $before, $br_id, $env, $pattern);
 2746     for (;;) {
 2747 #	last unless (/$begin_env_rx/o);
 2748 	last unless (/$begin_env_rx|$begin_cmd_rx|\\(selectlanguage)/o);
 2749 #	local ($contents, $before, $br_id, $env, $pattern);
 2750 	local($this_env, $opt_arg, $style_info);
 2751 	$contents = '';
 2752 	# $1,$2 : optional argument/text --- stylesheet info
 2753 	# $3 : br_id (at the beginning of an environment name)
 2754 	# $4 : environment name
 2755 	# $5 : br_id of open-brace, when $3 == $4 == '';
 2756 	# $6 : \selectlanguage{...}
 2757 	if ($7) {
 2758 	    push(@processedE,$`);
 2759 	    $_ = $';
 2760 	    if (defined &do_cmd_selectlanguage) {
 2761 		$_ = &do_cmd_selectlanguage($_);
 2762 	    } else {
 2763 		local($cmd) = $7;
 2764 		$pattern = &missing_braces unless (
 2765 		    s/$next_pair_rx/$pattern = $2;''/e);
 2766 		local($trans) = $pattern.'_translation';
 2767 		if (defined &$trans) {
 2768 		    &set_default_language($pattern,$_);
 2769 		}
 2770 		undef $cmd; undef $trans;
 2771 	    }
 2772 	    next;
 2773 	} elsif ($4) {
 2774 	    ($before, $opt_arg, $style_info, $br_id
 2775 	         , $env, $after, $pattern) = ($`, $2, $3, $4, $5, $', $&);
 2776 	    if (($before)&& (!($before =~ /$begin_env_rx|$begin_cmd_rx/))) {
 2777 		push(@processedE,$before);
 2778 		$_ = $pattern . $after; $before = '';
 2779 	    }
 2780 	} else {
 2781 	    ($before, $br_id, $env, $after, $pattern) = ($`, $6, 'group', $', $&);
 2782 	    if (($before)&& (!($before =~ /$begin_env_rx|$begin_cmd_rx/))) {
 2783 		push(@processedE,$before);
 2784 		$_ = $pattern . $after; $before = '';
 2785 	    }
 2786 	    local($end_cmd_rx) = &make_end_cmd_rx($br_id);
 2787 	    if ($after =~ /$end_cmd_rx/) {
 2788 		# ... find the the matching closing one
 2789 		$NESTING_LEVEL++;
 2790 		($contents, $after) = ($`, $');
 2791 		$contents = &process_group_env($contents);
 2792 		print STDOUT "\nOUT: {$br_id} ".length($contents) if ($VERBOSITY > 3);
 2793 		print STDOUT "\n:$contents\n" if ($VERBOSITY > 7);
 2794 		# THIS MARKS THE OPEN-CLOSE DELIMITERS AS PROCESSED
 2795 		$_ = join("", $before,"$OP$br_id$CP", $contents,"$OP$br_id$CP", $after);
 2796 		$NESTING_LEVEL--;
 2797 	    } else {
 2798 		$pattern = &escape_rx_chars($pattern);
 2799 		s/$pattern//;
 2800 		print "\nCannot find matching bracket for $br_id";
 2801 		$_ = join("", $before,"$OP$br_id$CP", $after);
 2802 	    }
 2803 	    next;
 2804 	}
 2805 	$contents = undef;
 2806 	local($defenv) = $env =~ /deferred/;
 2807 #	local($color_env);
 2808 	local($color_env)
 2809 	    unless ($env =~ /tabular|longtable|in(line|display)|math/);
 2810 	local($closures,$reopens);
 2811 	local(@save_open_tags) = @$open_tags_R unless ($defenv);
 2812 	local($open_tags_R) = [ @save_open_tags ] unless ($defenv);
 2813 	local(@saved_tags) if ($env =~ /tabular|longtable|makeimage/);
 2814 	if ($env =~ /tabular|longtable|makeimage|in(line|display)/) {
 2815 	    @save_open_tags = @$open_tags_R;
 2816 	    $open_tags_R = [ @save_open_tags ];
 2817 	    # check for color
 2818 	    local($color_test) = join(',',@$open_tags_R);
 2819 	    if ($color_test =~ /(color\{[^}]*\})/g ) {
 2820 		$color_env = $1;
 2821 	    } # else { $color_env = '' }
 2822 
 2823 	    if ($env =~ /tabular|longtable|makeimage/) {
 2824 		# close to the surrounding block-type tag
 2825 		($closures,$reopens,@saved_tags) = &preserve_open_block_tags();
 2826 		@save_open_tags = @$open_tags_R;
 2827 		$open_tags_R = [ @save_open_tags ];
 2828 		if ($color_env) {
 2829 		    $color_test = join(',',@saved_tags);
 2830 		    if ($color_test =~ /(color\{[^}]*\})/g ) {
 2831 		        $color_env = $1;
 2832 		    }
 2833 		}
 2834 	    } elsif ($env =~ /in(line|display)/) {
 2835 		$closures = &close_all_tags() if ((&defined_env($env))
 2836 		    &&!($defenv)&&!($env=~/inline/)&&(!$declarations{$env}));
 2837 		if ($color_env) {
 2838 		    $color_test = $declarations{$color_env};
 2839 		    $color_test =~ s/<\/.*$//;
 2840 		    $closures .= "\n$color_test";
 2841 		    push (@$open_tags_R , $color_env);		
 2842 		}
 2843 	    }
 2844 	} elsif ($env =~ /alltt|tex2html_wrap/) {
 2845 	    # alltt is constructed as paragraphs, not with <PRE>
 2846 	    #  tex2html_wrap  creates an image, which is at text-level
 2847 	} else {
 2848 	    $closures = &close_all_tags() if ((&defined_env($env))
 2849 		&&!($defenv)&&(!$declarations{$env}) );
 2850 	}
 2851 	# Sets $contents and modifies $after
 2852 	if (&find_end_env($env,$contents,$after)) {
 2853 	    print STDOUT "\nIN-A {$env $br_id}\n$contents\n" if ($VERBOSITY > 4);
 2854 	    &process_command($counters_rx, $before)
 2855 		if ($before =~ /$counters_rx/);
 2856 	    # This may modify $before and $after
 2857 	    # Modifies $contents
 2858 #RRM: the do_env_... subroutines handle when to translate sub-environments
 2859 #	    $contents = &translate_environments($contents) if
 2860 ##		((!$defenv) && (&defined_env($env)) && (! $raw_arg_cmds{$env})
 2861 ##		&& (!$declarations{$env})
 2862 #		((&defined_env($env)) && (! $raw_arg_cmds{$env})
 2863 #		&& (!($env =~ /latexonly|enumerate|figure|table|makeimage|wrap_inline/))
 2864 #		&& ((! $NO_SIMPLE_MATH)||(!($env =~ /wrap/)))
 2865 #		&& (!($env =~ /(math|wrap|equation|eqnarray|makeimage|minipage|tabular)/) )
 2866 #		);
 2867 	    if ($opt_arg) { 
 2868 		&process_environment(1, $env, $br_id, $style_info); # alters $contents
 2869 	    } else {
 2870 		&process_environment(0, $env, $br_id, '');
 2871 	    }
 2872 	    undef $_;
 2873 	    print STDOUT "\nOUT-A {$env $br_id}\n$contents\n" if ($VERBOSITY > 4);
 2874 	    #JCL(jcl-env) - insert the $O$br_id$C stuff to handle environment grouping
 2875 	    if (!($contents eq '')) {
 2876 		$after =~ s/^\n//o if ($defenv);
 2877 		$this_env = join("", $before, $closures
 2878 			  , $contents
 2879 			  , ($defenv ? '': &balance_tags())
 2880 			  , $reopens ); $_ = $after;
 2881 	    } else { 
 2882 		$this_env = join("", $before , $closures
 2883 			  , ($defenv ? '': &balance_tags())
 2884 			  , $reopens ); $_ = $after;
 2885 	    };
 2886 	### Evan Welsh <welsh@epcc.ed.ac.uk> added the next 24 lines ##
 2887 	} elsif (&defined_env($env)) {
 2888 	    print STDOUT "\nIN-B {$env $br_id}\n$contents\n" if ($VERBOSITY > 4);
 2889 	    # If I specify a function for the environment then it
 2890 	    # calls it with the contents truncated at the next section.
 2891 	    # It assumes I know what I'm doing and doesn't give a
 2892 	    # deferred warning.
 2893 	    $contents = $after;
 2894 	    if ($opt_arg) { 
 2895 		$contents = &process_environment(1, $env, $br_id, $style_info);
 2896 	    } else {
 2897 		$contents = &process_environment(0, $env, $br_id, '');
 2898 	    }
 2899 	    print STDOUT "\nOUT-B {$env $br_id}\n$contents\n" if ($VERBOSITY > 4);
 2900 	    $this_env = join("", $before, $closures ,$contents, $reopens);
 2901 
 2902 	    # there should not be anything left over 
 2903 #	    $_ = $after;
 2904 	    $_ = '';
 2905 	} elsif ($ignore{$env}) {
 2906 	    print STDOUT "\nIGNORED {$env $br_id}\n$contents\n" if ($VERBOSITY > 4);
 2907 	    # If I specify that the environment should be ignored then
 2908 	    # it is but I get a deferred warning.
 2909 	    $this_env = join("", $before , $closures , &balance_tags()
 2910 		      , $contents, $reopens );
 2911 	    $_ = $after;
 2912 	    &write_warnings("\n\\end{$env} not found (ignored).\n");
 2913 	} elsif ($raw_arg_cmds{$env}) {
 2914 	    print "\nIN-C {$env $br_id}\n$contents\n" if ($VERBOSITY > 4);
 2915 	    # If I specify that the environment should be passed to tex
 2916 	    # then it is with the environment truncated at the next
 2917 	    # section and I get a deferred warning.
 2918 
 2919 	    $contents = $after;
 2920 	    if ($opt_arg) { 
 2921 		$contents = &process_environment(1, $env, $br_id, $style_info);
 2922 	    } else {
 2923 		$contents = &process_environment(0, $env, $br_id, '');
 2924 	    }
 2925 	    print STDOUT "\nOUT-C {$env $br_id}\n$contents\n" if ($VERBOSITY > 4);
 2926 	    $this_env = join("", $before, $closures
 2927 			     , $contents, &balance_tags(), $reopens );
 2928 	    $_='';
 2929 	    &write_warnings(
 2930 	        "\n\\end{$env $br_id} not found (truncated at next section boundary).\n");
 2931 	} else {
 2932 	    $pattern = &escape_rx_chars($pattern);
 2933 	    s/$pattern/$closures/;
 2934 	    print "\nCannot find \\end{$env $br_id}\n";
 2935 	    $_ .= join('', &balance_tags(), $reopens) unless ($defenv);
 2936 	}
 2937 	if ($this_env =~ /$begin_env_rx|$begin_cmd_rx/) {
 2938 	    $_ = $this_env . $_;
 2939 	} else { push (@processedE, $this_env) }
 2940     }
 2941     $_ = join('',@processedE) . $_;
 2942     $tmp = $_; undef $_;
 2943     &process_command($counters_rx, $tmp) if ($tmp =~ /$counters_rx/);
 2944     $_ = $tmp; undef $tmp;
 2945     $_
 2946 }
 2947 
 2948 sub find_end_env {
 2949     # MRO: find_end_env($env,$contents,$rest)
 2950     #local ($env, *ref_contents, *rest) = @_;
 2951     my $env = $_[0];
 2952     my $be_rx = &make_begin_end_env_rx($env);
 2953     my $count = 1;
 2954 
 2955     while ($_[2] =~ /($be_rx)(\n?)/s) { # $rest
 2956 	$_[1] .= $`; # $contents
 2957 
 2958 	if ($2 eq "begin") { ++$count }
 2959 	else { --$count };
 2960 
 2961 	#include any final \n at an {end} only
 2962 	$_[2] = (($2 eq 'end')? $5 : '') . $'; # $rest
 2963 	last if $count == 0;
 2964 
 2965 	$_[1] .= $1; # $contents
 2966     }
 2967 
 2968     if ($count != 0) {
 2969 	$_[2] = join('', $_[1], $_[2]); # $rest = join('', $contents, $rest);
 2970 	$_[1] = ''; # $contents
 2971 	return(0)
 2972     } else { return(1) }
 2973 }
 2974 
 2975 
 2976 sub process_group_env {
 2977     local($contents) = @_;
 2978     local(@save_open_tags) = @$open_tags_R;
 2979     local($open_tags_R) = [ @save_open_tags ];
 2980     print STDOUT "\nIN::{group $br_id}" if ($VERBOSITY > 4);
 2981     print STDOUT "\n:$contents\n" if ($VERBOSITY > 6);
 2982 
 2983     # need to catch explicit local font-changes
 2984     local(%font_size) = %font_size if (/\\font\b/);
 2985 
 2986     # record class/id info for a style-sheet entry
 2987     local($env_id, $tmp, $etmp);
 2988     if (($USING_STYLES) && !$PREAMBLE ) { $env_id = $br_id; }
 2989 #	$env_id = "grp$br_id";
 2990 #	$styleID{$env_id} = " ";
 2991 #        $env_id = " ID=\"$env_id\"";
 2992 #    }
 2993 
 2994     undef $_;
 2995     $contents =~ s/^\s*$par_rx\s*//s; # don't start with a \par 
 2996     if ($contents =~ /^\s*\\($image_switch_rx)\b\s*/s) {
 2997 	# catch TeX-like environments: {\fontcmd ... }
 2998 	local($image_style) = $1;
 2999 	if ($USING_STYLES) {
 3000 	    $env_style{$image_style} = " " unless ($env_style{$image_style});
 3001 	}
 3002 	local($switch_cmd) = "do_cmd_${image_style}";
 3003 	if (defined &$switch_cmd ) {
 3004 	    eval "\$contents = \&${switch_cmd}(\$')";
 3005 	    print "\n*** &$switch_cmd didn't work: $@\n$contents\n\n" if ($@);
 3006 	} elsif ($contents =~ /$par_rx/) {
 3007 	    # split into separate image for each paragraph
 3008 	    local($par_style,$this_par_img) = '';
 3009 	    local(@par_pieces) = split($par_rx, $contents);
 3010 	    local($this_par,$par_style,$par_comment);
 3011 	    $contents = '';
 3012 	    while (@par_pieces) {
 3013 		$this_par = shift @par_pieces;
 3014 		if ($this_par =~ /^\s*\\($image_switch_rx)\b/s) {
 3015 		    $image_style = $1;
 3016 		    $par_style = 'P.'.$1;
 3017 		    $env_style{$par_style} = " " unless ($env_style{$par_style});
 3018 		}
 3019 #	no comment: source is usually too highly encoded to be meaningful
 3020 #	$par_comment = &make_comment($image_style,$this_par);
 3021 		$this_par_img = &process_in_latex("\{".$this_par."\}");
 3022 		$contents .=  join(''  #,"\n", $par_comment
 3023 			, "\n<P"
 3024 			, (($USING_STYLES && $image_style)? " CLASS=\"$image_style\"" :'')
 3025 			,">", $this_par_img
 3026 			, "</P>\n");
 3027 		if (@par_pieces) {
 3028 		    # discard the pieces from matching  $par_rx
 3029 		    $dum = shift @par_pieces;
 3030 		    $dum = shift @par_pieces;
 3031 		    $dum = shift @par_pieces;
 3032 		    $dum = shift @par_pieces;
 3033 		    $dum = shift @par_pieces;
 3034 		    $dum = shift @par_pieces;
 3035 #		    $contents .= "\n</P>\n<P>";
 3036 		}
 3037 	    }
 3038 	} else {
 3039 	    $contents = &process_undefined_environment("tex2html_accent_inline"
 3040 		, ++$global{'max_id'},"\{".$contents."\}");
 3041         }
 3042     } elsif ($contents =~ /^\s*\\(html)?url\b($O\d+$C)[^<]*\2\s*/) {
 3043 	# do nothing
 3044 	$contents = &translate_environments($contents);
 3045 	$contents = &translate_commands($contents);
 3046     } elsif (($env_switch_rx)&&($contents =~ s/^(\s*)\\($env_switch_rx)\b//s)) {
 3047 	# write directly into images.tex, protected by \begingroup...\endgroup
 3048 	local($prespace, $cmd, $tmp) = ($1,$2,"do_cmd_$2");
 3049 	$latex_body .= "\n\\begingroup ";
 3050 	if (defined &$tmp) {
 3051 	    eval("\$contents = &do_cmd_$cmd(\$contents)");
 3052 	}
 3053 	$contents = &translate_environments($contents);
 3054 	$contents = &translate_commands($contents);
 3055 	undef $tmp; undef $cmd;
 3056 	$contents .= "\n\\endgroup ";
 3057     } elsif ($contents =~ /^\s*\\([a-zA-Z]+)\b/s) { 
 3058 	local($after_cmd) = $';
 3059 	local($cmd) = $1; $tmp = "do_cmd_$cmd"; $etmp = "do_env_$cmd";
 3060 	if (($cmd =~/^(rm(family)?|normalsize)$/)
 3061 		||($declarations{$cmd}&&(defined &$tmp))) {
 3062 	    do{
 3063 		local(@save_open_tags) = @$open_tags_R;
 3064 		eval "\$contents = \&$tmp(\$after_cmd);";
 3065 		print "\n*** eval &$tmp failed: $@\n$contents\n\n" if ($@);
 3066 		$contents .= &balance_tags();
 3067 	    };
 3068 	} elsif ($declarations{$cmd}&&(defined &$etmp)) {
 3069 	    eval "\$contents = \&$etmp(\$after_cmd);";
 3070 	} else {
 3071 	    $contents = &translate_environments($contents);
 3072 	    $contents = &translate_commands($contents)
 3073 		if ($contents =~ /$match_br_rx/o);
 3074 	    # Modifies $contents
 3075 	    &process_command($single_cmd_rx,$contents) if ($contents =~ /\\/o);
 3076 	}
 3077 	undef $cmd; undef $tmp; undef $etmp;
 3078     } else { 
 3079 	$contents = &translate_environments($contents);
 3080 	$contents = &translate_commands($contents)
 3081 	    if ($contents =~ /$match_br_rx/o);
 3082         # Modifies $contents
 3083 	&process_command($single_cmd_rx,$contents)
 3084 	    if ($contents =~ /\\/o);
 3085     }
 3086     $contents . &balance_tags();
 3087 }
 3088 
 3089 # MODIFIES $contents
 3090 sub process_environment {
 3091     local($opt, $env, $id, $styles) = @_;
 3092 
 3093     local($envS) = $env; $envS =~ s/\*\s*$/star/;
 3094     local($env_sub,$border,$attribs,$env_id) = ("do_env_$envS",'','','');
 3095     local($original) = $contents;
 3096 
 3097     if ($env =~ /tex2html_deferred/ ) {
 3098 	$contents = &do_env_tex2html_deferred($contents);
 3099 	return ($contents);
 3100     }
 3101     $env_id = &read_style_info($opt, $env, $id, $styles) 
 3102 	if (($USING_STYLES)&&($opt));
 3103 
 3104     if (&defined_env($env)) {
 3105 	print STDOUT ",";
 3106 	print STDOUT "{$env $id}" if ($VERBOSITY > 1);
 3107 #	$env_sub =~ s/\*$/star/;
 3108 	$contents = &$env_sub($contents);
 3109 
 3110     } elsif ($env =~ /tex2html_nowrap/) {
 3111 	#pass it on directly for LaTeX, via images.tex
 3112 	$contents = &process_undefined_environment($env, $id, $contents);
 3113 	return ($contents);
 3114 
 3115 #    elsif (&special_env) {	# &special_env modifies $contents
 3116     } else {
 3117 	local($no_special_chars) = 0;
 3118 	local($failed) = 0;
 3119 	local($has_special_chars) = 0;
 3120 	&special_env; #  modifies $contents
 3121 	print STDOUT "\n<MATH $env$id $contents>" if ($VERBOSITY > 3);
 3122 	if ($failed || $has_special_chars) {
 3123 	    $contents = $original;
 3124 	    $failed = 1;
 3125 	    print STDOUT " !failed!\n" if ($VERBOSITY > 3);
 3126         }
 3127     }
 3128     if (($contents) && ($contents eq $original)) {
 3129         if ($ignore{$env}) {  return(''); }
 3130         # Generate picture
 3131 	if ($contents =~ s/$htmlborder_rx//o) {
 3132 	    $attribs = $2; $border = (($4)? "$4" : 1)
 3133 	} elsif ($contents =~ s/$htmlborder_pr_rx//o) { 
 3134 	    $attribs = $2; $border = (($4)? "$4" : 1)
 3135 	}
 3136 	$contents = &process_undefined_environment($env, $id, $contents);
 3137 	$env_sub = "post_latex_$env_sub"; # i.e. post_latex_do_env_ENV
 3138         if ( defined &$env_sub) {
 3139 	    $contents = &$env_sub($contents);
 3140 	} elsif (($border||($attributes))&&($HTML_VERSION > 2.1)) {
 3141 	    $contents = &make_table($border,$attribs,'','','',$contents);
 3142 	} else {
 3143 	    $contents = join('',"<BR>\n",$contents,"\n<BR>")
 3144 	        unless (!($contents)||($inner_math)||($env =~
 3145 	              /^(tex2html_wrap|tex2html_nowrap|\w*math|eq\w*n)/o ));
 3146 	}
 3147     }
 3148     $contents;
 3149 }
 3150 
 3151 
 3152 #RRM: This reads the style information contained in the optional argument
 3153 #   to the \begin command. It is stored to be recovered later as an entry
 3154 #   within the automatically-generated style-sheet, if $USING_STYLES is set.
 3155 # Syntax for this info is:
 3156 #   <style names> ; <extra style-info> 
 3157 
 3158 sub read_style_info {
 3159     local($opt, $envS, $id, $styles) = @_;
 3160     return() unless (($opt)&&($USING_STYLES));
 3161     # allow macro-expansion within the style-info
 3162     $opt = &translate_commands($opt) if ($opt =~ /\\/);
 3163 
 3164     # record class/id info for a style-sheet entry
 3165     local($style_names, $style_extra, $env_id)=(''," ",'');
 3166     if ($opt) {
 3167 	# if there is a `;'  then <names> ; <extra>
 3168 	if ($styles =~ /^\s*([^\|]*)\|\s*(.*)$/) {
 3169 	    $style_names = $1; $style_extra = $2;
 3170 	    if ($style_names =~ /[=:;]/) {
 3171 		# cannot be <names>, so is <extra>
 3172 		$style_extra = $style_names.$style_extra;
 3173 		$style_names = '';
 3174 	    }
 3175 	} elsif ($styles =~ /[\=\:]/) {
 3176 	    # cannot be <names>, so is <extras>
 3177 	    $style_extra = $styles;
 3178 	} else { $style_names = $styles }
 3179 	$style_extra =~ s/\s*[=:]\s*/ : /go;
 3180 	$style_extra =~ s/([\w,\-]+)\s+([\w,\-]+)/$1 ; $2/go;
 3181 	$style_extra =~ s/\s*,\s*/ /go;
 3182 
 3183 	if ($style_names) {
 3184 	    local($sname);
 3185 	    local(@names) = split ( /\s+/ , $style_names );
 3186 	    # ensure a style-sheet entry for each new name
 3187 	    foreach $sname (@names) {
 3188 		$env_style{$sname} = " "
 3189 		    unless (($env_style{$sname})||($sname =~ /^\s*$/));		
 3190 	    }
 3191 	}
 3192     }
 3193     # remove uninformative part of internally-defined env names
 3194     $envS =~ s/tex2html_(\w+_)?(\w+)/$2/; $envS =~ s/preform/pre/;
 3195     $env_id = $envS.$id;
 3196     $styleID{$env_id} = $style_extra unless ($PREAMBLE);
 3197     
 3198     if ($style_names) { $envS = "$style_names" }
 3199     elsif (($envS =~ /^pre$/)&&
 3200 	(/^\\begin.*preform($O|$OP)\d+($C|$CP)$verbatim_mark(\w*[vV]erbatim|lstlisting)(\*?)/))
 3201 	    { $envS = $3.($4 ? 'star' : '') };
 3202     $env_style{$envS} = " " unless (($style_names)||($env_style{$envS}));
 3203     $env_id = " ID=\"$env_id\"".(($envS) ? " CLASS=\"$envS\"" : '');
 3204     return($env_id);
 3205 }
 3206 
 3207 # RRM: This provides the mechanism to save style information in %env_style
 3208 #      using LaTeX macros  \htmlsetstyle  and  \htmladdtostyle
 3209 #
 3210 sub process_htmlstyles {
 3211     local($mode, $_) = @_;
 3212     local($pre_tags) = &get_next_optional_argument;
 3213     local($class) = &missing_braces unless (
 3214         (s/$next_pair_pr_rx/$class = $2;''/e)
 3215         ||(s/$next_pair_rx/$class = $2;''/e));
 3216     local($sinfo) = &missing_braces unless (
 3217         (s/$next_pair_pr_rx/$sinfo = $2;''/e)
 3218         ||(s/$next_pair_rx/$sinfo = $2;''/e));
 3219     return ($_) unless ($class||$pre_tags);
 3220 
 3221     $class = $pre_tags.($class ?'.':'').$class;
 3222     $sinfo =~ s/\s*[:=]\s*/ : /g;
 3223     $sinfo =~ s/\s*,\s*/ /g;
 3224     if ($mode =~ /add/) {
 3225     	$sinfo = '; '.$sinfo if ($env_style{$class}); 
 3226 	$env_style{$class} .= $sinfo;
 3227     } else { $env_style{$class} = $sinfo }
 3228     $_;
 3229 }
 3230 sub do_cmd_htmlsetstyle   { &process_htmlstyles('set',@_) }
 3231 sub do_cmd_htmladdtostyle { &process_htmlstyles('add',@_) }
 3232 
 3233 
 3234 # The $<$, $>$, $|$ and $=>$, etc strings are replaced with their textual
 3235 # equivalents instead of passing them on to latex for processing in math-mode.
 3236 # This will not be necessary when the mechanism for passing environments
 3237 # to Latex is improved.
 3238 # RETURNS SUCCESS OR FAILURE
 3239 sub special_env {
 3240     # Modifies $contents in its caller
 3241     local($next)='';
 3242     local ($allow) = $HTML_VERSION ge '3.0' ?
 3243 	 "[^#\$%&~\\\\{}]|\\limits" : "[^^#\$%&~_\\\\{}]";
 3244     #JKR: Use italics instead of bold #HWS: Generalize to include more symbols.
 3245 #    $contents =~ s/^\$(\s*($html_specials_inv_rx|$allow)*\s*)\$(.)?/
 3246 #	$next=$3;&simple_math_env($1).(($next =~ m|\w|)? " ":'').$next/ige;
 3247     $contents =~ s/^\$(\s*($html_specials_inv_rx|$allow)*\s*)\$$/
 3248 	&simple_math_env($1)." "/ige;
 3249     if ($contents =~ /\&\w*;/) { $has_math_chars=1 }
 3250     if ($contents =~ /;SPM([a-zA-Z]+);/) { $has_special_chars=1 };
 3251 }
 3252 
 3253 # Translate simple math environments into italic.
 3254 # Only letters should become italic; symbols should stay non-italic.
 3255 sub simple_math_env {
 3256     local($mathcontents) = @_;
 3257     if ($mathcontents eq '') { return("$mathcontents"); }
 3258     elsif ($NO_SIMPLE_MATH) {  # always make an image
 3259 	$failed = 1; return($mathcontents);
 3260     } elsif ($mathcontents =~ /\\/) { # any macro kills "simple-math"
 3261 	local($save_math) = $mathcontents;
 3262 	local(@text_only) = ();
 3263 	while ((!$failed)&&($mathcontents =~
 3264 		/\\((boldsymbol|bm)|(math|text)(bf|rm|it|tt)|times|[{}@#^_])(\b|[^A-Za-z]|$)/)) {
 3265 	    # ...except when only simple styles
 3266 	    push (@text_only, $`, ("$2$4" ? "\\simplemath".($4 ? $4 :"bf") :"\\$1") );
 3267 	    $mathcontents = $5.$';
 3268 	    $failed = 1 if ($` =~ /\\/);
 3269 	}
 3270 	$failed = 1 if ($mathcontents =~ /\\/);
 3271 	return($save_math) if $failed;
 3272 	$mathcontents = join('',@text_only,$mathcontents);
 3273     }
 3274     # Is there a problem here, with nested super/subscripts ?
 3275     # Yes, so do each pattern-match for bracketings within a while-loop
 3276     while ($mathcontents =~ s/\^$any_next_pair_rx/<SUP>$2<\/SUP>/go){};
 3277     while ($mathcontents =~ s/\^$any_next_pair_pr_rx/<SUP>$2<\/SUP>/go){};
 3278     while ($mathcontents =~ s/_$any_next_pair_rx/<SUB>$2<\/SUB>/g){};
 3279     while ($mathcontents =~ s/_$any_next_pair_pr_rx/<SUB>$2<\/SUB>/g){};
 3280 
 3281     $mathcontents =~ s/\^(\\[a-zA-Z]+|.)/<SUP><i>$1<\/i><\/SUP>/g;
 3282     $mathcontents =~ s/_(\\[a-zA-Z]+|.)/<SUB><i>$1<\/i><\/SUB>/g;
 3283     $mathcontents =~ s/(^|\s|[,;:'\?\.\[\]\(\)\+\-\=\!>]|[^\\<]\/|\d)(<(I|TT|B)>)?([a-zA-Z]([a-zA-Z ]*[a-zA-Z])?)(<\/\3>)?/
 3284 	$1.(($2)? $2 :'<I>').$4.(($6)? $6 : '<\/I>')/eig;
 3285 
 3286     $mathcontents =~ s/\\times($|\b|[^A-Za-z])/ x $1/g;
 3287     $mathcontents =~ s/\\times($|\b|[^A-Za-z])/ x $1/g;
 3288     $mathcontents =~ s/\\\\/<BR>\n/g;
 3289     $mathcontents =~ s/\\\\/<BR>\n/g;
 3290     $mathcontents =~ s/\\([,;])/ /g;
 3291     $mathcontents =~ s/\\(\W)/$1/g;
 3292     $mathcontents =~ s/ {2,}/ /g;
 3293 
 3294     # any simple style changes remove enclosed <I> tags
 3295     $mathcontents = &translate_commands($mathcontents)
 3296 	if ($mathcontents =~ /\\/);
 3297 
 3298     $mathcontents =~ s/<I><\/(SUB|SUP)>/<\/$1><I>/g;
 3299     $mathcontents =~ s/<(SUB|SUP)><\/I>/<\/I><$1>/g;
 3300     $mathcontents =~ s/;<I>SPM([a-zA-Z]+)<\/I>;/;SPM$1;/go;
 3301     $mathcontents =~ s/<(\/?)<I>(SUB|SUP|I|B|TT)<\/I>>/<$1$2>/g;
 3302     $mathcontents =~ s/<\/(B|I|TT)><\1>//g;
 3303     $mathcontents;
 3304 }
 3305 
 3306 sub do_cmd_simplemathrm { 
 3307     local ($_) = @_;
 3308     local($text);
 3309     $text = &missing_braces unless (
 3310         (s/$next_pair_pr_rx/$text = $2;''/e)
 3311         ||(s/$next_pair_rx/$text = $2;''/e));
 3312     $text =~ s/<\/?I>//g;
 3313     join('', $text, $_)
 3314 }
 3315 sub do_cmd_simplemathbf { 
 3316     local ($_) = @_;
 3317     local($text);
 3318     $text = &missing_braces unless (
 3319         (s/$next_pair_pr_rx/$text = $2;''/e)
 3320         ||(s/$next_pair_rx/$text = $2;''/e));
 3321     $text =~ s/<\/?I>//g;
 3322     join('','<B>', $text, '</B>', $_)
 3323 }
 3324 sub do_cmd_simplemathtt {
 3325     local ($_) = @_;
 3326     local($text);
 3327     $text = &missing_braces unless (
 3328         (s/$next_pair_pr_rx/$text = $2;''/e)
 3329         ||(s/$next_pair_rx/$text = $2;''/e));
 3330     $text =~ s/<\/?I>//g;
 3331     join('','<TT>', $text, '</TT>', $_)
 3332 }
 3333 
 3334 sub process_math_in_latex {
 3335     local($mode,$style,$level,$math) = @_;
 3336     local(@anchors);
 3337     if ($level) {
 3338 	$style = (($level > 1) ? "script" : "") . "script";
 3339     } elsif (! $style) { 
 3340 	$style = (($mode =~/display|equation/)? "display" : "")
 3341     }
 3342     $style = "\\${style}style" if ($style);
 3343 
 3344     #  &process_undefined_environment  changes $_ , so save it.
 3345     local($after) = $_;
 3346 
 3347     # the 'unless' catches nested AMS-aligned environments
 3348     $mode = "tex2html_wrap_" .
 3349 	(($mode =~/display|equation|eqnarray/) ? 'indisplay' : 'inline')
 3350 	    unless ($mode =~ /^equationstar/ && $outer_math =~ /^equationstar/);
 3351 
 3352     $global{'max_id'}++;
 3353     $math =~ s/\\(\n|$)/\\ $1/g;	# catch \ at end of line or string
 3354     $math =~ s/^\s*((\\!|;SPMnegsp;)\s*)*//g;		# remove neg-space at start of string
 3355     if ($mode =~ /tex2html_wrap_/ ) {
 3356 	$math = &process_undefined_environment( $mode
 3357 	    , $global{'max_id'}, join('', "\$$style ", $math, "\$"));
 3358     } else {
 3359 	# some AMS environments must be within {equation} not {displaymath}
 3360 	$math =~ s/displaymath/equation*/
 3361 		if ($math =~ /\\begin\{(x+|fl)*align/);
 3362 	$math = &process_undefined_environment($mode, $global{'max_id'}, $math);
 3363     }
 3364     $math .= "\n" if ($math =~ /$comment_mark\s*\d+$/s);
 3365     $_ = $after;
 3366     # the delimiter \001 inhibits an unwanted \n at image-replacement
 3367     $math . ($math =~ /$image_mark/? "\001" : '');
 3368 }
 3369      
 3370 #RRM: Explicit font switches need images. Use the image_switch mechanism.
 3371 sub do_cmd_font {
 3372     local($_) = @_;
 3373     local($fontinfo,$fontname,$size) = ('','','10pt');
 3374     s/\s*\\(\w+)\s*=?\s*(.*)(\n|$)/$fontname=$1;$fontinfo=$2;''/eo;
 3375     $image_switch_rx .= "|$fontname";
 3376 
 3377     if ($fontinfo =~ /([.\d]+\s*(true)?(pt|mm|cm))/ ) { $size = $1 }
 3378     elsif ( $fontinfo =~ /[a-zA-Z]+(\d+)\b/ ) { $size = $1.'pt' }
 3379     if  ( $fontinfo =~ /(scaled|at)\s*\\?(.+)/) { $size .= " scaled $1" }
 3380     $font_size{$fontname} = $size;
 3381     $_;
 3382 }
 3383 sub wrap_cmd_font {
 3384     local($cmd, $_) = @_;
 3385     local ($args, $dummy, $pat) = "";
 3386     if (/\n/) { $args .= $`.$& ; $_ = $' } else {$args = $_; $_ = ''};
 3387     (&make_deferred_wrapper(1).$cmd.$padding.$args.&make_deferred_wrapper(0),$_)
 3388 }
 3389 
 3390 sub do_cmd_newfont {
 3391     local($_) = @_;
 3392     local($fontinfo,$fontname,$size) = ('','','10pt');
 3393     $fontname = &missing_braces unless (
 3394 	(s/$next_pair_pr_rx/$fontname=$2;''/eo)
 3395 	||(s/$next_pair_rx/$fontname=$2;''/eo));
 3396     $fontname=~ s/^\s*\\|\s*$//g;
 3397     $image_switch_rx .= "|$fontname";
 3398 
 3399     $fontinfo = &missing_braces unless (
 3400 	(s/$next_pair_pr_rx/$fontinfo=$2;''/eo)
 3401 	||(s/$next_pair_rx/$fontinfo=$2;''/eo));
 3402     if ($fontinfo =~ /([.\d]+\s*(true)?(pt|mm|cm))/ ) { $size = $1 }
 3403     elsif ( $fontinfo =~ /[a-zA-Z]+(\d+)\b/ ) { $size = $1.'pt' }
 3404     if  ( $fontinfo =~ /(scaled|at)\s*\\?(.+)/) { $size .= " scaled $1" }
 3405     $font_size{$fontname} = $size;
 3406     $_;
 3407 }
 3408 
 3409 sub defined_env {
 3410     local($env) = @_;
 3411     $env =~ s/\*$/star/;
 3412     local($env_sub) = ("do_env_$env");
 3413     # The test using declarations should not be necessary but 'defined'
 3414     # doesn't seem to recognise subroutines generated dynamically using 'eval'.
 3415     # Remember that each entry in $declarations generates a dynamic prodedure ...
 3416     ((defined &$env_sub) || ($declarations{$env}));
 3417 }
 3418 
 3419 # RRM: utility to add style information to stored image-parameters
 3420 #      currently only (math) scaling info is included;
 3421 #      current color, etc.  could also be added here.
 3422 sub addto_encoding {
 3423     local($env, $contents) = @_;
 3424 #    $contents =~ s/(\\(begin|end)\s*)?<<\d*>>|\n//g;	# RRM: remove env delimiters
 3425     $contents =~ s/(\\(begin|end)\s*(<<\d*>>))|\n//g;	# RRM: remove env delimiters
 3426     # append scaling information for environments using it
 3427     if (($MATH_SCALE_FACTOR)
 3428 	&&(($contents =~ /makeimage|inline|indisplay|entity|displaymath|eqnarray|equation|xy|diagram/)
 3429 	   ||($env =~ /makeimage|inline|indisplay|entity|displaymath|eqnarray|equation|xy|diagram/))
 3430 	) { $contents .= ";MSF=$MATH_SCALE_FACTOR" }
 3431 
 3432     if ($LATEX_FONT_SIZE =~ /([\d\.]+)pt/) {
 3433 	local($fsize) = $1;
 3434 	$contents .= ";LFS=$fsize" unless ($fsize ==10);
 3435     }
 3436 
 3437     if (($EXTRA_IMAGE_SCALE)
 3438 	&&(($contents =~ /makeimage|inline|indisplay|entity|displaymath|eqnarray|equation|xy|diagram/)
 3439 	   ||($env =~ /makeimage|inline|indisplay|entity|displaymath|eqnarray|equation|xy|diagram/))
 3440 	) { $contents .= ";EIS=$EXTRA_IMAGE_SCALE" }
 3441 
 3442     if (($DISP_SCALE_FACTOR)
 3443 	&&(($contents =~ /indisplay|displaymath|eqnarray|equation/)
 3444 	   ||($env =~ /indisplay|displaymath|eqnarray|equation/))
 3445 	&&!(($contents =~ /makeimage/)||($env =~ /makeimage/))
 3446 	) { $contents .= ";DSF=$DISP_SCALE_FACTOR" }
 3447 
 3448     if (($EQN_TAGS)
 3449 	&&(($env =~ /eqnarray($|[^_\*])|equation/)
 3450 	   ||($contents =~ /eqnarray($|[^_\*])|equation/))
 3451 	&&!(($contents =~ /makeimage/)||($env =~ /makeimage/))
 3452 	) { $contents .= ";TAGS=$EQN_TAGS" }
 3453 
 3454     if (($FIGURE_SCALE_FACTOR)
 3455 	&&!(($contents =~ /makeimage/)||($env =~ /makeimage/))
 3456 	&&(($contents =~ /figure/)||($env =~ /figure/))
 3457 	) { $contents .= ";FSF=$FIGURE_SCALE_FACTOR"}
 3458 
 3459     if (($ANTI_ALIAS)
 3460 	&&(($contents =~ /figure/)||($env =~ /figure/))
 3461 	&&!(($contents =~ /makeimage/)||($env =~ /makeimage/))
 3462 	) { $contents .= ";AAF" }
 3463     elsif ($ANTI_ALIAS_TEXT) { $contents .= ";AAT" }
 3464     if (!$TRANSPARENT_FIGURES) { $contents .= ";NTR" }
 3465 
 3466     $contents;
 3467 }
 3468 
 3469 sub process_undefined_environment {
 3470     local($env, $id, $contents) = @_;
 3471     if ($env =~ s/\*{2,}/*/) { print "\n*** $_[0] has too many \*s ***"};
 3472 
 3473     local($name,$cached,$raw_contents,$uucontents) = ("$env$id");
 3474     $name =~ s/\*/star/;
 3475     local($oldimg,$size,$fullcontents,$imgID);
 3476     return if ($AUX_FILE);
 3477 
 3478     # catch \footnotemark within an image, especially if in math
 3479     local(@foot_anchors,$foot_anchor);
 3480     local($im_footnote,$im_mpfootnote) = ($global{'footnote'},$global{'mpfootnote'});
 3481     @foot_anchors = &process_image_footnote($contents)
 3482 	if ($contents =~ /\\footnote(mark)?\b/s);
 3483     if ((@foot_anchors)&&($eqno)) {
 3484 	# append the markers to the equation-numbers
 3485 	$eqno .= join(' ', ' ', @foot_anchors);
 3486 	@foot_anchors = ();
 3487     }
 3488     
 3489     print STDOUT "\nUNDEF-IN {$env $id}:\n$contents\n" if ($VERBOSITY > 4);
 3490     #RRM - LaTeX commands wrapped with this environment go directly into images.tex.
 3491     if ($env =~ /tex2html_nowrap|^lrbox$/){ # leave off the wrapper, do not cache
 3492 	# totally ignore if in preamble...
 3493 	# ...since it will be put into  images.tex  anyway!!
 3494 	if (!($PREAMBLE)) {
 3495 	    $contents =~ s/^\n+|\n+$/\n/g;
 3496 	    local($lcontents) = join('', "\\begin{$env}", $contents , "\\end{$env}" );
 3497 	    $lcontents =~ s/\\(index|label)\s*(($O|$OP)\d+($C|$CP)).*\2//sg;
 3498 	    print STDOUT "pre-LATEX {$env}:\n$lcontents\n" if ($VERBOSITY > 3);
 3499 	    $raw_contents = &revert_to_raw_tex($lcontents);
 3500 	    print STDOUT "LATEX {$env}:\n$raw_contents\n" if ($VERBOSITY > 3);
 3501 	    $latex_body .= "\n$raw_contents"."%\n\n" ;
 3502 	}
 3503 	return("") if ($env =~ /^lrbox/);
 3504 	# ignore enclosed environments; e.g. in  \settolength  commands
 3505 #	$contents = &translate_environments($contents); # ignore environments
 3506 #	$contents = &translate_commands($contents);
 3507 	# ...but apply any Perl settings that may be defined
 3508 	$contents = &process_command($single_cmd_rx,$contents);
 3509 	print STDOUT "\nOUT {$env $id}:\n$contents\n" if ($VERBOSITY > 4);
 3510 	return("");
 3511     }
 3512     # catch pre-processor environments
 3513     if ($PREPROCESS_IMAGES) {
 3514 	local($pre_env,$which, $done, $indic);
 3515 	while ($contents =~ /$pre_processor_env_rx/) {
 3516 	    $done .= $`; $pre_env = $5; $which =$1; $contents = $';
 3517 	    if (($which =~ /begin/)&&($pre_env =~ /indica/)) {
 3518 		if ($contents =~ s/^\[(\w+)]//o) { $done .= '#'.$1 }
 3519 	    } elsif (($which =~ /end/)&&($pre_env =~ /indica/)) {
 3520 		$done .= '#NIL';
 3521 	    } elsif (($which =~ /begin/)&&($pre_env =~ /itrans/)) {
 3522 		if ($contents =~ s/^\[(\w+)]/$indic=$1;''/e)
 3523 	            { $done .= "\#$indic" }
 3524 	    } elsif (($which =~ /end/)&&($pre_env =~ /itrans/)) {
 3525 		$done .= "\#end$indic";
 3526 	    } elsif ($which =~ /begin/) {
 3527 		$done .= (($which =~ /end/)? $end_preprocessor{$pre_env}
 3528 		          : $begin_preprocessor{$pre_env} )
 3529 	    }
 3530 	}
 3531 	$contents = $done . $contents;
 3532     }
 3533     $fullcontents =  $contents; # save for later \label search.
 3534     # MRO: replaced $* with /m
 3535     $contents =~ s/\n?\s*$labels_rx(\%([^\n]+$|$EOL))?/\n/gm;
 3536 
 3537     local($tmp) = $contents;
 3538     $tmp =~ s/^((\\par|\%)?\s*\n)+$//g;
 3539     return( &do_labels($fullcontents, "\&nbsp;") ) unless $tmp;
 3540 
 3541     # just a comment as the contents of a cell in a math-display
 3542     if ($tmp =~ /\$\\(display|text|(script)+)style\s*$comment_mark\d+\s*\$$/)
 3543 	{ return ( &do_labels($fullcontents, "\&nbsp;") ) };
 3544 
 3545     $contents = "\n% latex2html id marker $id\n$contents" if
 3546 	(!$PREAMBLE &&($contents =~ /$order_sensitive_rx/)
 3547 		&&(!($env =~ /makeimage/)));
 3548 
 3549     $env =~ s/displaymath/equation*/
 3550 	if ($contents =~ /\\begin\{(x+|fl)*align/);
 3551     #RRM: include the inline-color, when applicable
 3552     $contents = join(''
 3553 	    , (($inner_math =~ /in(display|line)/) ? '$' : '')
 3554 	    , "\\begin{$env}"
 3555 	    , ($color_env ? "\\bgroup\\$color_env" : '')
 3556 	    , $contents , ($color_env ? "\\egroup" : '')
 3557 	    , "\\end{$env}"
 3558 	    , (($inner_math =~ /in(display|line)/) ? '$' : '')
 3559 	) if ($contents);
 3560 
 3561     # append to the name of special environments found within math
 3562     if ($inner_math) {
 3563 	local($ext) = $inner_math;
 3564 	if ($inner_math =~ /(display|line)/){ $ext = 'in'.$1;};
 3565 	$name =~ s/(\d+)$/_$ext$1/;
 3566     }
 3567 
 3568     if (!($latex_body{$name} = $contents)) {
 3569 	print "\n *** code for $name is too long ***\n"}
 3570     if ($contents =~ /$htmlimage_rx/) {
 3571 	$uucontents = &special_encoding($env,$2,$contents);
 3572     } elsif ($contents =~ /$htmlimage_pr_rx/) {
 3573 	$uucontents = &special_encoding($env,$2,$contents);
 3574     } else {
 3575 	$uucontents = &encode(&addto_encoding($env,$contents));
 3576     }
 3577     $cached = $cached_env_img{$uucontents} if $uucontents;
 3578     print STDOUT "\nCACHED: $uucontents:\n$cached\n" if ($VERBOSITY > 4);
 3579     if ($NOLATEX) { 
 3580 	$id_map{$name} = "[$name]";
 3581     } elsif (defined ($_ = $cached)) { # Is it in our cache?
 3582 	# Have we already used it?
 3583 	if (($oldimg) = /SRC="$PREFIX$img_rx\.$IMAGE_TYPE"/o) {
 3584 	    # No, check its size
 3585 	    local($eis) = 1;
 3586 	    # Does it have extra scaling ?
 3587 	    if ($uucontents =~ /EIS=(.*);/) { $eis = $1 }
 3588 	    ($size, $imgID) = &get_image_size("$PREFIX$oldimg.old", $eis);	
 3589 	    # Does it have extra scaling ?
 3590 #	    if ($uucontents =~ /EIS=(.*);/) {
 3591 #		local($eis) = $1; local($w,$h);
 3592 #		# quotes will not be there with HTML 2.0
 3593 #		$size =~ s/(WIDTH=\")(\d*)(\".*HEIGHT=\")(\d*)\"/
 3594 #		    $w = int($2\/$eis + .5); $h=int($4\/$eis + .5);
 3595 #		    "$1$w$3$h\""/e ; # insert the re-scaled size
 3596 #	    }
 3597 	    # quotes will not be there with HTML 2.0
 3598 	    $size =~ s/\"//g if ($HTML_VERSION < 2.2);
 3599 	    # if ($size && /\s$size\s/) {
 3600 	    # 2020-03-03 shige:
 3601 	    if ($size && /;$size$/) {
 3602 		# Size is OK; recycle it!
 3603 		++$global_page_num;
 3604 		$_ = $cached ;    # ...perhaps restoring the desired size.
 3605 		# 2020-03-03 shige:
 3606 		s/;$size$//;
 3607 		s/(${PREFIX}T?img)\d+\.($IMAGE_TYPE|html)/
 3608 			&rename_html($&,"$1$global_page_num.$2")/geo;
 3609 	    } else {
 3610 		if ($env =~ /equation/) { &extract_eqno($name,$cached) }
 3611 		$_ = "";				# The old Image has wrong size!
 3612 		undef($cached);			#  (or it doesn't exist)
 3613 	    }
 3614 	}
 3615 	s/(IMG\n)/$1$imgID/ if $imgID;
 3616 
 3617 	s/$PREFIX$img_rx\.new/$PREFIX$1.$IMAGE_TYPE/go; # Point to the actual image file(s)
 3618 	$id_map{$name} = $_;
 3619 	s/$PREFIX$img_rx\.$IMAGE_TYPE/$PREFIX$1.new/go;	# But remember them as used.
 3620 	$cached_env_img{$uucontents} = $_ if $uucontents;
 3621     }
 3622 
 3623     if (! defined($cached)) {				# Must generate it anew.
 3624 	&clear_images_dbm_database
 3625 	    unless ($new_page_num ||($NO_SUBDIR && $FIXEDDIR));
 3626 	$new_id_map{$name} = $id_map{$name} = ++$global_page_num . "#" .
 3627 	    ++$new_page_num;
 3628 	$orig_name_map{$id_map{$name}} = $name;
 3629 	$cached_env_img{$uucontents} = $id_map{$name} if ($uucontents && $REUSE == 2);
 3630 
 3631 	#RRM: this (old) code frequently crashes NDBM, so do it in 2 steps
 3632 #	$img_params{$name} = join('#', &extract_parameters($contents));
 3633 	local(@params) = &extract_parameters($contents);
 3634 	$img_params{$name} = join('#',@params); undef $params;
 3635 	print "\nIMAGE_PARAMS $name: ".$img_params{$name} if ($VERBOSITY > 3);
 3636 
 3637 	$contents =~ s/\\(index|label)\s*(($O|$OP)\d+($C|$CP)).*\2//sg;
 3638 	print STDOUT "\nLATEX {$env}:\n$contents" if ($VERBOSITY > 3);
 3639 	$raw_contents = &revert_to_raw_tex($contents) unless ($contents =~ /^\s*$/) ;
 3640 	$raw_contents =~ s/\\pagebreak|\\newpage|\\clearpage/\\\\/go;
 3641 	print STDOUT "\nLATEX {$env}:\n$raw_contents\n" if ($VERBOSITY > 3);
 3642 	local($box_type) = '';
 3643 	if ($raw_contents =~ /\\special\s*\{/) { 
 3644 	    $tex_specials{$name} = "1";
 3645 	    &write_warnings("\nenvironment $name contains \\special commands");
 3646 	    print STDOUT "\n *** environment $name contains \\special commands ***\n"
 3647 		if ($VERBOSITY);
 3648 	} elsif (($env =~ /$inline_env_rx/)||($inner_math =~ /in(line|display)/)) {
 3649 	    # crop to the marks only... or shave a bit off the bottom
 3650 	    if (($env =~ /tex2html_[^w]/)||$inner_math) {
 3651 		# e.g. accents, indic  but not wrap
 3652 		$crop{$name} = "bl";
 3653 		$box_type = "i";		
 3654 	    } else {
 3655 	    # ...or shave a bit off the bottom as well
 3656 		$crop{$name} = "bls";
 3657 		$box_type = "h";
 3658 	    }
 3659 	} elsif (($env =~ /(eqnarray|equation)(\*|star)/)||($inner_math)) {
 3660 	    # crop to minimum size...
 3661 	    $crop{$name} = "blrl";
 3662 	    $box_type = "v";
 3663 	} elsif ($env =~ /(picture|tex2html_wrap)(\*|star)?/) {
 3664 	    # crop hbox to minimum size...
 3665 	    $crop{$name} = "";
 3666 	    $box_type = "p";
 3667 	} elsif ($env =~ /$display_env_rx/) {
 3668 	    # crop vbox to minimum size...
 3669 	    $crop{$name} = "blrl" ;
 3670 	    if ($env =~ /(equation|eqnarray)((s)?$|\d)/) {
 3671 		# ... unless equation numbers are included ...
 3672 		if ($3) { #  AMS {subequations}
 3673 		    $global{'eqn_number'}=$prev_eqn_number if $prev_eqn_number;
 3674 		    #--$global{'eqn_number'};
 3675 		}
 3676 		$raw_contents = join('' ,
 3677 		    (($eqno{$name}||$global{'eqn_number'})?
 3678 		      &set_equation_counter($eqno{$name}) : '')
 3679 		    , $raw_contents);
 3680 		$crop{$name} = "bl" ;
 3681 	    } elsif ($HTML_VERSION < 2.2) {
 3682 		# ... HTML 2.0 cannot align images, so keep the full typeset width
 3683 		$crop{$name} = "bl" ;		
 3684 	    }
 3685 	    $box_type = "v";
 3686 	}
 3687 	
 3688 	#RRM: include the TeX-code for the appropriate type of box.
 3689 	eval "\$raw_contents = \&make_$box_type"."box($name, \$raw_contents);";
 3690 
 3691 	# JCL(jcl-pag) - remember html text if debug is set.
 3692 	local($_);
 3693 	if ($DEBUG) {
 3694 	    $_ = $contents;
 3695 	    s/\n/ /g;
 3696 	    $_ = &revert_to_raw_tex($_);
 3697 	    # incomplete or long commented code can break pre-processors
 3698 	    if ($PREPROCESS_IMAGES) {
 3699 		$_ = ((/^(\\\w+)?\{[^\\\}\<]*\}?/)? $& : '').'...' ;
 3700 		$_ = '{ ... }' if ( length($_) > 100);
 3701 	    } elsif ( length($_) > 200) {
 3702 		    $_ = join('',substr($_,0,200),"...\}");
 3703 	    }
 3704 	    s/\\(begin|end)/$1/g; s/[\000-\020]//g;
 3705 	    $_ = join('',"% contents=",$_,"\n");
 3706 	}
 3707 	$raw_contents = '\setcounter{equation}{'.$prev_eqn_number."}\n".$raw_contents
 3708 	    if ($env =~ /subequations/);
 3709 
 3710 # JCL(jcl-pag) - build the page entries for images.tex:  Each page is embraced to
 3711 # let most statements have only local effect. Each page must compile into a
 3712 # single dvi page to get proper image translation. Hence the invisible glue to
 3713 # get *at least* one page (raw_contents alone might not wield glue), and
 3714 # sufficing page length to get *exactly* one page.
 3715 #
 3716 	$latex_body .= "{\\newpage\\clearpage\n$_" .
 3717 #	    "$raw_contents\\hfill\\vglue1pt\\vfill}\n\n";
 3718 #	    "$raw_contents\\hfill\\vss}\n\n" if ($raw_contents);
 3719 #	    "$raw_contents\\hfill\\lthtmlcheckvsize\\clearpage}\n\n" if ($raw_contents);
 3720 	    "$raw_contents\\lthtmlcheckvsize\\clearpage}\n\n" if ($raw_contents);
 3721     }
 3722     print STDOUT "\nIMAGE_CODE:{$env $id}:\n$raw_contents\n" if ($VERBOSITY > 4);
 3723 
 3724     # Anchor the labels and put a marker in the text;
 3725     local($img) = &do_labels($fullcontents,"$image_mark#$name#");
 3726     print STDOUT "\nUNDEF_OUT {$env $id}:\n$img\n" if ($VERBOSITY > 4);
 3727     return($img) unless (@foot_anchors);
 3728 
 3729     # use the image as source to the 1st footnote, unless it is already an anchor.
 3730     if ($img =~ /<\/?A>/) {
 3731 	join(' ', $img, @foot_anchors);    	
 3732     } elsif ($#foot_anchors ==0) {
 3733 	$foot_anchor = shift @foot_anchors;
 3734 	$foot_anchor =~ s/<SUP>.*<\/SUP>/$img/;
 3735 #	join(' ', $foot_anchor, @foot_anchors);    	
 3736 	$foot_anchor;
 3737     } else {
 3738 	join(' ', $img, @foot_anchors);    	
 3739     }
 3740 }
 3741 
 3742 sub special_encoding { # locally sets $EXTRA_IMAGE_SCALE
 3743     local($env,$_,$contents) = @_; 
 3744     local($exscale) = /extrascale=([\.\d]*)/;
 3745     local($EXTRA_IMAGE_SCALE) = $exscale if ($exscale);
 3746     &encode(&addto_encoding($env,$contents));
 3747 }
 3748 
 3749 
 3750 sub extract_eqno{
 3751     local($name,$contents) = @_;
 3752     if ($contents =~ /<P ALIGN="\w+">\(([^<>])\)<\/P>$/) {
 3753 	if (($eqno{$name})&&!($eqno{$name} eq $1)) {
 3754 	    &write_warnings("\nequation number for $name may be wrong.")};
 3755 	$eqno{$name}="$1";
 3756     }
 3757 }
 3758 sub set_equation_counter{
 3759     if ( $global{'eqn_number'}) {
 3760 	"\\setcounter{equation}{". $global{'eqn_number'} ."}\n"
 3761     } else { "\\setcounter{equation}{0}\n" }
 3762 }
 3763 
 3764 # RRM: 3 different types of boxing, for image environments.
 3765 
 3766 #	general environments --- crops to width & height
 3767 sub make_box {
 3768     local($id,$contents) = @_;
 3769     "\\lthtmlfigureA{". $id ."}%\n". $contents ."%\n\\lthtmlfigureZ\n";
 3770 }
 3771 
 3772 #	inline math --- horizontal mode, captures height/depth + \mathsurround
 3773 sub make_hbox {
 3774     local($id,$contents) = @_;
 3775     if ($id =~ /indisplay/ or $USE_DVIPNG or $IMAGE_TYPE eq 'svg') {
 3776 	"\\lthtmlinlinemathA{". $id ."}%\n". $contents ."%\n\\lthtmlindisplaymathZ\n";
 3777     } else {
 3778 	"\\lthtmlinlinemathA{". $id ."}%\n". $contents ."%\n\\lthtmlinlinemathZ\n";
 3779     }
 3780 }
 3781 
 3782 #	inline text-image (e.g. accents) --- horizontal mode, captures height/depth
 3783 sub make_ibox {
 3784     local($id,$contents) = @_;
 3785     "\\lthtmlinlineA{". $id ."}%\n". $contents ."%\n\\lthtmlinlineZ\n";
 3786 }
 3787 
 3788 #	centered images (e.g. picture environments) --- horizontal mode
 3789 sub make_pbox {
 3790     local($id,$contents) = @_;
 3791     "\\lthtmlpictureA{". $id ."}%\n". $contents ."%\n\\lthtmlpictureZ\n";
 3792 }
 3793 
 3794 #	displayed math --- vertical mode, captures height/depth + page-width
 3795 sub make_vbox {
 3796     local($id,$contents) = @_;
 3797     if (($HTML_VERSION >=3.2)&&($id =~/(equation|eqnarray)($|\d)/) &&! $failed ) {
 3798 	if ($contents =~ s/^\\setcounter\{equation\}\{\d+\}/$&%\n\\lthtmldisplayB\{$id\}%/)
 3799 	    { $contents ."%\n\\lthtmldisplayZ\n" }
 3800 	else { "\\lthtmldisplayB{$id}%\n". $contents ."%\n\\lthtmldisplayZ\n" }
 3801     } else { "\\lthtmldisplayA{$id}%\n". $contents ."%\n\\lthtmldisplayZ\n"}
 3802 }
 3803 
 3804 sub preprocess_images {
 3805     do {
 3806 	print "\nWriting image.pre file ...\n";
 3807 	open(ENV,">.$dd${PREFIX}images.pre")
 3808             || die "\nCannot write '${PREFIX}images.pre': $!\n";
 3809 	print ENV &make_latex($latex_body);
 3810 	print ENV "\n";
 3811 	close ENV;
 3812 	&copy_file($FILE, "bbl");
 3813 	&copy_file($FILE, "aux");
 3814 	local($num_cmds, $cnt, $this, @cmds);
 3815 	@cmds = (split ('\n', $preprocessor_cmds));
 3816 	$this_cmd = $num_cmds = 1+$#cmds;
 3817 	$cnt = $num_cmds; $preprocessor_cmds = '';
 3818 	while (@cmds) {
 3819 	    $this_cmd = shift @cmds; last unless ($this_cmd);
 3820 	    $this_cmd =~ s/.pre /.tex$cnt / if(($cnt)&&($cnt < $num_cmds));
 3821 	    $cnt--; $this_cmd .= $cnt if ($cnt);
 3822 	    $preprocessor_cmds .= $this_cmd."\n";
 3823 	    L2hos->syswait($this_cmd);
 3824 	}
 3825 	# save pre-processor commands in a file:  preproc
 3826 	open(CMDS,">.$dd${PREFIX}preproc")
 3827             || die "\nCannot write '${PREFIX}preproc': $!\n";
 3828 	print CMDS $preprocessor_cmds ;
 3829 	close CMDS;
 3830 
 3831     } if ((%latex_body) && ($latex_body =~ /newpage/));
 3832 }
 3833 sub make_image_file {
 3834     do {
 3835 	print "\nWriting image file ...\n";
 3836 	open(ENV,">.$dd${PREFIX}images.tex")
 3837             || die "\nCannot write '${PREFIX}images.tex': $!\n";
 3838 	print ENV &make_latex($latex_body);
 3839 	print ENV "\n";
 3840 	close ENV;
 3841 	&copy_file($FILE, "bbl");
 3842 	&copy_file($FILE, "aux");
 3843     } if ((%latex_body) && ($latex_body =~ /newpage/));
 3844 }
 3845 
 3846 sub make_latex_images{
 3847     &close_dbm_database if $DJGPP;
 3848     local($dd) = $dd; $dd = '/' if ($dd eq "\\");
 3849     local($latex_call);
 3850     if ($USE_PDFTEX) {
 3851       print "\nTranslating images to PDF using pdflatex ...\n";
 3852       $latex_call = "$PDFLATEX .$dd${PREFIX}images.tex";
 3853     } elsif ($USE_LUATEX) {
 3854       print "\nTranslating images to PDF using lualatex ...\n";
 3855       $latex_call = "$LUALATEX .$dd${PREFIX}images.tex";
 3856     } elsif ($USE_LUADVI) {
 3857       print "\nTranslating images to DVI using dvilualatex ...\n";
 3858       $latex_call = "$DVILUALATEX .$dd${PREFIX}images.tex";
 3859     } else {
 3860       print "\nTranslating images to DVI using latex ...\n";
 3861       $latex_call = "$LATEX .$dd${PREFIX}images.tex";
 3862     }
 3863     print "$latex_call\n" if (($DEBUG)||($VERBOSITY > 1));
 3864     L2hos->syswait($latex_call);
 3865     &open_dbm_database if $DJGPP;
 3866 }
 3867 
 3868 sub make_off_line_images {
 3869     local($name, $page_num);
 3870     if (!$NOLATEX && -f ".${dd}${PREFIX}images.tex") {
 3871 	&make_tmp_dir;	# sets  $TMPDIR  and  $DESTDIR
 3872 	$IMAGE_PREFIX =~ s/^_//o if ($TMPDIR);
 3873 
 3874 	&make_latex_images();
 3875 
 3876 	&process_log_file(".$dd${PREFIX}images.log"); # Get eqn size info
 3877 	unless ($LaTeXERROR) {
 3878 	    &call_dvips();
 3879 	    # add suffix .ps to the file-names for each image
 3880 	    if(opendir(DIR, $TMPDIR || '.')) {
 3881                 #  use list-context instead; thanks De-Wei Yin <yin@asc.on.ca>
 3882 	        my (@ALL_IMAGE_FILES) = grep /^$IMAGE_PREFIX\d+$/o, readdir(DIR);
 3883 	        foreach (@ALL_IMAGE_FILES) {
 3884 		        L2hos->Rename("$TMPDIR$dd$_", "$TMPDIR$dd$_.ps");
 3885 	        }
 3886 	        closedir(DIR);
 3887             } else {
 3888                 print "\nError: Cannot read dir '$TMPDIR': $!\n";
 3889             }
 3890 	}
 3891     }
 3892     if ($LaTeXERROR) {
 3893         print "\n\n*** LaTeXERROR\n"; return();
 3894     }
 3895 
 3896     for $name (sort keys %new_id_map) {
 3897         $page_num = $new_id_map{$name};
 3898 	# Extract the page, convert and save it
 3899 	&extract_image($page_num,$orig_name_map{$page_num});
 3900     }
 3901 }
 3902 
 3903 # calls either dvips, dvipng, gs, or nothing as specified
 3904 # by command line options
 3905 sub call_dvips {
 3906     # local($dvips_call);
 3907     # 2019-12-27 shige: 2-44)
 3908     local($dvips_call, $dvips_call2);
 3909     if ($USE_PDFTEX || $USE_LUATEX) {
 3910 	# svg images are produced directly from images.pdf,
 3911 	# don't need to do anything here
 3912 	if ($IMAGE_TYPE ne 'svg') {
 3913 	    $dvips_call .= "$GS -q -dNOPAUSE -dNO_PAUSE -dBATCH -dNOSAFER ";
 3914 	    # -dNOSAFER is so that we can write to $TMPDIR - gs 9.50
 3915 	    if ($USE_DVIPNG) {
 3916 		my $device = $IMAGE_TYPE eq 'gif' ?
 3917 		    #'png256' :		# png256 provides bad dithering
 3918 		    'png16m' :		# better use png16m and quantize later
 3919 		    'png16m';		# 24 bit color for png
 3920 		print "\nTransforming PDF images using gs/$device ...\n";
 3921 		$dvips_call .= "-sDEVICE=$device -r$DVIPNG_DPI -dTextAlphaBits=4 -dGraphicsAlphaBits=4 -sOutputFile=$TMPDIR$dd$IMAGE_PREFIX%d.png .${dd}${PREFIX}images.pdf";
 3922 	    } else {
 3923 		# did not usepackage{preview}, need to crop
 3924 		print "\nTransforming PDF images to postscript using gs/ps2write ...\n";
 3925 		$dvips_call2 = $dvips_call . "-sDEVICE=ps2write -sOutputFile=$TMPDIR$dd$IMAGE_PREFIX%.3d.ps .${dd}${PREFIX}images-crop.pdf";
 3926 		$dvips_call = "$PDFCROP --hires " . ($DEBUG ? '--debug ' : '')
 3927 		    . ".${dd}${PREFIX}images.pdf";
 3928 	    }
 3929 	}
 3930     } else {
 3931 	# have dvi - not using pdftex or luatex
 3932 	if ($IMAGE_TYPE ne 'svg') {
 3933 	    if ($USE_DVIPNG) {
 3934 		print "\nGenerating images using dvipng ...\n";
 3935 		$dvips_call = "$DVIPNG -D $DVIPNG_DPI -o$TMPDIR$dd$IMAGE_PREFIX%d.png -T tight .${dd}${PREFIX}images.dvi";
 3936 	    } else {
 3937 		print "\nGenerating postscript images using dvips ...\n";
 3938 		$dvips_call = "$DVIPS -S1 -i $DVIPSOPT -o$TMPDIR$dd${IMAGE_PREFIX} .${dd}${PREFIX}images.dvi";
 3939 	    }
 3940 	} else {
 3941 	    # $dvips_call = "$DVIPS .${dd}${PREFIX}images.dvi && $PS2PDF .${dd}${PREFIX}images.ps";
 3942 	    # 2019-10-29, 2019-12-27 shige: 2-41)
 3943 	    $dvips_call = "$DVIPS .${dd}${PREFIX}images.dvi";
 3944 	    $dvips_call2 = "$PS2PDF .${dd}${PREFIX}images.ps";
 3945 	    print $dvips_call, "\n";
 3946 	}
 3947     }
 3948     if ($dvips_call) {
 3949 	print $dvips_call if (($DEBUG)||($VERBOSITY > 1));
 3950 	&close_dbm_database if $DJGPP;
 3951 	L2hos->syswait($dvips_call) && print "Error: $!\n";
 3952 	if ($dvips_call2) {
 3953 	    L2hos->syswait($dvips_call2) && print "Error: $!\n";
 3954 	}
 3955 	&open_dbm_database if $DJGPP;
 3956     }
 3957 }
 3958 
 3959 # Generate images for unknown environments, equations etc, and replace
 3960 # the markers in the main text with them.
 3961 # - $cached_env_img maps encoded contents to image URL's
 3962 # - $id_map maps $env$id to page numbers in the generated latex file and after
 3963 # the images are generated, maps page numbers to image URL's
 3964 # - $page_map maps page_numbers to image URL's (temporary map);
 3965 # Uses global variables $id_map and $cached_env_img,
 3966 # $new_page_num and $latex_body
 3967 
 3968 
 3969 sub make_images {
 3970     local($name, $contents, $raw_contents, $uucontents, $page_num,
 3971 	  %page_map, $img);
 3972     # 2020-03-03 shige:
 3973     local $imgsize;
 3974     # It is necessary to run LaTeX this early because we need the log file
 3975     # which contains information used to determine equation alignment
 3976     if ( $latex_body =~ /newpage/) {
 3977 	print "\n";
 3978 	if ($LATEX_DUMP) {
 3979 	    local ($plain_latex) = !($USE_PDFTEX || $USE_LUATEX || $USE_LUADVI);
 3980 	    # dump a pre-compiled format
 3981 	    if (!(-f "${PREFIX}images.fmt") && $plain_latex) {
 3982 	        print "$INILATEX .$dd${PREFIX}images.tex\n" 
 3983 		    if (($DEBUG)||($VERBOSITY > 1));
 3984 	        print "dumping ${PREFIX}images.fmt\n"
 3985 		    unless ( L2hos->syswait("$INILATEX .$dd${PREFIX}images.tex"));
 3986 	    }
 3987 	    local ($img_fmt) = (-f "${PREFIX}images.fmt");
 3988 	    if ($img_fmt && $plain_latex) {
 3989                 # use the pre-compiled format
 3990 	        print "$TEX \"&.$dd${PREFIX}images\" .$dd${PREFIX}images.tex\n"
 3991 		    if (($DEBUG)||($VERBOSITY > 1));
 3992 	        L2hos->syswait("$TEX \"&.$dd${PREFIX}images\" .$dd${PREFIX}images.tex");
 3993 	    } elsif (-f "${PREFIX}images.dvi" && $plain_latex) {
 3994 	        print "${PREFIX}images.fmt failed, proceeding anyway\n";
 3995 	    } else {
 3996 	        if ($plain_latex) {
 3997 		  print "${PREFIX}images.fmt failed, trying without it\n";
 3998 		} else {
 3999 		  print "${PREFIX}images.fmt cannot be created with pdftex or luatex\n";
 4000 		}
 4001 		if ($USE_PDFTEX) {
 4002 		  print "\nTranslating images to PDF using pdflatex ...\n";
 4003 		  print "$PDFLATEX .$dd${PREFIX}images.tex\n"
 4004 		    if (($DEBUG)||($VERBOSITY > 1));
 4005 		  L2hos->syswait("$PDFLATEX .$dd${PREFIX}images.tex");
 4006 		} elsif ($USE_LUATEX) {
 4007 		  print "\nTranslating images to PDF using lualatex ...\n";
 4008 		  print "$LUALATEX .$dd${PREFIX}images.tex\n"
 4009 		    if (($DEBUG)||($VERBOSITY > 1));
 4010 		  L2hos->syswait("$LUALATEX .$dd${PREFIX}images.tex");
 4011 		} elsif ($USE_LUADVI) {
 4012 		  print "\nTranslating images to DVI using dvilualatex ...\n";
 4013 		  print "$DVILUALATEX .$dd${PREFIX}images.tex\n"
 4014 		    if (($DEBUG)||($VERBOSITY > 1));
 4015 		  L2hos->syswait("$DVILUALATEX .$dd${PREFIX}images.tex");
 4016 		} else {
 4017 		  print "\nTranslating images to DVI using latex ...\n";
 4018 		  print "$LATEX .$dd${PREFIX}images.tex\n"
 4019 		    if (($DEBUG)||($VERBOSITY > 1));
 4020 		  L2hos->syswait("$LATEX .$dd${PREFIX}images.tex");
 4021 		}
 4022 	    }
 4023 	} else { &make_latex_images() }
 4024 #	    local($latex_call) = "$LATEX .$dd${PREFIX}images.tex";
 4025 #	    print "$latex_call\n" if (($DEBUG)||($VERBOSITY > 1));
 4026 #	    L2hos->syswait("$latex_call");
 4027 ##	    print "$LATEX .$dd${PREFIX}images.tex\n" if (($DEBUG)||($VERBOSITY > 1));
 4028 ##	    L2hos->syswait("$LATEX .$dd${PREFIX}images.tex");
 4029 ##        }
 4030 	$LaTeXERROR = 0;
 4031 	&process_log_file(".$dd${PREFIX}images.log"); # Get image size info
 4032     }
 4033     if ($NO_IMAGES) {
 4034         my $img = "image.$IMAGE_TYPE";
 4035 	my $img_path = "$LATEX2HTMLDIR${dd}icons$dd$img";
 4036 	L2hos->Copy($img_path, ".$dd$img")
 4037             if(-e $img_path && !-e $img);
 4038     }
 4039     elsif ((!$NOLATEX) && ($latex_body =~ /newpage/) && !($LaTeXERROR)) {
 4040 	$IMAGE_PREFIX =~ s/^_//o if ($TMPDIR);
 4041 	&call_dvips();
 4042 	# append .ps suffix to the filenames
 4043 	if(opendir(DIR, $TMPDIR || '.')) {
 4044             # use list-context instead; thanks De-Wei Yin <yin@asc.on.ca>
 4045 	    my @ALL_IMAGE_FILES = grep /^$IMAGE_PREFIX\d+$/o, readdir(DIR);
 4046 	    foreach (@ALL_IMAGE_FILES) {
 4047 	        L2hos->Rename("$TMPDIR$dd$_", "$TMPDIR$dd$_.ps");
 4048 	    }
 4049 	    closedir(DIR);
 4050         } else {
 4051             print "\nError: Cannot read dir '$TMPDIR': $!\n";
 4052         }
 4053     }
 4054     do {print "\n\n*** LaTeXERROR"; return()} if ($LaTeXERROR);
 4055     return() if ($LaTeXERROR); # empty .dvi file
 4056     L2hos->Unlink(".$dd${PREFIX}images.dvi") unless $DEBUG;
 4057 
 4058     print "\n *** updating image cache\n" if ($VERBOSITY > 1);
 4059     while ( ($uucontents, $_) = each %cached_env_img) {
 4060 	delete $cached_env_img{$uucontents}
 4061 	    if ((/$PREFIX$img_rx\.$IMAGE_TYPE/o)&&!($DESTDIR&&$NO_SUBDIR));
 4062 	$cached_env_img{$uucontents} = $_
 4063 	    if (s/$PREFIX$img_rx\.new/$PREFIX$1.$IMAGE_TYPE/go);
 4064     }
 4065     print "\n *** removing unnecessary images ***\n" if ($VERBOSITY > 1);
 4066     for $name (sort keys %id_map) {
 4067         $page_num = $id_map{$name};
 4068 	$contents = $latex_body{$name};
 4069 	if ($page_num =~ /^\d+\#\d+$/) { # If it is a page number
 4070 	    do {		# Extract the page, convert and save it
 4071 		# $img = &extract_image($page_num,$orig_name_map{$page_num});
 4072 		# 2020-03-03 shige:
 4073 		($img, $imgsize) = &extract_image($page_num,$orig_name_map{$page_num});
 4074 		if ($contents =~ /$htmlimage_rx/) {
 4075 		    $uucontents = &special_encoding($env,$2,$contents);
 4076 		} elsif ($contents =~ /$htmlimage_pr_rx/) {
 4077 		    $uucontents = &special_encoding($env,$2,$contents);
 4078 		} else {
 4079 		    $uucontents = &encode(&addto_encoding($contents,$contents));
 4080 		}
 4081 		if ($uucontents && ($HTML_VERSION >=3.2)||!($contents=~/$order_sensitive_rx/)){
 4082 		    $cached_env_img{$uucontents} = $img;
 4083 		    # 2020-03-03 shige:
 4084 		    if ($imgsize) { $cached_env_img{$uucontents} .= ";$imgsize"; }
 4085 		} else {
 4086                     # Blow it away so it is not saved for next time
 4087 		    delete $cached_env_img{$uucontents};
 4088 		    print "\nimage $name not recycled, contents may change (e.g. numbering)";
 4089 		}
 4090 		$page_map{$page_num} = $img;
 4091 	    } unless ($img = $page_map{$page_num}); # unless we've just done it
 4092 	    $id_map{$name} = $img;
 4093 	} else {
 4094 	    $img = $page_num;	# it is already available from previous runs
 4095 	}
 4096 	print STDOUT " *** image done ***\n" if ($VERBOSITY > 2);
 4097     }
 4098     &write_warnings(
 4099 		    "\nOne of the images is more than one page long.\n".
 4100 		    "This may cause the rest of the images to get out of sync.\n\n")
 4101 	if (-f sprintf("%s%.3d%s", $IMAGE_PREFIX, ++$new_page_num, ".ps"));
 4102     print "\n *** no more images ***\n"  if ($VERBOSITY > 1);
 4103     # MRO: The following cleanup seems to be incorrect: The DBM is
 4104     # still open at this stage, this causes a lot of unlink errors
 4105     #
 4106     #do { &cleanup; print "\n *** clean ***\n"  if ($VERBOSITY > 1);}
 4107     #	unless $DJGPP;
 4108 }
 4109 
 4110 # MRO: This copies the navigation icons from the distribution directory
 4111 # or an alternative specified in $ALTERNATIVE_ICONS
 4112 # to the document directory.
 4113 
 4114 sub copy_icons {
 4115     local($icon,$_);
 4116     print "\nCopying navigation icons ...";
 4117     foreach (keys %used_icons) {
 4118 	# each entry ends in svg or gif or png
 4119 	if ($ALTERNATIVE_ICONS) {
 4120 	    L2hos->Copy("$ALTERNATIVE_ICONS$dd$_", ".$dd$_")
 4121 		if (-e "$ALTERNATIVE_ICONS$dd$_" && !-e $_);
 4122 	} elsif (/(svg|gif|png)$/) {
 4123 	    L2hos->Copy("$LATEX2HTMLDIR${dd}icons$dd$_", ".$dd$_")
 4124 		if (-e "$LATEX2HTMLDIR${dd}icons$dd$_" && !-e $_);
 4125 	}
 4126     }
 4127 }
 4128 
 4129 sub process_log_file {
 4130     local($logfile) = @_;
 4131     local($name,$before,$lengthsfound);
 4132     local($TeXpt)= 72/72.27;
 4133     local($image_counter);
 4134     open(LOG, "<$logfile") || die "\nCannot read logfile '$logfile': $!\n";
 4135     while (<LOG>) {
 4136         if (/Overfull/) { $before .= $_ }
 4137         elsif (/latex2htmlLength ([a-zA-Z]+)=(\-?[\d\.]+)pt/) {
 4138 	    ${$1} = 0.0+$2; $lengthsfound = 1;
 4139 	} elsif (/latex2htmlSize|l2hSize/) {
 4140 	    /:([^:]*):/;
 4141 	    $name = $1; $name =~ s/\*//g;
 4142 	    ++$image_counter;
 4143 	    s/:([0-9.]*)pt/$height{$name} = $1*$TeXpt;''/e;
 4144 	    s/::([0-9.]*)pt/$depth{$name} = $1*$TeXpt;''/e;
 4145 	    s/::([0-9.]*)pt/$width{$name} = $1*$TeXpt;''/e;
 4146 	    s/\((.*)\)/$eqno{$name} = 1+$1;''/e;
 4147 	    if ($before) {
 4148 		local($tmp);
 4149 		if ($before =~ /hbox\s*\((\d+\.?\d*)pt/) {
 4150 		    $width{$name} = $width{$name}+$1*$TeXpt;
 4151 		}
 4152 		if ($before =~ /vbox\s*\((\d+\.?\d*)pt/) {
 4153 		    $height{$name} = $height{$name}+$1*$TeXpt;
 4154 		}
 4155 	        $before = '';
 4156 	    }
 4157 	} else {
 4158 	    s/^\:([^:]*)\:lthtmlCropMarkHeight\:\=([0-9.]*)pt/$cropmarkheight{$1} = $2;''/e;
 4159 	    s/^\:([^:]*)\:lthtmlCropMarkDepth\:\=([0-9.]*)pt\:1ex:=([0-9.]*)pt//;
 4160 	    $ptdepth{$1} = $2 + .5;
 4161 	    # extra .5 pt in depth is border from latex 'preview' packagea
 4162 	    $pt_per_ex{$1} = $3;
 4163 	    # $pt_per_ex contains the length of 1 ex measured in points,
 4164 	    #  and is used to scale the image to the curent html font size
 4165 	}
 4166     $LaTeXERROR = 1 if (/^No pages of output./);
 4167     }
 4168 
 4169     if ($LaTeXERROR) {
 4170 	print STDERR "\n\n *** LaTeX produced no output ***\n"
 4171 	    . " *** no new images can be created\n"
 4172 	    . " *** Examine the  images.log  file.\n\n";
 4173 	return;
 4174     }
 4175     print STDOUT "\n *** processing $image_counter images ***\n";
 4176     print STDOUT "\n *** LATEX LOG OK. ***\n" if ($VERBOSITY > 1);
 4177 
 4178     if ($lengthsfound) {
 4179 	$ODD_HMARGIN  = $hoffset + $oddsidemargin;
 4180 	$EVEN_HMARGIN = $hoffset + $evensidemargin;
 4181 	$VMARGIN = $voffset + $topmargin + $headheight + $headsep;
 4182         if ($dvi_mag >0 && $dvi_mag != 1000) {
 4183 	    $ODD_HMARGIN = int($dvi_mag /1000 * $ODD_HMARGIN);
 4184 	    $EVEN_HMARGIN = int($dvi_mag /1000 * $EVEN_HMARGIN);
 4185 	    $VMARGIN = int($dvi_mag /1000 * $VMARGIN);
 4186 	}
 4187     } else {
 4188 	$ODD_HMARGIN = 0;
 4189 	$EVEN_HMARGIN = 0;
 4190 	$VMARGIN = 0;
 4191     }
 4192     $ODD_HMARGIN  = int($ODD_HMARGIN*$TeXpt  + 72.5);
 4193     $EVEN_HMARGIN = int($EVEN_HMARGIN*$TeXpt + 72.5);
 4194     $VMARGIN = int($VMARGIN*$TeXpt + 72.5);
 4195     close(LOG);
 4196 }
 4197 
 4198 sub extract_image {
 4199     # dispatch to vector routine or bitmap routine
 4200     if ($IMAGE_TYPE eq 'svg') {
 4201 	&extract_image_svg(@_);
 4202     } else {
 4203 	&extract_image_bitmap(@_);
 4204     }
 4205 }
 4206 
 4207 sub extract_image_svg {
 4208     my ($page_num,$name) = @_;
 4209 
 4210     # The followin come out of %img_params
 4211     my ($scale, $external, $thumbnail, $map, $psimage, $align, $usemap,
 4212 	  $flip, $aalias, $trans, $exscale, $alt, $exstr);
 4213 
 4214     my ($lwidth, $val) = (0, '');
 4215     my ($custom_size,$color_depth,$height,$width,$croparg);
 4216 
 4217     print STDOUT "\nextracting $name as $page_num\n" if ($VERBOSITY > 1);
 4218     # $global_num identifies this image in the original source file
 4219     # $new_num identifies this image in images.tex
 4220     my ($global_num, $new_num) = split(/#/, $page_num);
 4221     $name =~ s/\*/star/;
 4222     my ($env,$basename,$img) = ($name,"img$global_num",'');
 4223     $env =~ s/\d+$//;
 4224     $img = "$basename.$IMAGE_TYPE";
 4225     ($scale, $external, $thumbnail, $map, $psimage, $align, $usemap, 
 4226      $flip, $aalias, $trans, $exscale, $alt, $exstr) =
 4227 	split('#', $img_params{$name});
 4228     $lwidth = ($align =~ s/nojustify/middle/) ? 0 : $LINE_WIDTH;
 4229     $alt = "ALT=\"$name\"" unless $alt;
 4230     $exscale = $EXTRA_IMAGE_SCALE unless($exscale);
 4231     
 4232     # without -noshrink and -nocenter, pdftocairo scales image slightly
 4233     # due to internally rounding page size to nearest integer number of pt
 4234     $svg_cmd ="$PDFTOCAIRO -svg -noshrink -nocenter -f $new_num -l $new_num ${PREFIX}images.pdf -";
 4235     print $svg_cmd, "\n" if ($VERBOSITY > 2);
 4236     open(PDF2SVG, "$svg_cmd|") || die;
 4237     open(SVG, ">${PREFIX}img$new_num.svg") || die;
 4238     while (<PDF2SVG>) {	# filter svg file
 4239       if (/^<svg .* width="([\d.]+)pt" height="([\d.]+)pt" /) {
 4240 	if ($pt_per_ex{$name}) {
 4241 	  $eheight{$name} = $2 / $pt_per_ex{$name};	# image height in ex
 4242 	  $edepth{$name} = $ptdepth{$name} / $pt_per_ex{$name};
 4243 	  # extra .5pt in depth is border from latex "preview" package
 4244 	}
 4245 	if ($name =~ /$inline_env_rx/) {
 4246 	  # remove image size so that image can scale with font size
 4247 	  s/width="([\d.]+)pt" height="([\d.]+)pt" //;
 4248 	}
 4249       }
 4250       print SVG;
 4251     }
 4252     close SVG;
 4253 
 4254     undef $thumbnail;	# don't use thumbnail with svg
 4255 
 4256     print "\nextracted $name as $page_num\n" if ($VERBOSITY > 1);
 4257     &embed_image("${PREFIX}$img", $name, $external, $alt, $thumbnail, $map,
 4258         $align, $usemap, $exscale, $exstr);
 4259 }
 4260 
 4261 
 4262 
 4263 sub extract_image_bitmap { # clean
 4264     my ($page_num,$name) = @_;
 4265 
 4266     # The followin come out of %img_params
 4267     my ($scale, $external, $thumbnail, $map, $psimage, $align, $usemap,
 4268 	  $flip, $aalias, $trans, $exscale, $alt, $exstr);
 4269 
 4270     my ($lwidth, $val) = (0, '');
 4271     my ($custom_size,$color_depth,$color_quant,$height,$width,$croparg);
 4272     my ($ehfull,$ehbot,$ehshift);
 4273 
 4274     # The combination -use_pdftex -use_dvipng uses gs driver png16m
 4275     # which can be incompatible with gif format (>256 colors).
 4276     $color_depth = $color_quant = '';
 4277     if (($USE_PDFTEX || $USE_LUATEX) && $USE_DVIPNG && $IMAGE_TYPE =~ /gif/) {
 4278         $color_depth = "-depth 8 ";
 4279         $color_quant = "|$PNMQUANT -norandom -floyd 256";
 4280     }
 4281 
 4282     print STDOUT "\nextracting $name as $page_num\n" if ($VERBOSITY > 1);
 4283     # $global_num identifies this image in the original source file
 4284     # $new_num identifies this image in images.tex
 4285     my ($global_num, $new_num) = split(/#/, $page_num);
 4286     $name =~ s/\*/star/;
 4287     my ($env,$basename,$img) = ($name,"img$global_num",'');
 4288     $env =~ s/\d+$//;
 4289     $psname = sprintf("%s%.3d", "$TMPDIR$dd$IMAGE_PREFIX", $new_num);
 4290     if ( $EXTERNAL_IMAGES && $PS_IMAGES ) {
 4291 	$img =  "$basename.ps";
 4292 	L2hos->Copy("$psname.ps", "${PREFIX}$img");
 4293     } else {
 4294 	$img = "$basename.$IMAGE_TYPE";
 4295 	($scale, $external, $thumbnail, $map, $psimage, $align, $usemap, 
 4296 	    $flip, $aalias, $trans, $exscale, $alt, $exstr) =
 4297             split('#', $img_params{$name});
 4298 	$lwidth = ($align =~ s/nojustify/middle/) ? 0 : $LINE_WIDTH;
 4299 	$alt = "ALT=\"$name\"" unless $alt;
 4300 	$exscale = $EXTRA_IMAGE_SCALE unless($exscale);
 4301 	if ($NO_IMAGES) {
 4302 	    L2hos->Symlink("image.$IMAGE_TYPE", "${PREFIX}$img");
 4303 	    if ($thumbnail) {
 4304 		L2hos->Symlink("image.$IMAGE_TYPE", "${PREFIX}T$img");
 4305 		$thumbnail = "${PREFIX}T$img";
 4306 	    }
 4307     } elsif ($cropmarkheight{$name}) {
 4308         my $p="$TMPDIR$dd$IMAGE_PREFIX$new_num";
 4309         die $! unless -f "$p.png";
 4310         &close_dbm_database if $DJGPP;
 4311         my $imgpixeloverex=72.27/($pt_per_ex{$name}*$DVIPNG_DPI);
 4312         $imgpixeloverex *=$EXTRA_IMAGE_SCALE if $EXTRA_IMAGE_SCALE ;
 4313         print "imgpixeloverex=$imgpixeloverex\n" if ($VERBOSITY > 2);
 4314         if ( $name =~ /figure|table/ and $FIGURE_SCALE_FACTOR) 
 4315             {$imgpixeloverex*= $FIGURE_SCALE_FACTOR;}
 4316         if ($name =~ /equation|eqnarray|display/){
 4317             $imgpixeloverex *= $DISP_SCALE_FACTOR if $DISP_SCALE_FACTOR}
 4318         my $millimeter=int(.04*$DVIPNG_DPI); 
 4319         if ($TRANSPARENT_FIGURES) {
 4320 	    my $TRANSPARENT_COLOR=
 4321 		$ENV{'TRANSPARENT_COLOR'} || '#FFFFFF';
 4322 	    # The '=' sign before color value specifies the exact color
 4323 	    # and prevents netpbm from selecting other random color
 4324 	    # if the actual image eventually has no transparency.
 4325 	    $transparent= "-transparent \"=$TRANSPARENT_COLOR\"";
 4326 	} else {
 4327 	    $transparent ='';
 4328 	}
 4329         my $PPMTO=$IMAGE_TYPE=~m/gif/i? $PPMTOGIF : $PNMTOPNG;
 4330         if ($name =~ /figure|table/) {
 4331 	  L2hos->syswait("$PNGTOPNM $p.png $color_quant >$p.ppm");
 4332 	  L2hos->syswait("$PPMTO --quiet $transparent $p.ppm >${PREFIX}img$new_num.$IMAGE_TYPE");
 4333 	} else {
 4334 	    L2hos->syswait("$PNGTOPNM $p.png|$PNMCROP -sides $color_quant >$p.ppm");
 4335 
 4336 	    L2hos->syswait("$PNGTOPNM $p.png >$p-full.ppm");
 4337 	    L2hos->syswait("$PNMCROP -sides -bottom $p-full.ppm >$p-bot.ppm");
 4338 	    L2hos->syswait("$PNMCROP -sides $p-full.ppm $color_quant >$p.ppm");
 4339 	    L2hos->syswait("$PPMTO --quiet $transparent $p.ppm >${PREFIX}img$new_num.$IMAGE_TYPE");
 4340 	}
 4341         $edepth{$name}=$ptdepth{$name}/$pt_per_ex{$name};
 4342 	# extra .5pt in depth is border from latex "preview" package
 4343         print "edepth{$name}=$edepth{$name}\n" if ($VERBOSITY > 2);
 4344         open PPM,"<$p-full.ppm"; binmode(PPM); read(PPM,$_,30);close PPM;
 4345         m/^(\d+) (\d+)$/m; 
 4346 	$ehfull = $2;			# full image height in pixels
 4347         open PPM,"<$p-bot.ppm"; binmode(PPM); read(PPM,$_,30);close PPM;
 4348         m/^(\d+) (\d+)$/m; 
 4349 	$ehbot = $2;			# image height cropped at bottom
 4350 	# Image should not be cropped at bottom more than latex-preview border
 4351 	$ehshift = ($ehfull-$ehbot)*$imgpixeloverex-0.5/$pt_per_ex{$name};
 4352 	$ehshift = 0
 4353 	    if ($ehfull-$ehbot <= ceil(0.5/$imgpixeloverex/$pt_per_ex{$name}));
 4354 	# Correct image depth if it was cropped at bottom too much
 4355 	$edepth{$name} -= $ehshift;
 4356         # open PPM,"<$p.ppm"; read(PPM,$_,30);close PPM;
 4357 	# 2019-12-12 shige: 2-44)
 4358         open PPM,"<$p.ppm"; binmode(PPM); read(PPM,$_,30);close PPM;
 4359         m/^(\d+) (\d+)$/m; 
 4360 	$eheight{$name}=$2*$imgpixeloverex;	# image height in ex
 4361         print "eheight{$name}=$ehieight{$name}\n" if ($VERBOSITY > 2);
 4362         &open_dbm_database if $DJGPP;
 4363 	} else {
 4364 	    # RRM: deal with size data
 4365  	    if ($width{$name} < 0) {
 4366 		if ($exscale && $PK_GENERATION) {
 4367 	    	    $height = int(				
 4368 			$exscale*$height{$name}+	
 4369 			$exscale*$depth{$name} +.5);
 4370 		    $width = int($exscale*$width{$name}-.5);
 4371 		} else {
 4372 	    	    $height = int($height{$name}+$depth{$name}+.5);
 4373 		    $width = int($width{$name}-.5);
 4374 		}
 4375 		$custom_size = "${width}x$height";
 4376 	    } elsif ($width{$name}) {
 4377 		if ($exscale && $PK_GENERATION) {
 4378 		    $height = int( $height{$name} * $exscale +
 4379 			$depth{$name} * $exscale +.5);
 4380 		    $width = int($width{$name} * $exscale +.5);
 4381 		} else {
 4382 		    $height = int($height{$name}+$depth{$name}+.5);
 4383 		    $width = int($width{$name}+.5);
 4384 		}
 4385 		$custom_size = "${width}x$height";
 4386             } else {
 4387 		$custom_size = '';
 4388 	    }
 4389             # MRO: add first overall crop
 4390 	    $croparg = '-crop a' . ($crop{$name} || '') . ' ';
 4391 	    $page_num  =~ s/^\d+#//o;
 4392 	    $custom_size .= " -margins "
 4393 		. (($page_num % 2) ? $ODD_HMARGIN:$EVEN_HMARGIN)
 4394 		. ",$VMARGIN" if ($custom_size);
 4395 
 4396 	    #RRM: \special commands may place ink outside the expected bounds:
 4397 	    $custom_size = '' if ($tex_specials{$name});
 4398 
 4399 	    # MRO: Patches for image conversion with pstoimg
 4400 	    # RRM: ...with modifications and fixes
 4401 	    L2hos->Unlink("${PREFIX}$img");
 4402 	    &close_dbm_database if $DJGPP;
 4403             print "Converting image #$new_num\n";
 4404 
 4405 	    if ( ($name =~ /figure/) || $psimage || $scale || $thumbnail) {
 4406 		$scale = $FIGURE_SCALE_FACTOR unless ($scale);
 4407 		print "\nFIGURE: $name scaled $scale  $aalias\n" if ($VERBOSITY > 2);
 4408 		(L2hos->syswait( "$PSTOIMG -type $IMAGE_TYPE "
 4409 		. ($DEBUG ? '-debug ' : '-quiet ' )
 4410 		. ($TMPDIR ? "-tmp $TMPDIR " : '' )
 4411 		. (($DISCARD_PS && !$thumbnail && !$psimage)? "-discard " :'')
 4412 		. (($INTERLACE) ? "-interlace " : '' )
 4413 		. (((($ANTI_ALIAS)||($aalias))&&($aalias !~ /no|text/))? "-antialias ":'')
 4414 		. (($ANTI_ALIAS_TEXT||(($aalias =~/text/)&&($aalias !~/no/)))?
 4415 			"-aaliastext ":'') 
 4416 		. (($custom_size) ? "-geometry $custom_size ": '' )
 4417 		. $croparg
 4418 		. ($color_depth || '')
 4419 		. (($flip) ? "-flip $flip " : '' )
 4420 		. (($scale > 0) ? "-scale $scale " : '' )
 4421 		. (((($TRANSPARENT_FIGURES && ($env =~ /figure/o))||($trans))
 4422 		     &&(!($trans =~ /no/))) ? "-transparent " : '')
 4423 		. (($WHITE_BACKGROUND) ? "-white " : '' )
 4424 		. "-out ${PREFIX}$img $psname.ps"
 4425 		) ) # ||!(print "\nWriting image: ${PREFIX}$img"))
 4426 		    && print "\nError while converting image: $!\n";
 4427 
 4428 		if ($thumbnail) { # $thumbnail contains the reduction factor
 4429 		    L2hos->Unlink("${PREFIX}T$img");
 4430 		    print "\nIMAGE thumbnail: $name" if ($VERBOSITY > 2);
 4431 		    (L2hos->syswait( "$PSTOIMG -type $IMAGE_TYPE "
 4432 		    . ($DEBUG ? '-debug ' : '-quiet ' )
 4433 		    . ($TMPDIR ? "-tmp $TMPDIR " : '' )
 4434 		    . (($DISCARD_PS && !$psimage) ? "-discard " : '' )
 4435 		    . (($INTERLACE) ? "-interlace " : '' )
 4436 		    . ((($ANTI_ALIAS||($aalias))&&(!($aalias =~/no/)))? "-antialias " :'')
 4437 		    . (($ANTI_ALIAS_TEXT||(($aalias =~/text/)&&($aalias !~/no/)))?
 4438 			"-aaliastext ":'') 
 4439 		    . (($custom_size) ? "-geometry $custom_size " : '' )
 4440 		    . ($color_depth || '')
 4441 		    . (($flip) ? "-flip $flip " : '' )
 4442 		    . (($thumbnail > 0) ? "-scale $thumbnail " : '' )
 4443 		    . ((($trans)&&(!($trans =~ /no/))) ? "-transparent " : '')
 4444 		    . (($WHITE_BACKGROUND) ? "-white " : '' )
 4445 		    . "-out ${PREFIX}T$img $psname.ps"
 4446 		    ) ) # ||!(print "\nWriting image: ${PREFIX}T$img"))
 4447 			&& print "\nError while converting thumbnail: $!\n";
 4448 		    $thumbnail = "${PREFIX}T$img";
 4449 		}
 4450 	    } elsif (($exscale &&(!$PK_GENERATION))&&($width{$name})) {
 4451 		my $under = '';
 4452 		my $mathscale = ($MATH_SCALE_FACTOR > 0) ? $MATH_SCALE_FACTOR : 1;
 4453 		if (($DISP_SCALE_FACTOR > 0) &&
 4454 		    ( $name =~ /equation|eqnarray|display/))
 4455 		        { $mathscale *= $DISP_SCALE_FACTOR; };
 4456 		if ($scale) {
 4457 		    $scale *= $exscale if ($name =~ /makeimage|tab/);
 4458 		} else {
 4459 		    $scale = $mathscale*$exscale;
 4460 		    $under = "d" if (($name =~/inline|indisplay/)&&($depth{$name}));
 4461 		}
 4462 		print "\nIMAGE: $name  scaled by $scale \n" if ($VERBOSITY > 2);
 4463 		$color_depth = ''
 4464 		    if (($ANTI_ALIAS_TEXT || $aalias) && $aalias !~ /no/);
 4465 		(L2hos->syswait( "$PSTOIMG -type $IMAGE_TYPE "
 4466 		. ($DEBUG ? '-debug ' : '-quiet ' )
 4467 		. ($TMPDIR ? "-tmp $TMPDIR " : '' )
 4468 		. (($DISCARD_PS)? "-discard " : '' )
 4469 		. (($INTERLACE)? "-interlace " : '' )
 4470 		. ((($ANTI_ALIAS_TEXT||($aalias))&&($aalias !~ /no/))? 
 4471 		    "-antialias -depth 1 " :'')
 4472 		. (($custom_size)? "-geometry $custom_size " : '' )
 4473                 . $croparg
 4474 		. ($color_depth || '')
 4475 		. (($scale != 1)? "-scale $scale " : '' )
 4476 		. (($exscale && ($exscale == int($exscale))&&($exscale != 1)&&
 4477 		    !($ANTI_ALIAS_TEXT &&($LATEX_COLOR)))? 
 4478 			"-shoreup $exscale$under " :'')
 4479 		. ((($TRANSPARENT_FIGURES ||($trans))
 4480 		     &&(!($trans =~ /no/)))? "-transparent " : '')
 4481 		. (($WHITE_BACKGROUND && !$TRANSPARENT_FIGURES) ? "-white " : '' )
 4482 		. "-out ${PREFIX}$img $psname.ps"
 4483 		) ) # ||!(print "\nWriting image: ${PREFIX}$img"))
 4484 		    && print "\nError while converting image: $!\n";
 4485 	    } else {
 4486 		print "\nIMAGE: $name\n" if ($VERBOSITY > 2);
 4487 		my $under = '';
 4488 		my $mathscale = ($MATH_SCALE_FACTOR > 0) ? $MATH_SCALE_FACTOR : 1;
 4489 		if (($DISP_SCALE_FACTOR > 0) &&
 4490 		    ( $name =~ /equation|eqnarray|display/))
 4491 		        { $mathscale *= $DISP_SCALE_FACTOR; };
 4492 		if (($scale)&&($exscale)) {
 4493 		    $scale *= $exscale if ($name =~ /makeimage|tab/);
 4494 		} elsif ($scale) {
 4495 		} elsif (($mathscale)&&($exscale)) {
 4496 		    $scale = $mathscale*$exscale;
 4497 		    $under = "d" if (($name =~/inline|indisplay/)&&($depth{$name}));
 4498 		} elsif ($mathscale) { $scale = $mathscale; }
 4499 
 4500 		$color_depth = ''
 4501 		    if (($ANTI_ALIAS_TEXT || $aalias) && $aalias !~ /no/);
 4502 		(L2hos->syswait("$PSTOIMG -type $IMAGE_TYPE "
 4503 		. ($DEBUG ? '-debug ' : '-quiet ' )
 4504 		. ($TMPDIR ? "-tmp $TMPDIR " : '' )
 4505 		. (($DISCARD_PS) ? "-discard " : '' )
 4506 		. (($INTERLACE) ? "-interlace " : '' )
 4507 		. ((($ANTI_ALIAS_TEXT||($aalias))&&(!($aalias =~ /no/)))?
 4508 		    "-antialias -depth 1 " :'')
 4509 		. (($exscale && ($exscale == int($exscale))&&($exscale != 1)&&
 4510 		    !($ANTI_ALIAS_TEXT &&($LATEX_COLOR)))? 
 4511 			"-shoreup $exscale " :'')
 4512 		. (($scale ne 1) ? "-scale $scale " : '' )
 4513 		. (($custom_size) ? "-geometry $custom_size " : '' )
 4514                 . $croparg
 4515 		. ($color_depth || '')
 4516 #		.  (($name =~ /(equation|eqnarray)/) ? "-rightjustify $lwidth " : '')
 4517 #		.  (($name =~ /displaymath/) ? "-center $lwidth " : '')
 4518 		. (($name =~ /inline|indisplay/ && (!($custom_size))&&$depth{$name}!= 0) ?
 4519 		    do {$val=($height{$name}-$depth{$name})/($height{$name}+$depth{$name});
 4520 			"-topjustify x$val "} : '')
 4521 		. ((($TRANSPARENT_FIGURES||($trans))
 4522 		    &&(!($trans =~ /no/))) ? "-transparent " : '')
 4523 		. (($WHITE_BACKGROUND && !$TRANSPARENT_FIGURES) ? "-white " : '' )
 4524 		. "-out ${PREFIX}$img $psname.ps")
 4525 		) #|| !(print "\nWriting image: ${PREFIX}$img"))
 4526 		    && print "\nError while converting image\n";
 4527 	    }
 4528 	    if (! -r "${PREFIX}$img") {
 4529 		&write_warnings("\nFailed to convert image $psname.ps")
 4530 	    } else { } #L2hos->Unlink("$psname.ps") unless $DEBUG }
 4531 	    &open_dbm_database if $DJGPP;
 4532 	}
 4533     }
 4534     # embed_image does not know how to scale unrecognized environments
 4535     # dvips used to use some empirical scaling coefficient (=1.6)
 4536     # in dvipng mode try to rescale them relative to the scaling of dvips
 4537     # and transfer to embed_image as the $exscale parameter
 4538     if ($USE_DVIPNG && $DVIPNG_DPI && !$exscale &&
 4539 	$name !~ /inline|display|entity|equation|math|eqn|makeimage|figure|tab/)
 4540     {
 4541 	$exscale = 1;
 4542 	$exscale = $MATH_SCALE_FACTOR if ($MATH_SCALE_FACTOR > 0);
 4543 	$exscale = $scale if ($scale);
 4544 	$exscale = $DVIPNG_DPI/72/$exscale;
 4545     }
 4546     print "\nextracted $name as $page_num\n" if ($VERBOSITY > 1);
 4547     &embed_image("${PREFIX}$img", $name, $external, $alt, $thumbnail, $map,
 4548         $align, $usemap, $exscale, $exstr);
 4549 }
 4550 
 4551 sub extract_parameters {
 4552     local($contents) = @_;
 4553     local($_, $scale, $external, $thumbnail, $map, $psimage, $align,
 4554 	  $usemap, $flip, $aalias, $trans, $pagecolor, $alt, $exscale,
 4555 	  $cdepth, $htmlparams);
 4556 
 4557     #remove the \htmlimage commands and arguments before...
 4558     $contents =~ s/$htmlimage_rx/$_ = $2;''/ego;
 4559     $contents =~ s/$htmlimage_pr_rx/$_ .= $2;''/ego;
 4560 
 4561     # code adapted from original idea by Stephen Gildea:
 4562     # If the document specifies the ALT tag explicitly
 4563     # with \htmlimage{alt=some text} then use it.
 4564     s!alt=([^,]+)!$alt = $1;
 4565         $alt =~ s/^\s+|\s+$//g; $alt =~ s/"//g;
 4566         $alt="ALT=\"$alt\"";
 4567     ''!ie;
 4568 
 4569   if (!$alt) {
 4570     #...catching all the code for the ALT text.
 4571     local($keep_gt)=1;
 4572     $alt = &flatten_math($contents); undef $keep_gt;
 4573     #RRM: too long strings upset the DBM. Truncate to <= 165 chars.
 4574     if ( length($alt) > 163 ) {
 4575 	local($start,$end);
 4576 	$start = substr($alt,0,80);
 4577 	$end = substr($alt,length($alt)-80,80);
 4578 	$alt = join('',$start,"...\n ...",$end);
 4579     }
 4580     s/ALT\s*=\"([\w\W]*)\"/$alt=$1;''/ie;
 4581     if ($alt) {
 4582 	if ($alt =~ /\#/) {
 4583 	    $alt =~ s/^(\\vbox\{)?\#[A-Za-z]*\s*//;
 4584 	    $alt =~ s/\n?\#[A-Za-z]*\s*\}?$//s;
 4585 	    if ($alt =~ /\#/) { $alt = $` . " ... " };
 4586 	}
 4587 	$alt =~ s/\`\`/\\lq\\lq /g; $alt =~ s/\`/\\lq /g;
 4588 	$alt =~ s/(^\s*|\s*$)//mg;
 4589 	$alt = "ALT=\"$alt\"" if ($alt);
 4590     } else { $alt = 'ALT="image"' }
 4591   }
 4592 
 4593     $psimage++ if ($contents =~ /\.ps/);
 4594 #    $contents =~ s/\s//g;	# Remove spaces   Why ?
 4595     s/extrascale=([\.\d]*)/$exscale=$1;''/ie;
 4596     s/\bscale=([\.\d]*)/$scale=$1;''/ie;
 4597     s/(^|,\s*)external/$external=1;''/ie;
 4598     s/(^|,\s*)((no)?_?anti)alias(_?(text))?/$aalias = $2.$4;''/ie;
 4599     s/(^|,\s*)((no)?_?trans)parent/$trans = $2;''/ie;
 4600     s/thumbnail=([\.\d]*)/$thumbnail=$1;''/ie;
 4601     s/usemap=([^\s,]+)/$usemap=$1;''/ie;
 4602     s/map=([^\s,]+)/;$map=$1;''/ie;
 4603     s/align=([^\s,]+)/$align=$1;''/ie;
 4604     s/flip=([^\s,]+)/$flip=$1;''/ie;
 4605     s/color_?(depth)?=([^\s,]+)/$cdepth=$2;''/ie;
 4606     ($scale,$external,$thumbnail,$map,$psimage,$align
 4607      ,$usemap,$flip,$aalias,$trans,$exscale,$alt,$_);
 4608 }
 4609 
 4610 
 4611 # RRM: Put the raw \TeX code into the ALT tag
 4612 # replacing artificial environments and awkward characters
 4613 sub flatten_math {
 4614     local ($_) = @_;
 4615     $_ = &revert_to_raw_tex($_);
 4616     s/[ \t]+/ /g;
 4617     s/^\$\s+/\$/;
 4618     # MRO: replaced $* with /m
 4619     s/$tex2html_wrap_rx//gm;
 4620     s/(\\begin\s*\{[^\}]*\})(\s*(\[[^]]*\]))?[ \t]*/$1$3/gm;
 4621     s/(\\end\{[^\}]*\})\n?/$1/gm;
 4622     s/>(\w)?/($1)?"\\gt $1":"\\gt"/eg unless ($keep_gt); # replace > by \gt
 4623     s/\\\|(\w)?/($1)?"\\Vert $1":"\\Vert"/eg; 	# replace \| by \Vert
 4624     s/\|(\w)?/($1)?"\\vert $1":"\\vert"/eg; 	# replace | by \vert
 4625     s/\\\\/\\\\ /g; 	# insert space after \\ 
 4626     s/\\"/\\uml /g;	# screen umlaut accents...
 4627     s/"/\'\'/g;		# replace " by ''
 4628     s/\\\#/\\char93 /g;	# replace \# by \char93 else caching fails
 4629 #    s/"(\w)?/($1)?"\\rq\\rq $1":"\'\'"/eg;	# replace " by \rq\rq
 4630 #    s/\&\\uml /\\\"/g;	# ...reinstate umlauts
 4631     $_;
 4632 }
 4633 
 4634 sub scaled_image_size {
 4635     local($exscale,$_) = @_;
 4636     local($width,$height) = ('','');
 4637     /WIDTH=\"?(\d*)\"?\s*HEIGHT=\"?(\d*)\"?$/o;
 4638     $width=int($1/$exscale + .5);
 4639     $height=int($2/$exscale + .5);
 4640     "WIDTH=\"$width\" HEIGHT=\"$height\""
 4641 }
 4642 
 4643 sub process_in_latex {
 4644     # This is just a wrapper for process_undefined_environment.
 4645     # @[0] = contents
 4646     $global{'max_id'}++;
 4647     &process_undefined_environment('tex2html_wrap',$global{'max_id'},$_[0]);
 4648 }
 4649 
 4650 # MRO: cp deprecated, replaced by L2hos->Copy
 4651 
 4652 # Marcus Hennecke  6/3/96
 4653 # MRO: test for existance
 4654 sub copy_file {
 4655     local($file, $ext) = @_;
 4656     $file =  &fulltexpath("$FILE.$ext");
 4657     if(-r $file) {
 4658         print "\nNote: Copying '$file' for image generation\n"
 4659             if($VERBOSITY > 2);
 4660         L2hos->Copy($file, ".$dd${PREFIX}images.$ext");
 4661     }
 4662 }
 4663 
 4664 sub rename_image_files {
 4665     local($_, $old_name, $prefix);
 4666     if ($PREFIX) {
 4667 	foreach (<${PREFIX}*img*.$IMAGE_TYPE>) {
 4668 	    $old_name = $_;
 4669 	    s/\.$IMAGE_TYPE$/\.old/o;
 4670 	    L2hos->Rename($old_name, $_);
 4671 	    }
 4672 	}
 4673     else {
 4674 	foreach (<img*.$IMAGE_TYPE>) {
 4675 	    $old_name = $_;
 4676 	    s/\.$IMAGE_TYPE$/\.old/o;
 4677 	    L2hos->Rename($old_name, $_);
 4678 	}
 4679 	foreach (<Timg*.$IMAGE_TYPE>) {
 4680 	    $old_name = $_;
 4681 	    s/\.$IMAGE_TYPE$/\.old/o;
 4682 	    L2hos->Rename($old_name, $_);
 4683 	}
 4684     }
 4685 }
 4686 
 4687 
 4688 ############################ Processing Commands ##########################
 4689 
 4690 sub ignore_translate_commands {
 4691     local ($_) = @_;
 4692 #   print "\nTranslating commands ...";
 4693 
 4694     local(@processedC);
 4695     &replace_strange_accents;
 4696     local($before, $contents, $br_id, $after, $pattern, $end_cmd_rx);
 4697     s/$begin_cmd_rx/&replace_macro_expansion($`, $1, $&, $')/eg;
 4698 }
 4699 
 4700 sub replace_macro_expansion {
 4701     push(@processedC,$_[1]);
 4702     $end_cmd_rx = &make_end_cmd_rx($_[2]);
 4703     $pattern = $_[3];
 4704     $_ = join('',$_[3],$_[4]);
 4705     $after = $_[4];
 4706     if (($before)&&(!($before =~ /$begin_cmd_rx/))) {
 4707 	push(@processedC,$before);
 4708 	    $_ = join('',$pattern,$after); $before = '';
 4709 	}
 4710 	local($end_cmd_rx) = &make_end_cmd_rx($br_id);
 4711     
 4712 }
 4713 
 4714 sub translate_aux_commands {
 4715     s/^(.*)$/&translate_commands($1)/es;
 4716 }
 4717 
 4718 sub translate_commands {
 4719     local ($_) = @_;
 4720 #   print "\nTranslating commands ...";
 4721 
 4722     local(@processedC);
 4723     &replace_strange_accents;
 4724     for (;;) {			# For each opening bracket ...
 4725 	last unless ($_ =~ /$begin_cmd_rx/);
 4726 	local($before, $contents, $br_id, $after, $pattern);
 4727 	($before, $br_id, $after, $pattern) = ($`, $1, $', $&);
 4728 	if (($before)&&(!($before =~ /$begin_cmd_rx/))) {
 4729 	    push(@processedC,$before);
 4730 	    $_ = join('',$pattern,$after); $before = '';
 4731 	}
 4732 	local($end_cmd_rx) = &make_end_cmd_rx($br_id);
 4733 	if ($after =~ /$end_cmd_rx/) { # ... find the the matching closing one
 4734 	    $NESTING_LEVEL++;
 4735 	    ($contents, $after) = ($`, $');
 4736 	    do {
 4737 		local(@save_open_tags) = @$open_tags_R;
 4738 		local($open_tags_R) = [ @save_open_tags ];
 4739 		print STDOUT "\nIN::{$br_id}" if ($VERBOSITY > 4);
 4740 		print STDOUT "\n:$contents\n" if ($VERBOSITY > 7);
 4741 		undef $_;
 4742 		$contents = &translate_commands($contents)
 4743 		    if ($contents =~ /$match_br_rx/o);
 4744                 # Modifies $contents
 4745 		&process_command($single_cmd_rx,$contents)
 4746 		    if ($contents =~ /\\/o);
 4747 
 4748 		$contents .= &balance_tags();
 4749 	    };
 4750 
 4751 	    print STDOUT "\nOUT: {$br_id}" if ($VERBOSITY > 4);
 4752 	    print STDOUT "\n:$contents\n" if ($VERBOSITY > 7);
 4753 	    # THIS MARKS THE OPEN-CLOSE DELIMITERS AS PROCESSED
 4754 	    $_ = join("", $before,"$OP$br_id$CP", $contents,"$OP$br_id$CP", $after);
 4755 	    $NESTING_LEVEL--;
 4756 	}
 4757 	else {
 4758 	    $pattern = &escape_rx_chars($pattern);
 4759 	    s/$pattern//;
 4760 	    print "\nCannot find matching bracket for $br_id" unless $AUX_FILE;
 4761 	}
 4762 	last unless ($_ =~ /$begin_cmd_rx/o);
 4763     }
 4764     $_ = join('',@processedC) . $_;
 4765     # Now do any top level commands that are not inside any brackets
 4766     # MODIFIES $_
 4767     print $_ if ($VERBOSITY > 8);
 4768     &process_command($single_cmd_rx,$_);
 4769 }
 4770 
 4771 #RRM: based on earlier work of Marcus Hennecke
 4772 # makes sure the $open_tags_R at the end of an environment
 4773 # is the same as @save_open_tags from the start,
 4774 # ensuring that the HTML page indeed has balanced tags
 4775 sub balance_tags {
 4776     local($tag_cmd, $tags, $save_tags, $open_tags, @reopen_tags);
 4777     $save_tags = join(',',@save_open_tags) if (@save_open_tags);
 4778     $open_tags = join(',',@$open_tags_R) if (@$open_tags_R);
 4779     if ($open_tags eq $save_tags) { return(); }
 4780     if ($save_tags =~ s/^\Q$open_tags\E//) {
 4781 	@reopen_tags = split (',',$');
 4782     } else {
 4783 	@reopen_tags = @save_open_tags;
 4784 	while (@$open_tags_R) {
 4785 	    $tag_cmd = pop (@$open_tags_R);
 4786 	    print STDOUT "\n</$tag_cmd>" if $VERBOSITY > 2;
 4787 	    $declarations{$tag_cmd} =~ m|</.*$|;
 4788 	    $tags .= $& unless ($` =~ /^<>$/);
 4789 	    $open_tags = join(',',@$open_tags_R) if (@$open_tags_R);
 4790 	    last if ( $save_tags =~ s/^\Q$open_tags\E/
 4791 		     @reopen_tags = split (',',$');''/e);
 4792 	}
 4793     }
 4794     while (@reopen_tags) {
 4795 	$tag_cmd = shift @reopen_tags;
 4796 	if ($tag_cmd) {
 4797 	    push (@$open_tags_R, $tag_cmd) if ($tag_cmd);
 4798 	    print STDOUT "\n<$tag_cmd>" if $VERBOSITY > 2;
 4799 	    $declarations{$tag_cmd} =~ m|</.*$|;
 4800 	    $tags .= $` unless ($` =~ /^<>$/);
 4801 	}
 4802     }
 4803     $tags;
 4804 }
 4805 
 4806 sub close_all_tags {
 4807     return() if (!@$open_tags_R);
 4808     local($tags,$tag_cmd);
 4809     while (@$open_tags_R) {
 4810 	$tag_cmd = pop (@$open_tags_R);
 4811 	print STDOUT "\n</$tag_cmd>" if $VERBOSITY > 2;
 4812 	$declarations{$tag_cmd} =~ m|</.*$|;
 4813 	$tags .= $& unless ($` =~ /^<>$/);
 4814     }
 4815     $tags;
 4816 }
 4817 
 4818 sub preserve_open_tags {
 4819     local(@save_open_tags) = @$open_tags_R;
 4820     local($open_tags_R) = [ @save_open_tags ];
 4821     # provides the markup to close and reopen the current tags
 4822     (&close_all_tags(), &balance_tags());
 4823 }
 4824 
 4825 sub preserve_open_block_tags {
 4826     local($tag_cmd,$tags_open,$tags_close,$pre,$post,@tags);
 4827     while (@$open_tags_R) {
 4828 	$tag_cmd = pop (@$open_tags_R);
 4829 	print STDOUT "\n</$tag_cmd>" if $VERBOSITY > 2;
 4830 	$declarations{$tag_cmd} =~ m|</.*$|;
 4831 	($pre,$post) = ($`,$&);
 4832 	if ($post =~ /$block_close_rx/) {
 4833 	    # put it back and exit
 4834 	    push(@$open_tags_R,$tag_cmd);
 4835 	    last;
 4836 	} else {
 4837 	    # leave it closed, collecting tags for it
 4838 	    $tags_close .= $post;
 4839 	    $tags_open = $pre . $tags_open;
 4840 	    unshift(@tags,$tag_cmd);
 4841 	}
 4842     }
 4843     ($tags_close , $tags_open, @tags);  
 4844 }
 4845 
 4846 sub minimize_open_tags {
 4847     local($this_tag, $close_only) = @_;
 4848     local($pre,$post,$decl);
 4849     $decl = $declarations{$this_tag};
 4850     if ($decl) {
 4851     # if it is a declaration, get the corresponding tags...
 4852 	$decl =~ m|</.*$|;
 4853 	($pre,$post) = ($`,$&) unless ($` =~ /^<>$/);
 4854 	if (!@$open_tags_R) { # when nothing else is open...
 4855             # pushing the style, when appropriate
 4856 	    push (@$open_tags_R, $this_tag)
 4857 		unless ($close_only ||($post =~ /$block_close_rx/));
 4858 	    print STDOUT "\n<$this_tag>" if $VERBOSITY > 2;
 4859             # and return the tags
 4860 	    return($pre,$post) unless ($USING_STYLES);
 4861 	    local($env_id) = '' if ($env_id =~/^\w+$/);
 4862 	    $pre =~ s/>$/ $env_id>/ if ($env_id);
 4863 	    return($pre,$post);
 4864 	}
 4865     } else { # ...else record the argument as $pre
 4866 	$pre = $this_tag unless $close_only;
 4867     }
 4868     local($env_id) = '' if ($env_id =~/^\w+$/);
 4869     $pre =~ s/>$/ ID="$env_id">/ if ($USING_STYLES &&($env_id));
 4870 
 4871     # return the tags, if nothing is already open
 4872     if (!@$open_tags_R) { 
 4873 	return($pre,$post);
 4874     }
 4875 #    elsif ($close_only) { push (@$open_tags_R, $this_tag) }
 4876 
 4877     local($tags,$tag_cmd,$tag_open);
 4878     local($closures,$reopens,@tags);
 4879     local($tag_close,$tag_open);
 4880     local($align_cmd,$align_open);
 4881     local($size_cmd,$size_open);
 4882     local($font_cmd,$font_open);
 4883     local($fontwt_cmd,$fontwt_open);
 4884     local($color_cmd,$color_open);
 4885     if ($decl) {
 4886 	if ($this_tag =~ /$alignchange_rx/) { 
 4887 	    $align_cmd = $this_tag;
 4888 	} elsif ($this_tag =~ /$sizechange_rx/) { 
 4889 	    $size_cmd = $this_tag;
 4890 	} else {
 4891 	    if ($this_tag =~ /$fontchange_rx/) { 
 4892 	        $font_cmd = $this_tag }
 4893 	    if ($this_tag =~ /$fontweight_rx/) { 
 4894 		$fontwt_cmd = $this_tag }
 4895 	}
 4896     }
 4897     while (@$open_tags_R) {
 4898 	($tag_close,$tag_open) = ('','');
 4899 	$tag_cmd = pop (@$open_tags_R);
 4900 	print STDOUT "\n</$tag_cmd>" if $VERBOSITY > 2;
 4901 	$declarations{$tag_cmd} =~ m|</.*$|;
 4902 	($tag_close,$tag_open) = ($&,$`) unless ($` =~ /<>/);
 4903 	$closures .= $tag_close;
 4904 
 4905 	if ((!$align_cmd)&&($tag_cmd =~ /$alignchange_rx/)) {
 4906 	    $align_cmd = $tag_cmd;
 4907 	    $align_open = $tag_open;
 4908 	}
 4909 	elsif ((!$size_cmd)&&($tag_cmd =~ /$sizechange_rx/)) {
 4910 	    $size_cmd = $tag_cmd;
 4911 	    $size_open = $tag_open;
 4912 	}
 4913 	elsif ((!$font_cmd)&&($tag_cmd =~ /$fontchange_rx/)) {
 4914 	    $font_cmd = $tag_cmd;
 4915 	    $font_open = $tag_open;
 4916 	}
 4917 	elsif ((!$fontwt_cmd)&&($tag_cmd =~ /$fontweight_rx/)) {
 4918 	    $fontwt_cmd = $tag_cmd;
 4919 	    $fontwt_open = $tag_open;
 4920 	}
 4921 	elsif ((!$color_cmd)&&($tag_cmd =~ /$colorchange_rx/)) {
 4922 	    $color_cmd = $tag_cmd;
 4923 	    $color_open = $tag_open;
 4924 	} 
 4925 	elsif ($tag_cmd =~ 
 4926 	     /$alignchange_rx|$sizechange_rx|$fontchange_rx|$fontweight_rx|$colorchange_rx/) {
 4927 	} else {
 4928 	    unshift (@tags, $tag_cmd);
 4929 	    print STDOUT "\n<<$tag_cmd>" if $VERBOSITY > 2;
 4930 	    $reopens = $tag_open . $reopens;
 4931 	}
 4932     }
 4933     if ($USING_STYLES) {
 4934 	local($TAG) = "DIV";
 4935 	if ($pre =~ /^<(DIV|SPAN|PRE)/) { $TAG = $1 };
 4936 	if (($pre =~ /^<$TAG/)&&($env_id =~ /^\s+(CLASS|ID)/)) {
 4937 	    $pre =~ s/<$TAG/<$TAG$env_id/;
 4938 	} elsif ($pre =~ /<P>/) {
 4939 	    $TAG = 'P';
 4940 	} else {
 4941 	}
 4942 #	$post .= "</$TAG>";
 4943     }
 4944     push (@$open_tags_R, @tags);
 4945     $tags .= $pre if ($pre && $post =~ /$block_close_rx/);
 4946     if ($align_cmd && !($align_cmd eq $this_tag)) {
 4947 	# This tag must be checked first when found
 4948 	push (@$open_tags_R,$align_cmd);
 4949 	print STDOUT "\n<$align_cmd>" if $VERBOSITY > 2;
 4950 	$tags .= $align_open;
 4951     }
 4952     if ($font_cmd && !($font_cmd eq $this_tag)) {
 4953 	push (@$open_tags_R,$font_cmd);
 4954 	print STDOUT "\n<$font_cmd>" if $VERBOSITY > 2;
 4955 	$tags .= $font_open;
 4956     }
 4957     if ($fontwt_cmd && !($fontwt_cmd eq $this_tag)) {
 4958 	push (@$open_tags_R,$fontwt_cmd);
 4959 	print STDOUT "\n<$fontwt_cmd>" if $VERBOSITY > 2;
 4960 	$tags .= $fontwt_open;
 4961     }
 4962     if ($size_cmd && !($size_cmd eq $this_tag)) {
 4963 	push (@$open_tags_R,$size_cmd);
 4964 	print STDOUT "\n<$size_cmd>" if $VERBOSITY > 2;
 4965 	$tags .= $size_open;
 4966     }
 4967     if ($color_cmd && !($color_cmd eq $this_tag)) {
 4968 	push (@$open_tags_R,$color_cmd);
 4969 	print STDOUT "\n<$color_cmd>" if $VERBOSITY > 2;
 4970 	$tags .= $color_open;
 4971     }
 4972     $tags .= $pre unless ($pre && $post =~ /$block_close_rx/);
 4973     push (@$open_tags_R, $this_tag)
 4974 	if ($decl &&!($post =~ /$block_close_rx|$all_close_rx/));
 4975     print STDOUT "\n<$this_tag>" if $VERBOSITY > 2;
 4976     ($closures.$reopens.$tags , $post );
 4977 }
 4978 
 4979 
 4980 sub declared_env {
 4981     local($decl, $_, $deferred) = @_;
 4982     local($after_cell,$pre,$post);
 4983     local($decls) = $declarations{$decl};
 4984     $decls =~ m|</.*$|;
 4985     ($pre,$post) = ($`,$&);
 4986     if ($USING_STYLES) {
 4987 	$env_style{$decl} = " " unless ($env_style{$decl});
 4988 	$pre =~ s/>$/$env_id>/ if ($env_id);
 4989     }
 4990     local($closing_tag) = 1 if ($pre =~ /^<>$/);
 4991     $pre = $post = '' if $closing_tag;
 4992     local($closures,$reopens);
 4993 
 4994     local(@save_open_tags) = @$open_tags_R
 4995 	unless ($closing_tag || $deferred);
 4996     local($open_tags_R) = [ @save_open_tags ]
 4997 	unless ($closing_tag || $deferred );
 4998 
 4999     if ($post =~ /$block_close_rx/) {
 5000 	local($last_tag) = pop (@$open_tags_R);
 5001 	local($ldecl) = $declarations{$last_tag};
 5002 	if ($ldecl =~ m|</.*$|) { $ldecl = $& }
 5003 	if (($last_tag)&&!($ldecl =~ /$block_close_rx/)) {
 5004 	    # need to close tags, for re-opening inside
 5005 	    push (@$open_tags_R, $last_tag);
 5006 	    ($closures,$reopens) = &preserve_open_tags();
 5007 	    $pre = join('', $closures, "\n", $pre, $reopens);
 5008 	    $post = join('', $closures, $post, $reopens);
 5009 	} elsif ($last_tag) {
 5010 	    $pre = "\n".$pre;
 5011 	    push (@$open_tags_R, $last_tag);
 5012 	    undef $ldecl;
 5013 	} else {
 5014 	}
 5015 
 5016 	if ($deferred) {
 5017 	    if (defined $ldecl) {
 5018 		print STDOUT "\n<<$decl>" if $VERBOSITY > 2;
 5019 		unshift(@$open_tags_R, $decl);
 5020 	    } else {
 5021 		print STDOUT "\n<$decl>" if $VERBOSITY > 2;
 5022 		push(@$open_tags_R, $decl);
 5023 	    }
 5024 	    return ( $pre . $_ );
 5025 	} else {
 5026 	    if (defined $ldecl) {
 5027 		print STDOUT "\n<<$decl>" if $VERBOSITY > 2;
 5028 		unshift(@$open_tags_R, $decl);
 5029 	    } else {
 5030 		print STDOUT "\n<$decl>" if $VERBOSITY > 2;
 5031 		push(@$open_tags_R, $decl);
 5032 	    }
 5033 	}
 5034     } elsif ($post =~/$all_close_rx/) {
 5035 	($closures,$reopens) = &preserve_open_tags();
 5036 	($pre,$post) = &minimize_open_tags($decl,1);
 5037 	$pre = join('', $closures, $pre);
 5038     } elsif ($closing_tag) {
 5039 	$prev_open = $pre;
 5040 	($pre,$post) = &minimize_open_tags($decl,1);
 5041 	$pre =~ s/<\/?>//g; $post =~ s/<\/?>//;
 5042     } else {
 5043 	($pre,$post) = &minimize_open_tags($decl); 
 5044     }
 5045     $_ =~ s/^\s+//s; #RRM:28/4/99 remove spaces at the beginning
 5046     $_ = &translate_environments($_);
 5047     $_ = &translate_commands($_) if (/\\/);
 5048     if ($post =~ /$block_close_rx/) {
 5049 	s/^\n?/\n/o; 
 5050 	if (defined $ldecl) {
 5051 	    $post = &close_all_tags();
 5052 	} else {
 5053 	    $post = "\n";
 5054 	}
 5055     } elsif ($post =~/$all_close_rx/) {
 5056     } else { $post = '' };
 5057 
 5058     join('', $pre, $_, $post
 5059 	   , ($closing_tag ? '' : &balance_tags()) );
 5060 }
 5061 
 5062 # SGE: reimplemented via $declarations{$cmd} in &process_command
 5063 #sub do_cmd_centering{&declared_env('center',$_[0],$tex2html_deferred)}
 5064 #sub do_cmd_raggedright{&declared_env('flushleft',$_[0],$tex2html_deferred)}
 5065 #sub do_cmd_raggedleft{&declared_env('flushright',$_[0],$tex2html_deferred)}
 5066 
 5067 sub do_env_verse { &declared_env('verse',@_) }
 5068 sub do_env_quote { &declared_env('quote', @_) }
 5069 sub do_env_quotation { &declared_env('quote', @_) }
 5070 sub do_env_tex2html_preform { &declared_env('preform', @_) }
 5071 sub do_env_tex2html_ord { &declared_env('ord', @_) }
 5072 sub do_env_tex2html_unord { &declared_env('unord', @_) }
 5073 sub do_env_tex2html_desc { &declared_env('desc', @_) }
 5074 
 5075 
 5076 # Modifies $contents
 5077 sub process_command {
 5078     # MRO: modified to use $_[1]
 5079     # local ($cmd_rx, *ref_contents) = @_;
 5080     local ($cmd_rx) = @_;
 5081     local ($ref_before, $cmd, $bcmd, $pc_after);
 5082     local ($cmd_sub, $cmd_msub, $cmd_wsub, $cmd_trans, $mathentity);
 5083     local (@open_font_tags, @open_size_tags);
 5084     $_[1] = &convert_iso_latin_chars($_[1])
 5085 	unless (($cmd =~ /(Make)?([Uu]pp|[Ll]ow)ercase/)||
 5086 	    ((!$cmd)&&($_[1] =~ /^\\(Make)?([Uu]pp|[Ll]ow)ercase/s)));
 5087 
 5088     local(@ref_processed);
 5089     for (;;) {			# Do NOT use the o option
 5090 	last unless ($_[1] =~ /$cmd_rx/ );
 5091 	print ".";
 5092 	#JCL(jcl-del) - use new regexp form which handles white space
 5093 	($ref_before, $cmd, $pc_after) = ($`, $1.$2, $4.$');
 5094 	push(@ref_processed,$ref_before);
 5095 #print "\nAFTER:$1.$2:".$4."\n" if ($cmd_rx eq $single_cmd_rx);
 5096 	print STDOUT "$cmd" if ($VERBOSITY > 2);
 5097 	print STDOUT "\nIN: $_[1]\n" if ($VERBOSITY > 6);
 5098 	# keep cmd name before being normalized
 5099 	$bcmd = $cmd;
 5100 	if ( $cmd = &normalize($cmd,$pc_after) ) {
 5101 	    ($cmd_sub, $cmd_msub, $cmd_wsub, $cmd_trans, $mathentity) =
 5102 		("do_cmd_$cmd", "do_math_cmd_$cmd", "wrap_cmd_$cmd"
 5103 		, $declarations{$cmd}, $mathentities{$cmd});
 5104 	    if ($new_command{$cmd}||$renew_command{$cmd}) { 
 5105                 # e.g. some \the$counter 
 5106 		local($argn, $body, $opt) = split(/:!:/, $new_command{$cmd});
 5107 		&make_unique($body) if ($body =~ /$O/);
 5108 		if ($argn) {
 5109 		    do { 
 5110 			local($before) = '';
 5111 			local($_) = "\\$cmd ".$pc_after;
 5112 			# &substitute_newcmd  may need what comes after the $cmd
 5113 			# from the value of $after 
 5114 			#RRM: maybe best to pass it as a parameter ?
 5115 			my $keep_after = $after;
 5116 			$after = $pc_after;
 5117 			$pc_after = &substitute_newcmd;   # may change $after
 5118 			$pc_after =~ s/\\\@#\@\@/\\/o ;
 5119 			$pc_after .= $after;
 5120 			$after = $keep_after;
 5121 		    }
 5122 		} else {
 5123 		    $pc_after = $body . $pc_after;
 5124 		}
 5125 	    } elsif (defined &$cmd_sub) {
 5126 		# $ref_before may also be modified ...
 5127 		if ($cmd =~ /$sizechange_rx/o) {
 5128 		    $pc_after = &$cmd_sub($pc_after, $open_tags_R);
 5129 		} else {
 5130 		    $pc_after = &$cmd_sub($pc_after, $open_tags_R);
 5131 		};
 5132 		# evtl update letter sensitive rx
 5133 		$cmd_rx = $single_cmd_rx
 5134 		    if ($cmd eq 'makeatletter' || $cmd eq 'makeatother');
 5135 	    } elsif ((defined &$cmd_msub)&&!$NO_SIMPLE_MATH) {
 5136 #print "\nMCMD:$cmd_msub :  ";
 5137 		# $ref_before may also be modified ...
 5138 		$pc_after = &$cmd_msub($pc_after, $open_tags_R);
 5139 		if ( !$math_mode ) {
 5140 		    $pc_after = "<MATH>" . $pc_after . "</MATH>";
 5141 		    ++$commands_outside_math{$cmd};
 5142 		};
 5143 	    } elsif ($cmd_trans) { # One to one transform
 5144 #print "\nCMD-DECL: $inside_tabular : $cmd_trans". join(',',@$open_tags_R);
 5145 		if ($inside_tabular) {
 5146 		    push (@ref_processed , "\\$cmd ")
 5147 		} elsif ($cmd =~ /$alignchange_rx/o) {
 5148 		    # Ensure the proper nesting of alignment block tags
 5149 		    local($pre, $post) = &minimize_open_tags($cmd);
 5150 		    $pc_after = join('', $pre, $pc_after);
 5151 		    if (@$open_tags_R) {
 5152 		        local($decl) = shift(@$open_tags_R);
 5153 		        $declarations{$decl} =~ m|</.*$|;
 5154 		        ($pre, $post) = ($`, $&);
 5155 		        if ($post =~ /$block_close_rx/) {
 5156 			    # Keep the order of two nested block tags
 5157 			    unshift(@$open_tags_R, ($decl,$cmd));
 5158 			} else {
 5159 			    # No nested block tags, place alignment in front
 5160 			    unshift(@$open_tags_R, ($cmd,$decl));
 5161 			}
 5162 		    } else {
 5163 			# No tags, place alignment block tag in front
 5164 		        unshift(@$open_tags_R, $cmd);
 5165 		    }
 5166 		} else {
 5167 		    # Regular (not block) tags are pushed from tail
 5168 		    $cmd_trans =~ m|</.*$|;
 5169 		    $pc_after = $` . $pc_after unless ($` =~ /^<>/);
 5170 		    push(@$open_tags_R, $cmd)
 5171 			if ($cmd =~ /$fontchange_rx|$fontweight_rx|$sizechange_rx/o);
 5172 		}
 5173 	    } elsif ($mathentity) {
 5174 #print "\nM-ENT:$mathentity :  ";
 5175 		if ( $math_mode ) {
 5176 		    $pc_after = "&$mathentity#$cmd;" . $pc_after;
 5177 		} elsif ($NO_SIMPLE_MATH) {
 5178 		    $pc_after = "&$mathentity#$cmd;" . $pc_after;
 5179 #		    ++$commands_outside_math{$cmd};
 5180 		} else {
 5181 		    $pc_after = "<MATH>&$mathentity#$cmd;</MATH>" . $pc_after;
 5182 		    ++$commands_outside_math{$cmd};
 5183 		}
 5184 	    } elsif ($ignore{$bcmd}) { # Ignored command
 5185 		print "\nignoring \\$bcmd" if $VERBOSITY > 5;
 5186 		$pc_after = join('', " ", $pc_after) if ($cmd eq " "); # catches `\ '
 5187 		$pc_after = join(''," ", $pc_after)
 5188 		    if (($cmd eq ',')&&($pc_after =~ /^\-/s)&&($ref_before =~/\-$/s));
 5189 	    } elsif ($cmd =~ /^the(.+)$/){
 5190 		$counter = $1;
 5191 		local($tmp)="do_cmd_$cmd";
 5192 		if (defined &$tmp) { # Counter
 5193 		    $pc_after = &do_cmd_thecounter($pc_after);
 5194 		} else {
 5195 		    if (defined $failed) {
 5196 			$failed = 1;
 5197 #			$ref_before .= "$cmd";
 5198 			push(@ref_processed,$cmd);  # $ref_before .= "$cmd";
 5199 		    } else {  &declare_unknown_cmd($bcmd) }
 5200 #		    $ref_before .= "$cmd" if ($failed);
 5201 		}
 5202 	    } elsif (defined &$cmd_wsub) {
 5203 		# call generated wrapper
 5204 		($dum1, $pc_after) = &$cmd_wsub($dum1, $pc_after);
 5205 	    } elsif ($cmd eq "\n") { push(@ref_processed," ");  # $ref_before .= " "; 
 5206 	    } else {
 5207 		# Do not add if reading an auxiliary file
 5208 		if (defined $failed) { 
 5209 		    $failed = 1;
 5210 		} else { &declare_unknown_cmd($bcmd) }
 5211 	    }
 5212 	} else {
 5213 	    # &normalize should have already handled it adequately
 5214 	    # '\ ' (space) gets thru to here. Perhaps some others too ?
 5215 #	    print "\n ?? This should not happen: \\$cmd ??\n";
 5216 	}
 5217 #	$_[1] = join('', $ref_before, $pc_after);
 5218 	$_[1] = $pc_after;
 5219 	print STDOUT "\n-> $ref_before\n" if ($VERBOSITY > 6);
 5220     }
 5221     $_[1] = join('',@ref_processed).$_[1];
 5222 }
 5223 
 5224 sub declare_unknown_cmd {
 5225     local($cmd) = @_;
 5226     local($dum1, $dum2) = ($cmd, '');
 5227     $dum1 = $cmd unless ($dum1 = &normalize($dum1, $dum2));
 5228     local($tmp) = "wrap_cmd_$dum1";
 5229     do { ++$unknown_commands{$cmd};
 5230 	print STDOUT "\n*** Unknown command[1]: \\$cmd *** \n" 
 5231 	    if ($VERBOSITY > 2);
 5232     } unless ($AUX_FILE||(defined &$tmp)||($image_switch_rx=~/\b\Q$cmd\E\b/));
 5233 }
 5234 
 5235 
 5236 # This makes images from the code for math-entities,
 5237 # when $NO_SIMPLE_MATH is set and the  math  extension is loaded.
 5238 #
 5239 sub replace_math_constructions {
 5240     local($math_mode) = @_;
 5241     &make_math_box_images($math_mode) if (/<BOX>/);
 5242     &make_math_entity_images($math_mode) if (/\&\w+#\w+;/);
 5243 }
 5244 
 5245 sub make_math_box_images {
 5246     local($math_mode) = @_;
 5247     local($pre,$this,$post,$tmp) = ('','','');
 5248     local($slevel,$blevel) = 0;
 5249 
 5250     while (/<BOX>/) {
 5251 	$pre .= $`; $tmp = $`; $this = ''; $post = $';	
 5252 	# compute the super/sub-scripting level for each entity
 5253 	$tmp =~ s/<(\/?)SU[BP]>/
 5254 	    if ($1) { $slevel--} else { $slevel++};''/eog;
 5255 
 5256 	$tmp = $post;
 5257 	if ($tmp =~ /<(\/?)BOX>/o ) {
 5258 	    if ($1) { $this = $`; $post = $' }
 5259 	    else { $failed = 1 } # nested box, too complicated !
 5260 	} else {
 5261 	    &write_warnings("\nLost end of a <BOX> ?");
 5262 	    $failed = 1;
 5263 	}
 5264 	last if ($failed);
 5265 
 5266 	($this,$_) = &process_box_in_latex(
 5267 		    $math_mode, $slevel, $this, $post);
 5268 	$_ =~ s/^\s*//; # remove any leading spaces
 5269 	$pre .= $this ."\001"; 
 5270     }
 5271     return  if ($failed);
 5272     $_ = $pre . $_;
 5273 }
 5274 
 5275 sub make_math_entity_images {
 5276     local($math_mode) = @_;
 5277     local($pre,$this,$post,$tmp) = ('','','');
 5278     local($slevel) = 0;
 5279     # compute the super/sub-scripting level for each entity
 5280     while (/\&\w+#(\w+);/) {
 5281 	$pre .= $`; $tmp = $`; $this = $1; $post = $';
 5282 	$tmp =~ s/<(\/?)SU[BP]>/
 5283 	    if ($1) { $slevel--} else { $slevel++};''/eog; 
 5284 	($this,$_) = &process_entity_in_latex(
 5285 		$math_mode, $slevel, $this, $post);
 5286 	$_ =~ s/^\s*//; # remove any leading spaces
 5287 	$pre .= $this ."\001"; 
 5288     }
 5289     $_ = $pre . $_;
 5290 }
 5291 
 5292 
 5293 #RRM:  Revert a math-entity to create image using LaTeX, together with
 5294 # any super/sub-scripts (possibly nested or with \limits ).
 5295 # Must also get the correct  \display/text/(script)script  style.
 5296 #
 5297 sub process_entity_in_latex {
 5298     local($mode,$level,$entity,$after) = @_;
 5299     local($math_style,$supsub,$rest) = ('','','');
 5300     $level++ if ($mode =~/box/); # for top/bottom of inline fractions, etc.
 5301 
 5302     if ($level) {
 5303 	$math_style = "\\". (($level > 1) ? "script" : "")."scriptstyle"
 5304     } else {
 5305 	$math_style = "\\displaystyle" unless ($mode =~ /inline/);
 5306     }
 5307     while ($after =~ s/^\s*((\\limits|\&limits;)?\s*<SU(P|B)>)\s*/$supsub .= $1;''/eo) {
 5308 	local($slevel) = 1;
 5309 	local($aftersupb) = '';
 5310 	while ($slevel) {
 5311 	    $after =~ s/(<(\/)SU(B|P)>)/($2)? $slevel-- : $slevel++;''/oe;
 5312 	    $supsub .= $`.$&;
 5313 	    $aftersupb = $';
 5314 	}
 5315 	$after = $aftersupb;
 5316     }
 5317 
 5318     local($latex_code) = "\$$math_style\\$entity$supsub\$";
 5319 
 5320     $global{'max_id'}++;
 5321     ( &process_undefined_environment('tex2html_wrap_inline'
 5322 	     ,$global{'max_id'}, $latex_code ) , $after);
 5323 }
 5324 
 5325 sub process_box_in_latex {
 5326     local($mode,$level,$inside,$after) = @_;
 5327     local($math_style,$which,$pre,$post,$tmp) = ('','',"\{","\}");
 5328     
 5329     if ($level) {
 5330 	$math_style = "\\". (($level > 1) ? "script" : "")."scriptstyle"
 5331     } else {
 5332 	$math_style = "\\displaystyle" unless ($mode =~ /inline/);
 5333     }
 5334 
 5335     if ($inside =~ /<((LEFT)|(RIGHT))>/ ) {
 5336 	$pre = "\\left"; $post = "\\right";
 5337 	if ($2) { 
 5338 	    $tmp = $`; $inside = $';
 5339 	    $pre .= (($tmp) ? $tmp : ".") . "\{";
 5340 	    if ( $inside =~ /<RIGHT>/ ) {
 5341 		$tmp = $';
 5342 		$inside = $`;
 5343 		$post = "\}". (($tmp) ? $tmp : ".");
 5344 	    }
 5345 	} else {
 5346 	    $pre .= ".\{"; $tmp = $'; $inside = $`;
 5347 	    $post = "\}". (($tmp) ? $tmp : ".");
 5348 	}
 5349     }
 5350     if ( $inside =~ /<((OVER)|(ATOP)|(CHOOSE))>/ ) {
 5351 	$pre .= $`;
 5352 	$post = $' . $post ;
 5353 	if ($2) { $which = "over " }
 5354 	elsif ($3) { $which = "atop " }
 5355 	elsif ($4) { $which = "atopwithdelims\(\)" }
 5356     }
 5357 
 5358     local($latex_code) = join('', "\$" , $math_style , " ", $pre 
 5359 	  , (($which)? "\\$which" : "") , $post , "\$" );
 5360 
 5361     if ($after =~ s/<SUP ALIGN=\"CENTER\">([^<]*)<\/SUP>/
 5362 	$tmp =$1;''/eo ) {
 5363 	$latex_code = join('', "\\stackrel" , $latex_code
 5364 			   , "\{" , $tmp , "\}" );
 5365     }
 5366     
 5367     $global{'max_id'}++;
 5368     ( &process_undefined_environment('tex2html_wrap_inline'
 5369 	     ,$global{'max_id'}, $latex_code ) , $after);
 5370 }
 5371 
 5372 ####################### Processing Meta Commands ############################
 5373 # This is a specialised version of process_command above.
 5374 # The special commands (newcommand, newenvironment etc.)
 5375 # must be processed before translating their arguments,
 5376 # and before we cut up the document into sections
 5377 # (there might be sectioning commands in the new definitions etc.).
 5378 # \newtheorem commands are treated during normal processing by
 5379 # generating code for the environments they define.
 5380 
 5381 sub substitute_meta_cmds {
 5382     local ($next_def);
 5383     local ($cmd, $arg, $argn, $opt, $body, $before, $xafter);
 5384     local ($new_cmd_no_delim_rx, $new_cmd_rx, $new_env_rx, $new_cmd_or_env_rx);
 5385     local ($new_end_env_rx);
 5386     &tokenize($meta_cmd_rx);	#JCL(jcl-del) - put delimiter after meta command
 5387     print "\nProcessing macros ..." if (%new_command || %new_environment);
 5388     # First complete any replacement left-over from the previous part.
 5389     if ($UNFINISHED_ENV) { 
 5390 	s/$UNFINISHED_ENV/$REPLACE_END_ENV/;
 5391 	$UNFINISHED_ENV = '';
 5392 	$REPLACE_END_ENV = '';
 5393     }
 5394 
 5395     local(@processed);
 5396     local($processed, $before, $after)=('', '', $_);
 5397     while ($after =~ /$meta_cmd_rx$EOL/o) {	# ... and uses the delimiter
 5398 	($cmd, $after) = ($1.$2, $');
 5399 	$before .= $`;
 5400 #	$next_def = '';
 5401 	if (!($before =~ /$meta_cmd_rx$EOL/)) {
 5402 	    push(@processed, $before); $before = '';
 5403 	}
 5404 		 
 5405 	print ",";
 5406 #	$next_def = "\\$cmd" unless (($cmd =~ /renewcommand/));
 5407 	local($cmd_sub) = "get_body_$cmd";
 5408 	if (defined &$cmd_sub) {
 5409 #	    $processed = &$cmd_sub(*after);
 5410 	    $processed = &$cmd_sub(\$after);
 5411 #	    if ($processed) { $after = $before . $processed; }
 5412 #	    $next_def = '' 
 5413 #		if (($PREAMBLE > 1)&&($cmd =~ /(re)?newcommand/));
 5414 #	    &add_to_preamble($cmd, $next_def)
 5415 #		unless ($next_def =~ /^\s*$/);
 5416 ### new style of handling meta-commands
 5417 	    if ($processed) { push(@processed, "\\".$processed) }
 5418 	}
 5419 	elsif ($before) {
 5420 	    # this shouldn't happen !!
 5421 	    print STDERR "\nCannot handle \\$cmd , since there is no $cmd_sub ";
 5422 	    $after = $before . $cmd . $after;
 5423 	    $before = '';
 5424 	} else { 
 5425 	    push(@processed, "\\$cmd ") if $cmd;
 5426 	}
 5427     }
 5428     print "\nmeta-commands: ". (0+@processed) ." found "
 5429 	if ((@processed)&&($VERBOSITY > 1));
 5430     $_ = join('',@processed, $after); undef @processed;
 5431     if ($PREAMBLE) {
 5432 	# MRO: replaced $* with /m
 5433         s/((\n$comment_mark\d*)+\n)/\n/gm;
 5434         s/(\\par\b\s*\n?)+/\\par\n/gm;
 5435         s/(\\par\b\n?)+/\\par\n/gm;
 5436     }
 5437 
 5438     # hard-code the new-command replacements for these
 5439     $new_command{'begingroup'} = "0:!:\\begin<<0>>tex2html_begingroup<<0>>:!:}";
 5440     $new_command{'endgroup'} = "0:!:\\end<<0>>tex2html_begingroup<<0>>:!:}";
 5441     $new_command{'bgroup'} = "0:!:\\begin<<0>>tex2html_bgroup<<0>>:!:}";
 5442     $new_command{'egroup'} = "0:!:\\end<<0>>tex2html_bgroup<<0>>:!:}";
 5443 
 5444     # All the definitions have now moved to the $preamble and their bodies
 5445     # are stored in %new_command and %new_environment
 5446     #
 5447     # Now substitute the new commands and environments:
 5448     # (must do them all together because of cross definitions)
 5449     $new_cmd_rx = &make_new_cmd_rx(sort keys %new_command);
 5450     $new_cmd_no_delim_rx = &make_new_cmd_no_delim_rx(sort keys %new_command);
 5451     $new_env_rx = &make_new_env_rx;
 5452     $new_end_env_rx = &make_new_end_env_rx;
 5453 #    $new_cnt_rx = &make_new_cnt_rx(keys %new_counter);
 5454     $new_cmd_or_env_rx = join("|", $new_cmd_no_delim_rx." ", $new_env_rx);
 5455 #    $new_cmd_or_env_rx = join("|", $new_cmd_no_delim_rx." ", $new_env_rx, " ".$new_cnt_rx);
 5456     $new_cmd_or_env_rx =~ s/^ \||\|$//;
 5457 
 5458     print STDOUT "\nnew commands:\n" if ($VERBOSITY > 2);
 5459     for $cmd (sort keys %new_command) {
 5460         $body = $new_command{$cmd};
 5461 	unless ($expanded{"CMD$cmd"}++) {
 5462 	    print STDOUT ".$cmd " if ($VERBOSITY > 2);
 5463 	    $new_command{$cmd} = &expand_body;
 5464 	    print STDOUT " ".$new_command{$cmd}."\n" if ($VERBOSITY > 4);
 5465 	    &write_mydb("new_command", $cmd, $new_command{$cmd});
 5466 	}
 5467     }
 5468 
 5469     print STDOUT "\nnew environments:\n" if ($VERBOSITY > 2);
 5470     for $cmd (sort keys %new_environment) {
 5471         $body = $new_environment{$cmd};
 5472 	unless ($expanded{"ENV$cmd"}++) {
 5473 	    print STDOUT ".$cmd" if ($VERBOSITY > 2);
 5474 	    $new_environment{$cmd} = &expand_body;
 5475 	    &write_mydb("new_environment", $cmd, $new_environment{$cmd});
 5476 	}
 5477     }
 5478 
 5479     print STDOUT "\nnew counters and dependencies:\n" if ($VERBOSITY > 2);
 5480     &clear_mydb("dependent") if ($DEBUG);     #avoids appending to a previous version
 5481     for $cmd (sort keys %dependent) {
 5482         $body = $dependent{$cmd};
 5483 	print STDOUT ".($cmd,$body)" if ($VERBOSITY > 2);
 5484         &write_mydb("dependent", $cmd, $dependent{$cmd});
 5485     }
 5486     &clear_mydb("img_style") if ($DEBUG);     #avoids appending to a previous version
 5487     for $cmd (sort keys %img_style) {
 5488         &write_mydb("img_style", $cmd, $img_style{$cmd});
 5489     }
 5490 
 5491     &clear_mydb("depends_on") if ($DEBUG);     #avoids appending to a previous version
 5492     for $cmd (sort keys %depends_on) {
 5493         $body = $depends_on{$cmd};
 5494 	print STDOUT ".($cmd,$body)" if ($VERBOSITY > 2);
 5495         &write_mydb("depends_on", $cmd, $depends_on{$cmd});
 5496     }
 5497 
 5498 
 5499     &clear_mydb("styleID") if ($DEBUG);     #avoids appending to a previous version
 5500     for $cmd (sort keys %styleID) {
 5501         &write_mydb("styleID", $cmd, $styleID{$cmd});
 5502     }
 5503 
 5504     &clear_mydb("env_style") if ($DEBUG);     #avoids appending to a previous version
 5505     for $cmd (sort keys %env_style) {
 5506         &write_mydb("env_style", $cmd, $env_style{$cmd});
 5507     }
 5508     &clear_mydb("txt_style") if ($DEBUG);     #avoids appending to a previous version
 5509     for $cmd (sort keys %txt_style) {
 5510         &write_mydb("txt_style", $cmd, $txt_style{$cmd});
 5511     }
 5512 
 5513     print STDOUT "\ntheorem counters:\n" if ($VERBOSITY > 2);
 5514     &clear_mydb("new_theorem") if ($DEBUG);     #avoids appending to a previous version
 5515     for $cmd (sort keys %new_theorem) {
 5516         $body = $new_theorem{$cmd};
 5517 	print STDOUT ".($cmd,$body)" if ($VERBOSITY > 2);
 5518         &write_mydb("new_theorem", $cmd, $new_theorem{$cmd});
 5519     }
 5520 
 5521 
 5522     print "+";
 5523     if (length($new_env_rx)) {
 5524 	local(@pieces);
 5525         print STDOUT "\nsubstituting new environments: $new_env_rx\n" if ($VERBOSITY > 3);
 5526 #	while (/\n?$new_env_rx/ && (($before, $cmd, $after) = ($`, $2, $'))) {
 5527 	while (/$new_env_rx/ && (($before, $cmd, $after) = ($`, $2, $'))) {
 5528 	    print STDOUT ",";
 5529 	    print STDOUT "{$cmd}" if ($VERBOSITY > 1);
 5530 	    if (!($before =~ /$new_env_rx/)) {
 5531 		push (@pieces, $before); $before = ''; print "{}";
 5532 	    }
 5533 	    $_ = join('',$before, &substitute_newenv);
 5534 	}
 5535 	print "\n ".(0+@pieces). " new environments replaced\n" if (@pieces);
 5536 	$_ = join('', @pieces, $_); undef @pieces;	
 5537     }
 5538 
 5539 
 5540     print "+";
 5541     if (length($new_cmd_rx)) {
 5542 	print STDOUT "\ntokenizing: $new_cmd_rx\n" if ($VERBOSITY > 2);
 5543 	&tokenize($new_cmd_rx); # Put delimiter after the new commands
 5544 
 5545 	# and use the delimiter.
 5546 	print STDOUT "\nsubstituting new commands: $new_cmd_rx\n" if ($VERBOSITY > 2);
 5547 	print STDOUT "\ninitial size: ".length($after) if ($VERBOSITY > 1);
 5548 	# store processed pieces in an array
 5549 	local($this_cmd, @pieces);
 5550 	# speed-up processing of long files by splitting into smaller segments
 5551 	# but don't split within the preamble, else \newenvironment may break
 5552 	local($pre_segment,@segments); &make_sections_rx;
 5553 	local($within_preamble,$this_section) = 1 if ($PREAMBLE>1);
 5554 	while (/$sections_rx/) {
 5555 	    $pre_segment .= $`; $_ = $'; $this_section = $&;
 5556 	    do {
 5557 		push(@segments,$pre_segment);
 5558 		$pre_segment = '';
 5559 	    } unless ($within_preamble);
 5560 	    $within_preamble = 0 if ($within_preamble && ($pre_segment =~ 
 5561 		    /\\(startdocument|begin\s*($O\d+${C})\s*document\s*\2)/));
 5562 	    $pre_segment .= $this_section;
 5563 	}
 5564 	push(@segments,$pre_segment.$_);
 5565 	local($replacements,$seg) ; $before = ''; # count the segments
 5566 	local($within_preamble) = 1 if ($PREAMBLE>1);
 5567 	foreach $after (@segments) {
 5568 	  while ($after =~ /(\\(expandafter|noexpand)\b\s*)?$new_cmd_no_delim_rx\b\s?/) {
 5569 	    ($before, $xafter, $cmd, $after) = ($`, $2, $3, $');
 5570 	    $within_preamble = 0
 5571 		if ($before =~ /\\(startdocument|begin\s*($O\d+${C})\s*document\s*\2)/);
 5572 	    push(@pieces, $before);
 5573 	    print "."; ++$replacements;
 5574 	    print STDOUT "$cmd" if ($VERBOSITY > 2);
 5575 	    if ($xafter =~ /no/) { $this_cmd = "\\\@#\@\@".$cmd  }
 5576 	    elsif (($xafter =~ /after/)&&($after =~ /^\s*\\/)) {
 5577 		local($delayed) = $cmd;
 5578 		local($nextcmd);
 5579 		$after =~ s/^\s*\\([a-zA-Z]+|.)/$nextcmd = $1;''/eo;
 5580 		($cmd,$nextcmd) = ($nextcmd, "do_cmd_$nextcmd");
 5581 		if (defined &$nextcmd) { $after = &$nextcmd($after); }
 5582 		elsif ($new_command{$cmd}) { 
 5583 		    local($argn, $body, $opt) = split(/:!:/, $new_command{$cmd});
 5584 		    &make_unique($body) if ($body =~ /$O/);
 5585 		    if ($argn) {
 5586 			do { 
 5587 			    local($before) = '';
 5588 			    $after = join('',&substitute_newcmd, $after);
 5589 			    $after =~ s/\\\@#\@\@/\\/o ;
 5590 			};
 5591 		    } else { $after = $body . $after; }
 5592 		} else { print "\nUNKNOWN COMMAND: $cmd "; }
 5593 		$cmd = $delayed;
 5594 		if ($new_command{$cmd}) {
 5595 		    if ($renew_command{$cmd}) {
 5596 #			# must wrap it in a deferred environment
 5597 #			$this_cmd = join('', &make_deferred_wrapper(1)
 5598 #				,"\\$cmd".(($cmd =~ /\w$/)? " ":'')
 5599 #				, &make_deferred_wrapper(0));
 5600 #			push(@pieces, $this_cmd); $this_cmd = '';
 5601 			push(@pieces, "\\$cmd".(($cmd =~ /\w$/)? " ":''));
 5602 			$this_cmd = '';
 5603 		    } elsif ($provide_command{$cmd}&&$within_preamble) {
 5604 			# leave it alone
 5605 			push(@pieces, "\\$cmd".(($cmd =~ /\w$/)? " ":''));
 5606 			$this_cmd = '';
 5607 		    } else {
 5608 			# do the substitution
 5609 			$this_cmd = &substitute_newcmd;
 5610 		    }
 5611 		}
 5612 	    } elsif ($renew_command{$cmd}) {
 5613 		# leave it alone
 5614 		push(@pieces, "\\$cmd".(($cmd =~ /\w$/)? " ":''));
 5615 		$this_cmd = '';
 5616 	    } elsif (($provide_command{$cmd})&&($within_preamble)) {
 5617 		# leave it alone
 5618 		push(@pieces, "\\$cmd".(($cmd =~ /\w$/)? " ":''));
 5619 		$this_cmd = '';
 5620 	    } else {
 5621 		# do the substitution
 5622 		$this_cmd = &substitute_newcmd if ($new_command{$cmd});
 5623 	    }
 5624 	    if ($this_cmd =~ /(\\(expandafter|noexpand)\s*)?$new_cmd_no_delim_rx\b\s?/)
 5625 	        { $after = $this_cmd . $after }
 5626 	    elsif ($this_cmd) { push(@pieces, $this_cmd) }
 5627 	  }
 5628 	  push(@pieces, $after);
 5629 	}
 5630 	print " $replacements new-command replacements\n"
 5631 	    if (($VERBOSITY>1) && $replacements);
 5632 	# recombine the processed pieces
 5633 	$_ = join('', @pieces); undef @pieces;
 5634         print STDOUT ", resulting size: ".length($_)." " if ($VERBOSITY > 1);
 5635 	$_ =~ s/\\\@#\@\@/\\/go;
 5636     }
 5637 
 5638     print STDOUT "\n *** substituting metacommands done ***\n" if ($VERBOSITY > 3);
 5639 }
 5640 
 5641 sub insert_command_expansion {
 5642     ($xafter, $cmd) = @_;
 5643 #   push(@pieces, $_[1]);
 5644     print ".$cmd";
 5645     print STDOUT "$_[3]" if ($VERBOSITY > 2);
 5646 #   $xafter = $_[2];
 5647 #   $cmd = $_[3];
 5648     if ($xafter =~ /no/) { $this_cmd = "\\\@#\@\@".$cmd }
 5649     elsif (($xafter =~ /after/)&&($after =~ /^\s*\\/)) {
 5650 	local($delayed,$nextcmd) = ($_[3],'');
 5651 
 5652 	$after =~ s/^\s*\\([a-zA-Z]+|.)/$nextcmd = $1;''/eo;
 5653 	($cmd,$nextcmd) = ($nextcmd, "do_cmd_$nextcmd");
 5654 	if (defined &$nextcmd) { $after = &$nextcmd($after); }
 5655 	elsif ($new_command{$cmd}) { 
 5656 	    local($argn, $body, $opt) = split(/:!:/, $new_command{$cmd});
 5657 	    &make_unique($body) if ($body =~ /$O/);
 5658 	    if ($argn) {
 5659 		do { 
 5660 		    local($before) = '';
 5661 		    $after = join('',&substitute_newcmd, $after);
 5662 		    $after =~ s/\\\@#\@\@/\\/o ;
 5663 		};
 5664 	    } else { $after = $body . $after; }
 5665 	} else { print "\nUNKNOWN COMMAND: $cmd "; }
 5666 	$cmd = $delayed;
 5667 	$this_cmd = &substitute_newcmd if ($new_command{$cmd});		
 5668     } else {
 5669 	$this_cmd = &substitute_newcmd if ($new_command{$cmd});
 5670     }
 5671 #   if ($this_cmd =~ /(\\(expandafter|noexpand)\s*)?$new_cmd_no_delim_rx\s?/){
 5672 #	$after = $this_cmd . $after
 5673 #   } else { push(@pieces, $this_cmd); }
 5674     $this_cmd;
 5675 }
 5676 
 5677 
 5678 sub expand_body {
 5679     return unless length($new_cmd_or_env_rx);
 5680     local($_) = $body;
 5681     local($cmd,$saveafter,$avoid_looping);
 5682     # Uses $before, $body, $arg, etc. of the caller, but not $cmd.
 5683     # Uses $new_cmd_rx (resp. $new_cmd_no_delim_rx) and $new_env_rx
 5684     # set in the caller, of which one might be empty.
 5685 
 5686     # Puts delimiter after the new commands ...
 5687     &tokenize($new_cmd_rx) if length($new_cmd_rx);
 5688 
 5689     while (/$new_cmd_or_env_rx/) {
 5690 	# $new_cmd_rx binds $1, and $new_env_rx binds $3.
 5691 	($before,$cmd,$after,$saveafter) = ($`,$1.$3,$',$');
 5692 	if (length($new_command{$cmd})) { # We have a command
 5693 	    # this tokenizes again
 5694 	    local($replace) = &substitute_newcmd; # sets $_, changes $after
 5695 	    if (!($replace)) {
 5696 		# protect name of unexpanded macro
 5697 		$_ = join('', $before ,"\\@#@@", $cmd, $saveafter );
 5698 	    } else {
 5699 		$_ = join('', $before , $replace, $after );
 5700 	    }
 5701 	} elsif (length($new_environment{$cmd})) {
 5702 	    $_ = join('',$before, &substitute_newenv);
 5703 	}
 5704 	last if $avoid_looping;
 5705     }
 5706     # remove protection from unreplaced macro names
 5707     s/\\\@#\@\@/\\/go;
 5708 
 5709     # remove trivial comments
 5710     s/(\\\w+)$comment_mark\d*\n[ \t]*/$1 /go;
 5711     s/$comment_mark\d*\n[ \t]*//go;
 5712 #    s/($O\d+$C)?($comment_mark\n)[ \t]*/($1 ? $1.$2 : '')/eg;
 5713 
 5714     $_;
 5715 }
 5716 
 5717 
 5718 sub substitute_newcmd {
 5719     # Modifies $after in the caller
 5720     # Get the body from the new_command array
 5721     local($tmp,$cnt,$saved, $arg, $isword) = ('',0,$cmd);
 5722     local($argn, $_, $opt) = split(/:!:/, $new_command{$cmd});
 5723     $avoid_looping = 1 if ($new_command{$cmd} =~ /\\$cmd\b/);
 5724 
 5725     &tokenize($new_cmd_rx); # must do it again for newly inserted cmd bodies
 5726     print STDOUT "\nNEW:$cmd:$_" if ($VERBOSITY > 5);
 5727     foreach $i (1..$argn) {
 5728 	$arg = $isword = '';
 5729 	if ($i == 1 && $opt ne '}') {
 5730 	    $arg = ($after =~ s/$optional_arg_rx//o) ? $1 : $opt;
 5731 	}
 5732 	else {
 5733 	    # Get the next argument, if not in braces, get next character
 5734 	    #RRM: allow also for processed braces, in case substitution
 5735 	    #     was delayed; e.g. by \renewcommand
 5736 	    if (!(($after =~ s/$next_pair_rx/$arg = $2;''/e)
 5737 		  ||($after =~ s/$next_pair_pr_rx/$arg = $2;''/e))) {
 5738 		$after =~ s/^\s*(\\[a-zA-Z]+|.)/$arg = $1;''/e;
 5739 	    }
 5740 	    if ($arg eq '#') { 
 5741 		&write_warnings("\nSubstitution of arg to $cmd delayed."); 
 5742 		$_ = "\\\@#\@\@$saved";
 5743 		return ();
 5744 	    };
 5745 	}
 5746 	$arg =~ s/(^|\G|[^\\])\\\#/$1$hash_mark/gs;
 5747 	$arg =~ s/\#/$param_mark/gs;
 5748 
 5749 	#RRM: Substitute the arguments in the body one at a time
 5750 	#     else multiple instances would fail in  &make_unique
 5751 
 5752 	# First protect ## parameters in TeX-like substitutions
 5753 	# suggested by Dirk Pleiter (Berlin)
 5754 	s/((^|[^\\])(\\\\)*)\#\#$i/$1$protected_hash/gs;
 5755 	$tmp = $_;
 5756 	$cnt = $tmp =~ s/\#$i//g ;
 5757 	$isword = 1 if ($arg =~ /^\w/);
 5758 	if ($cnt > 1 ) {
 5759 	    $tmp = $_;
 5760 	    while ($cnt > 1) {
 5761 		if ( s/(\\\w+)?\#$i/(($1&&$isword)? $1.' ': '').$arg/e) { 
 5762 		    &make_unique($_) if ($arg =~ /$O/ ); 
 5763 		    &make_unique_p($_) if ($arg =~ /$OP/ );
 5764 		}
 5765 		$cnt--;
 5766 	    }
 5767 	    $tmp = $_;
 5768 	}
 5769 #	s/(\\\w+)?\#$i/(($1&&$isword)? $1.' ': '').$arg/e ;
 5770 	s/(\\\w+)?\#$i/$1.(($1&&$isword)? ' ': '').$arg/e ;
 5771 	print "\n *** substitution: $arg \nfor \#$i in \\$cmd did not take ***\n"
 5772 	   if (/\#$i/);
 5773 	&write_warnings("incomplete substitution in a \\$cmd command:\n$_") if (/\#$i/);
 5774 	s/$protected_hash/\#$i/g;
 5775     }
 5776     s/$param_mark/\#/g;
 5777     s/$hash_mark/\\\#/g;
 5778     s/(\\\w+)$/$1 /s;
 5779 
 5780     # Make the body unique (give unique id's to the brackets),
 5781     # translate, and return it
 5782     &make_unique($_);
 5783     if ($avoid_looping) {
 5784 	s/\\$cmd\b/\\csname $cmd\\endcsname/g;
 5785 	print STDERR "\n *** possible looping with new-command \\$cmd ***\n";
 5786 	&write_warnings("\npossible looping with new-command \\$cmd ");
 5787     }
 5788     print STDOUT "\nOUT:$cmd:$_" if ($VERBOSITY > 5);
 5789 
 5790 # Insert a space to prevent letters from clashing together with a
 5791 # letter command. Consider this:
 5792 # New command substitution is restricted to commands introduced by
 5793 # \newcommand etc. (so-called meta commands), but it is not done
 5794 # for already defined commands, eg. \large.
 5795 # But new command, as well as new environment, substitution is done
 5796 # prior to any other substitution.
 5797 # So \newcommand{\this}{...} {\large\this b} will get expanded the
 5798 # following way:
 5799 # 1. \newcommand{\this}{...}
 5800 #    is handled by &substitute_meta_cmds, it gets the definition
 5801 #    of \this and stores it within a table, %new_command.
 5802 #    After all new commands are recognized, &expand_body is called
 5803 #    to expand one command body from each other. That's O(n*n)!
 5804 # 2. A regular expression $new_cmd_rx is built containing a pattern
 5805 #    that matches all occurrences of a properly delimited \this
 5806 #    macro. When matching, ensuing white space gets lost.
 5807 #    (But only for letter commands, see also &make_new_cmd_rx.)
 5808 #    Another regular expression called $new_cmd_no_delim_rx is built
 5809 #    which matches exact the \this, and would also match the prefix
 5810 #    of \thisx.
 5811 # 3. The *whole* text is tokenized using $new_cmd_rx, with separates
 5812 #    \this from the ensuing text by one white space.
 5813 # 4. Then $new_cmd_no_delim_rx together with the delimiting space
 5814 #    is used to substitute \this with its body.
 5815 # 5. The following situations may occur:
 5816 #  a) ... is some text (no macros) => {\large<text>yyy}
 5817 #     Then we must prevent that the text clashes into \large.
 5818 #     This is only dangerous when <text> begins with a letter.
 5819 #  b) ... contains another, not expanded new command.
 5820 #     This happens during &expand_body.
 5821 #     In this case, make sure to &tokenize the body before giving
 5822 #     the result to the caller. Also take care that leading letters
 5823 #     of the body cannot clash into \large.
 5824 #  e) ... contains a macro not known as new command:
 5825 #     Make sure that the macro cannot clash with the ensuing yyy.
 5826 #  f) ... is empty:
 5827 #     Make sure that \large cannot clash with yyy.
 5828 # 6. We prevent clashing by inserting a delimiting blank.
 5829 #    Out of the scetched situation, there are three conditions to
 5830 #    take care of:
 5831 #  a) empty body, left a letter command, right a letter => blank
 5832 #  b) body starts with letter, left a letter command    => blank
 5833 #  c) body ends with letter command, right a letter     => blank
 5834 #  d) else => no blank, clash all together, it will work.
 5835 # 7. With this rules, the expansion should work quite well,
 5836 #    concerning letter/non-letter commands and white space
 5837 #    handling.
 5838 # 8. Deficiencies:
 5839 # 8.1 Consider \this<CR>that. It's handled this way:
 5840 #  a) The \this swallows the <CR> in LaTeX, but what LaTeX2HTML does
 5841 #     is to &tokenize the expression into \this <CR>that.
 5842 #  b) If ... is some text, it results in <text><CR>that.
 5843 #  c) If ... is a macro (or command, or control sequence, these
 5844 #     terms are often mixed up, but effectively mean the same),
 5845 #     then if the macro later takes at least one argument, the <CR>
 5846 #     might get swallowed, this depends on the grace of $next_pair_rx
 5847 #     resp. $next_pair_pr_rx.
 5848 #     If the macro takes no arguments, the <CR> remains in the text.
 5849 #  d) If ... ends in another new command, the problem repeats.
 5850 # 8.2 The new commands are substituted in a very insensitive way.
 5851 #     If \this occurs within an environment which sees \this
 5852 #     totally different, there's no chance to substitute \this in
 5853 #     a different way.
 5854 # 8.3 In relation to 8.2 a similar problem arises when the meta
 5855 #     command, or several meta commands redefining \this, occur
 5856 #     amongst several \this macros.
 5857 # 8.4 In raw TeX like environments it is not possible to revert the
 5858 #     expansion of \this, but \this probably *must* occur in its
 5859 #     raw form.
 5860 
 5861 # Handle the cases as depicted in the description of new command
 5862 # substitution.
 5863     local($befdel,$aftdel);
 5864     $befdel = ' '
 5865 	if ($before=~/(^|[^\\])\\[a-zA-Z]+$/ && /^$/ && $after=~/^[a-zA-Z]/) ||
 5866 	    ($before=~/(^|[^\\])\\[a-zA-Z]+$/ && /^[a-zA-Z]/);
 5867     $aftdel = ' '
 5868 	if /(^|[^\\])\\[a-zA-Z]+$/s && $after=~/^[a-zA-Z]/;
 5869     join('', $befdel, $_, $aftdel);
 5870 }
 5871 
 5872 #RRM:  use this to test whether a specific command is substituting correctly
 5873 sub trace_cmd {
 5874     local($this) = @_;
 5875     if ($cmd eq $this) { print "\n$1=>$id:$2::"}
 5876 }
 5877 
 5878 # Make the text unique (give unique id's to the brackets).
 5879 # The text shouldn't contain processed brackets.
 5880 sub make_unique {
 5881     # MRO: Change to references $_[0]
 5882     # local(*_) = @_;
 5883     my $id = $global{'max_id'};
 5884     # MRO: replaced $* by /m
 5885     # this looks quite funny but is optimized
 5886     1 while($_[0] =~ s/$O(\d+)$C([\w\W]*)$O\1$C/$id++;"\000$id $2\000$id "/geom);
 5887     $_[0] =~ s/\000(\d+) /$O$1$C/gom;
 5888     $global{'max_id'} = $id;
 5889 }
 5890 
 5891 #RRM: this shouldn't be needed, but just in case...
 5892 sub make_unique_p {
 5893     # MRO: Change to references $_[0]
 5894     my $id = $global{'max_id'};
 5895     # MRO: replaced $* by /m
 5896     # this looks quite funny but is optimized
 5897     1 while($_[0] =~ s/$OP(\d+)$CP([\w\W]*)$OP\1$CP/$id++;"\000$id $2\000$id "/geom);
 5898     $_[0] =~ s/\000(\d+) /$OP$1$CP/gom;
 5899     $global{'max_id'} = $id;
 5900 }
 5901 
 5902 
 5903 sub substitute_newenv {
 5904     # Modifies $cmd and $after in the caller
 5905     # Get the body from the new_environment array
 5906     local($argn, $begdef, $enddef, $opt) = split(/:!:/, $new_environment{$cmd});
 5907     local($arg,$new_def_rx,$tmp,$cnt);
 5908 
 5909     # Note that latex allows argument substitution only in the
 5910     # \begin part of the new definition
 5911     foreach $i (1..$argn) {	# Process the arguments
 5912 	if (($i == 1) && ($opt ne '}')) {
 5913 	    $after =~ s/$optional_arg_rx/$arg = $1;''/eo;
 5914 	    $arg = $opt unless $arg;
 5915 	}
 5916 	else {
 5917 	    $after =~ s/$next_pair_rx/$arg = $2;''/eo;
 5918 	}
 5919 	$arg =~ s/(^|[^\\])\\\#/$1$hash_mark/g;
 5920 	$arg =~ s/\#/$param_mark/g;
 5921 
 5922         #RRM: multiple instances can fail later in  &make_unique
 5923 #       s/\#$i/$arg/g;          # Substitute the arguments in the body
 5924         #RRM: ...so do one at a time and  &make_unique_p
 5925         $tmp = $begdef;
 5926         $cnt = $tmp =~ s/\#$i//g ;
 5927         if ($cnt > 1) {
 5928             $tmp = $begdef;
 5929             while ($cnt > 1) {
 5930 		if ( $begdef =~ s/\#$i/$arg/) { 
 5931 		    &make_unique($begdef) if ($arg =~ /$O/ ); 
 5932 		    &make_unique_p($begdef) if ($arg =~ /$OP/ );
 5933 		}
 5934                 $cnt--;
 5935             }
 5936             $tmp = $_;
 5937         }
 5938         $begdef =~ s/\#$i/$arg/ ;
 5939         print "\n *** substitution: $arg \nfor \#$i in {$cmd} did not take ***\n"
 5940            if ($begdef =~ /\#$i/);
 5941 	&write_warnings("incomplete substitution in a {$cmd} environment:\n$begdef")
 5942 	    if ($begdef =~ /\#$i/);
 5943     }
 5944     $begdef =~ s/$param_mark/\#/g;
 5945     $begdef =~ s/$hash_mark/\\\#/g;
 5946     $begdef =~ s/(\\\w+)$/$1 /s;
 5947 
 5948     # Make the body unique (Give unique id's to the brackets),
 5949     # translate, and return it
 5950 #RRM: when are these needed ?
 5951 #    $_ = &revert_to_raw_tex($_);
 5952 #    &pre_process;
 5953 
 5954     &make_unique($begdef);		# Make bracket IDs unique   
 5955     print STDOUT "\nBEGIN:$cmd:$begdef" if ($VERBOSITY > 4);
 5956 
 5957     # Now substitute the \end part:
 5958 #RRM: when are these needed ?
 5959 #    $_ = &revert_to_raw_tex($enddef);
 5960 #    &pre_process;
 5961 
 5962     &make_unique($enddef);		# Make bracket IDs unique
 5963     print STDOUT "\nEND:$cmd:$enddef" if (($enddef)&&($VERBOSITY > 4));
 5964     $enddef =~ s/(\\\w+)$/$1 /s;
 5965 
 5966     local($new_end_def_rx) = &make_end_env_rx($cmd);
 5967     if (($enddef)&&!($after =~ s/\n?$new_end_def_rx/$enddef/ )) {
 5968         $UNFINISHED_ENV = $new_end_def_rx;
 5969         $REPLACE_END_ENV = $enddef;
 5970     };
 5971     join('',$begdef,$after);
 5972 }
 5973 
 5974 sub substitute_pars {
 5975     s/((\%|$comment_mark\d*)|.)(\r*\n[ \t]*){2,}[ \t]*/$1\n\\par \n/og;
 5976 #    s/((\%|$comment_mark\d*)|\d|.)[\r\n\015]{2,}/print "\nPAR:".$`.$&;"$1\n\\par \n"/egs;
 5977 }
 5978 
 5979 sub do_cmd_end { #RRM:  catches the end of any unclosed environments
 5980     local($_) = @_;
 5981     &missing_braces unless (
 5982 	(s/$next_pair_pr_rx//o)||(s/$next_pair_rx//o));
 5983     s/^\n//;
 5984     $_;
 5985 }
 5986 
 5987 # Removes the definition from the input string, 
 5988 # adds to the preamble unless it is part of the preamble already
 5989 # and stores the body in %new_command;
 5990 sub get_body_newcommand {
 5991     local($newed, $n_after) = &process_body_newcommand(0,@_);
 5992     (($PREAMBLE)? "newed".$newed : '');
 5993 }
 5994 
 5995 sub process_body_newcommand {
 5996 #    local($renewed,*_) = @_;
 5997     local($renewed,$after_R) = @_;
 5998     local($_) = $$after_R;
 5999     local($no_change) = $_;
 6000     local($argn,$newcmd,$cmd_br,$body,$body_br,$tmp,$tmp1,$opt,$pat);
 6001     local($new_cmd) = 'command';
 6002 
 6003     # read command name
 6004     if ((s/$next_pair_pr_rx/$pat=$&;$newcmd=$2;''/e)
 6005 	||(s/$next_pair_rx/$pat=$&;$newcmd=$2;''/e)) {
 6006 	# command name was in curly braces
 6007     } else {
 6008 	# didn't find curly braces, now read command name
 6009 	($newcmd,$pat) = &get_next(2);
 6010 	local($br_id) = ++$global{'max_id'};
 6011 	# add synthetic curly braces
 6012 	$pat = "$O$br_id$C".$newcmd."$O$br_id$C";
 6013     }
 6014 
 6015     $pat =~ s/\\//; $new_cmd .= $pat;
 6016     $newcmd =~ s/^\s*\\//;
 6017     ($argn,$pat) = &get_next(0);	# Get optional no. of args
 6018     $argn = 0 unless $argn; $new_cmd .= $pat if $argn;
 6019     local($cmd) = $newcmd;
 6020 
 6021     # Get the body of the code and store it with the name and number of args
 6022     # UNLESS THE COMMAND IS ALREADY DEFINED
 6023     # ...in which case $ALLOW_REDEFINE must also have been set.  # RRM
 6024     # (This is the mechanism with which raw html can be ignored in a Latex document
 6025     # but be recognised as such by the translator).
 6026     $opt = '}';			# Flag for no optional arg
 6027     local($bodyA) = '';
 6028     if (/^\[/) {
 6029 	($opt,$pat) = &get_next(0);
 6030 	$new_cmd .= $pat;
 6031 	$bodyA .= "\n".'($dummy, $pat) = &get_next_optional_argument;' .
 6032                     "\n". '$args .= $pat;';
 6033     }
 6034     local($nargs) = $argn;
 6035     while ($nargs > 0) { $nargs--;
 6036 	$bodyA .=
 6037 	    "\n".'$args .= $`.$& if ((s/$next_pair_pr_rx//o)||(s/$next_pair_rx//o));';
 6038     }
 6039     if ($renewed =~ /provide/||$renewed == 2 ) {
 6040         $body = &missing_braces unless (
 6041 	        (s/$next_pair_pr_rx/$pat=$&;$body=$2;''/e)
 6042 	        ||(s/$next_pair_rx/$pat=$&;$body=$2;''/e));
 6043 	$new_cmd .= $pat;
 6044     } else {
 6045 	($body,$pat) = &get_next(4);  #get the body
 6046 	$new_cmd .= $pat;
 6047     }
 6048 
 6049     local($thisone);
 6050 #    $thisone = 1 if ($cmd =~ /div|vec/);  # for debugging
 6051 
 6052     local($dum1, $dum2) = ($cmd, '');
 6053     $dum1 = $cmd unless ($dum1 = &normalize($dum1, $dum2));
 6054     $tmp = "do_cmd_$dum1";
 6055     local($wtmp) = "wrap_cmd_$dum1";
 6056     if ((defined &$tmp)||(defined &$wtmp)){
 6057 	# command already exists, so \providecommand  does nothing
 6058 	# but may still be needed in  images.tex
 6059 	$$after_R = $_;
 6060 	return ($new_cmd) if ($renewed =~ /provide/);
 6061 
 6062 	print "\n*** redefining \\$cmd ***\n";
 6063 	&write_warnings("\nredefining command \\$cmd ");
 6064 	if (!$ALLOW_REDEFINE) {
 6065 	    print "*** overriding previous meaning ***\n";
 6066 	    &write_warnings("\nprevious meaning of \\$cmd will be lost");
 6067 	}
 6068 #	local($code) = "undef \&$tmp"; eval ($code);
 6069 #	if ($@) {print "\n*** undef \&$cmd failed \n"}
 6070 	if ((!$PREAMBLE)||($renewed>1)) {
 6071 	    $new_command{$cmd} = join(':!:',$argn,$body,$opt);
 6072 #	    local($code) = "sub $tmp\{\&replace_new_command(\"$cmd\");\}";
 6073 #	    eval $code;
 6074 #	    print STDERR "\n*** sub do_cmd_$cmd failed:\nPERL: $@\n" if ($@);
 6075 #	    &replace_new_command($cmd);
 6076 	}
 6077 
 6078 	$renew_command{$cmd} = 1;
 6079 	&write_mydb("renew_command", $cmd, $renew_command{$cmd});
 6080         local($padding) = " ";
 6081         $padding = '' if (($cmd =~ /\W$/)||(!$args)||($args =~ /^\W/));
 6082         # Generate a new subroutine
 6083         local($codeA) = "sub $wtmp {" . "\n"
 6084             .'local($cmd, $_) = @_; local ($args, $dummy, $pat) = "";'
 6085             . $bodyA
 6086 	    . (($thisone)? "\nprint \"\\nwrap \", '$cmd', \":\".\$args.\"\\n\";" : '')
 6087             . "\n".'(&make_deferred_wrapper(1).$cmd.'
 6088             . "\"$padding\"".'.$args.&make_deferred_wrapper(0),$_)}'
 6089             . "\n";
 6090         print "\nWRAP_CMD: $codeA " if ($thisone); # for debugging
 6091         eval $codeA;
 6092         print STDERR "\n\n*** sub $wtmp  failed: $@\n" if ($@);
 6093 	$raw_arg_cmds{$cmd} = 1;
 6094 
 6095     } elsif (($ALLOW_REDEFINE)&&($PREAMBLE < 2)) {
 6096 	print "\n*** redefining \\$cmd ***\n";
 6097 	&write_warnings("\ncommand \\$cmd had no previous definition")
 6098 	    if (!($new_command{$cmd}));
 6099     }
 6100     if ($renewed && ($PREAMBLE > 1) &&($new_command{$cmd})) {
 6101 	$raw_arg_cmds{$cmd} = 1 ;
 6102 	$renew_command{$cmd} = 1;
 6103         local($padding) = " ";
 6104         $padding = '' if (($cmd =~ /\W$/)||(!$args)||($args =~ /^\W/));
 6105         # Generate a new subroutine
 6106         local($codeA) = "sub $wtmp {" . "\n"
 6107             .'local($cmd, $_) = @_; local ($args, $dummy, $pat) = "";'
 6108             . $bodyA
 6109 	    . (($thisone)? "\nprint \"\\nwrap \", '$cmd', \":\".\$args.\"\\n\";" : '')
 6110             . "\n".'(&make_deferred_wrapper(1).$cmd.'
 6111 	    . "\"$padding\"".'.$args.&make_deferred_wrapper(0),$_)}'
 6112             . "\n";
 6113         print "\nWRAP_CMD: $codeA " if ($thisone); # for debugging
 6114         eval $codeA;
 6115         print STDERR "\n\n*** sub $wtmp  failed: $@\n" if ($@);
 6116 
 6117 	&write_mydb("renew_command", $cmd, $renew_command{$cmd});
 6118     } elsif ($renewed) {
 6119         $new_command{$cmd} = join(':!:',$argn,$body,$opt);
 6120     } else {
 6121 	$new_command{$cmd} = join(':!:',$argn,$body,$opt)
 6122 	    unless (($PREAMBLE > 1)&&($renew_command{$cmd}));
 6123     }
 6124 
 6125     local($this_cmd);
 6126     $this_cmd = join(''
 6127 	, "command{\\$cmd}"
 6128 	, ($argn ? "[$argn]" :'') 
 6129 	, (($opt =~ /^}$/) ? '' : "[$opt]" )
 6130 	, "{", $body , "}" );
 6131     $this_cmd = &revert_to_raw_tex($this_cmd);
 6132     if ($renewed) {
 6133 	if ($renewed=~/provide/){
 6134 	    $provide_command{$cmd} = 1;
 6135 	    &write_mydb("provide_command", $cmd, $provide_command{$cmd});
 6136 #	} else {
 6137 #	    print "\n ** marking $cmd as renewed **";
 6138 #	    $renew_command{$cmd} = 1;
 6139 	};
 6140 	if ((!$PREAMBLE)&&($renewed>1)) {
 6141 #	    local($this_cmd) = join(''
 6142 #		, "\n\\renewcommand{\\$cmd}"
 6143 #		, ($argn ? "[$argn]" :'') 
 6144 #		, (($opt =~ /^}$/) ? '' : "[$opt]" )
 6145 #		, "{", $body , "}\n" );
 6146 #	    $latex_body .= &revert_to_raw_tex($this_cmd);
 6147 	    $latex_body .= "\n\\renew". $this_cmd."\n";
 6148 	} else {
 6149 ##	    &add_to_preamble('command',"\\" . $this_cmd);
 6150 	}
 6151     } else {
 6152 	&add_to_preamble('command',"\\new" . $this_cmd)
 6153 	    unless ($PREAMBLE);
 6154     }
 6155     undef $body;
 6156     if ($renewed == 2) {
 6157 	# there is no output to return
 6158 	$$after_R = $_;
 6159 	return();
 6160     } 
 6161 
 6162     if (!$PREAMBLE) {
 6163 	$$after_R = $_;
 6164 	return ($new_cmd) if ($renewed);
 6165 #	    $cmd_br =~ s/\\//;
 6166 #	( join ('', &make_deferred_wrapper(1)
 6167 #	    , "\\". ($renewed ? (($renewed =~ /provide/)? 'provid' : 'renew')
 6168 #		: 'new')."edcommand"
 6169 #	    , $cmd_br , ($argn ? "[$argn]" :'') 
 6170 #	    , ( ($opt =~ /^\}$/ ) ? '' : "[$opt]" ) , $body_br
 6171 #	    , &make_deferred_wrapper(0)) , $_ );
 6172 	$new_cmd = join('', "command{\\$cmd}"
 6173 			 , ($argn ? "[$argn]" :'') 
 6174 			 , (($opt =~ /^\}$/) ? '' : "[$opt]" )
 6175 			 , "{", $body , "}" );
 6176 	$new_cmd = &revert_to_raw_tex($new_cmd);
 6177 	&add_to_preamble('command', "\\provide".$new_cmd );
 6178 	$$after_R = $_;
 6179 	return();
 6180     }
 6181     $new_cmd =~ s/\\$cmd([\d\W]|$)/$cmd$1/s;
 6182     $$after_R = $_;
 6183     $new_cmd;
 6184 }
 6185 
 6186 sub replace_new_command {
 6187     local($cmd) = @_;
 6188     local($argn, $body, $opt) = split(/:!:/, $new_command{$cmd});
 6189     do { ### local($_) = $body;
 6190 	 &make_unique($body);
 6191 	 } if ($body =~ /$O/);
 6192     $body =~ s/(^|[^\\])\~/$1\\nobreakspace /g;
 6193     if ($argn) {
 6194 	do { 
 6195 	    local($before) = '';
 6196 	    local($after) = "\\$cmd ".$_;
 6197 	    $after = &substitute_newcmd;   # may change $after
 6198 	    $after =~ s/\\\@#\@\@/\\/o ;
 6199 	};
 6200     } elsif ($body =~ /\\/) {
 6201 	$body = &translate_commands($body);  # ???
 6202 	$_ = $body . $_;
 6203     } else { $_ = $body . $_; }
 6204     $_;
 6205 }
 6206 
 6207 sub get_body_let {
 6208 #    local(*_) = @_;
 6209     local($_) = @_;
 6210     local($cmd,$body,$replace,$tmp,$pat);
 6211     ($cmd,$body) = &get_next_tex_cmd;
 6212     s/^\s*=?\s*/$body .= $&;''/e;
 6213     ($replace,$pat) = &get_next_tex_cmd;
 6214 #    return() if ($replace eq $cmd);
 6215     $body .= $pat;
 6216     $body = &revert_to_raw_tex($body);
 6217     &add_to_preamble('', "\\let ".$body );
 6218     $_[0] = $_;
 6219     if (($replace eq $cmd)||($cmd="\\")||($cmd =~/(style|size)$/)) {
 6220 	"let ".$body
 6221     } else {
 6222 	$new_command{$cmd} = join(':!:','',"\\$replace ",'}');
 6223 	'';
 6224     }
 6225 }
 6226 
 6227 
 6228 #  do not remove the \renewcommand code, since it may be needed
 6229 #  within images. Instead replace it with \renewedcommand;
 6230 #  This will be reverted in &revert_to_raw_tex
 6231 sub get_body_renewcommand {
 6232     local($ALLOW_REDEFINE) = 1;
 6233     local($renew, $n_after) = &process_body_newcommand(1,@_);
 6234     ($renew ? 'renewed' . $renew : '');
 6235 }
 6236 
 6237 sub do_cmd_renewedcommand {
 6238     local($_) = @_;
 6239     local($ALLOW_REDEFINE) = 1;
 6240     &process_body_newcommand(2,\$_);
 6241     $_ ;
 6242 }
 6243 
 6244 sub get_body_providecommand {
 6245     local($provide, $n_after) = &process_body_newcommand('provide',@_);
 6246     (($PREAMBLE && $provide) ? 'provided'.$provide : '');
 6247 }
 6248 
 6249 sub do_cmd_providedcommand {	# \providecommand does not redefine, so
 6250     local($_) = @_;		# not setting $ALLOW_REDEFINE
 6251     &process_body_newcommand('provided',\$_);
 6252     $_ ;
 6253 }
 6254 
 6255 sub get_body_DeclareRobustCommand {
 6256     local($provide, $n_after) = &process_body_newcommand('provide',@_);
 6257     (($PREAMBLE && $provide) ? 'provided'.$provide : '');
 6258 }
 6259 
 6260 sub get_body_DeclareMathOperator {
 6261     local($after_R) = @_;
 6262     local($_) = $$after_R;
 6263     my $star;
 6264     s/^\\DeclareMathOperator\s*(\*|star)/$star = $1;''/s;
 6265     my ($mcmd,$patA) = &get_next(1);
 6266     my ($mop,$patB) = &get_next(1);
 6267     if ($star) {
 6268 	$patA .= "${O}0$C\\mathop${O}1$C\\mathrm${patB}${O}1$C${O}0$C".$_;
 6269     } else {
 6270 	$patA .= "${O}0$C${O}1$C\\mathrm${patB}${O}1$C${O}0$C".$_;
 6271     }
 6272     local($provide, $n_after) = &process_body_newcommand('provide',\$patA);
 6273     $$after_R = $patA;
 6274     (($PREAMBLE && $provide) ? 'provided'.$provide : '');
 6275 }
 6276 
 6277 sub get_body_DeclareMathOperatorstar {
 6278     local($after_R) = @_;
 6279     local($_) = $$after_R;
 6280     my $star;
 6281     s/^\\DeclareMathOperator\s*(\*|star)/$star = $1;''/s;
 6282     my ($mcmd,$patA) = &get_next(1);
 6283     my ($mop,$patB) = &get_next(1);
 6284     $patA .= "${O}0$C\\mathop${O}1$C\\mathrm${patB}${O}1$C${O}0$C".$_;
 6285     local($provide, $n_after) = &process_body_newcommand('provide',\$patA);
 6286     $$after_R = $patA;
 6287     (($PREAMBLE && $provide) ? 'provided'.$provide : '');
 6288 }
 6289 
 6290 
 6291 # Removes the definition from the input string, adds to the preamble
 6292 # and stores the body in %new_environment;
 6293 sub get_body_newenvironment {
 6294     local($newed,$after) = &process_body_newenvironment(0,@_);
 6295     ( $PREAMBLE ? "newed".$newed : '');
 6296 }
 6297 
 6298 sub process_body_newenvironment {
 6299 #    local($renew,*_) = @_;
 6300     local($renew,$after_R) = @_;
 6301     local($_) = $$after_R;
 6302     local($no_change) = $_;
 6303     local($argn,$env,$begin,$end,$tmp,$opt,$pat);
 6304     local($new_env) = 'environment';
 6305     if ($renew == 2) {
 6306         $env = &missing_braces unless (
 6307 	        (s/$next_pair_pr_rx/$pat=$&;$env=$2;''/e)
 6308 	        ||(s/$next_pair_rx/$pat=$&;$env=$2;''/e));
 6309 	$new_env .= $pat;
 6310     } else {
 6311 	($env,$pat) = &get_next(1);	# Get the environment name
 6312 	$env =~ s/^\s*\\//; $new_env .= $pat;
 6313     }
 6314     ($argn,$pat) = &get_next(0);	# Get optional no. of args
 6315     $argn = 0 unless $argn; $new_env .= $pat if $argn;
 6316 
 6317     # Get the body of the code and store it with the name and number of args
 6318     # UNLESS THE COMMAND IS ALREADY DEFINED (see get_body_newcommand)
 6319     # ...in which case $ALLOW_REDEFINE must also have been set.  # RRM
 6320     $opt = '}';			# Flag for no optional arg
 6321     if (/^\[/) {
 6322 	($opt,$pat) = &get_next(0);
 6323 	$new_env .= $pat;
 6324     }
 6325     $tmp = "do_env_$env";
 6326 
 6327     if ($renewed == 2 ) {
 6328         $begin = &missing_braces unless (
 6329 	        (s/$next_pair_pr_rx/$pat=$&;$begin=$2;''/e)
 6330 	        ||(s/$next_pair_rx/$pat=$&;$begin=$2;''/e));
 6331 	$new_env .= $pat;
 6332 	$end = &missing_braces unless (
 6333 	        (s/$next_pair_pr_rx/$pat=$&;$end=$2;''/e)
 6334 	        ||(s/$next_pair_rx/$pat=$&;$end=$2;''/e));
 6335 	$new_env .= $pat;
 6336     } else {
 6337 	($begin,$pat) = &get_next(1); $new_env .= $pat;
 6338 	($end,$pat) = &get_next(1); $new_env .= $pat;
 6339     }
 6340     if ((defined &$tmp)&&($ALLOW_REDEFINE)) {
 6341 	print STDOUT "\n*** redefining environment {$env} ***\n";
 6342 	&write_warnings("\nredefined environment {$env} ");
 6343     }
 6344     $new_environment{$env} = join(':!:', $argn, $begin, $end, $opt)
 6345 	unless ((defined &$tmp)&&(! $ALLOW_REDEFINE));
 6346 
 6347     if (!$PREAMBLE) {
 6348 	$new_env = join ('', 
 6349 	    , "environment{$env}" 
 6350 	    , ($argn ? "[$argn]" : '')
 6351 	    , (($opt ne '}')? "[$opt]" : '')
 6352 	    , "{$begin}{$end}"
 6353 	    );
 6354 	&revert_to_raw_tex($new_env);
 6355 	if ($renew == 2) {
 6356 	    $latex_body .= "\n\\".($renew ? 're':'').'new'.$new_env."\n";
 6357 	} else {
 6358 	    &add_to_preamble ('environment'
 6359 		, "\\".($renew ? 're':'').'new'.$new_env );
 6360 	}
 6361 	$$after_R = $_;
 6362 	return();
 6363     }
 6364     if ($new_env =~ /$sections_rx/) {
 6365     	$new_env = join('', $`,'\csname ',$2,'\endcsname',$3,$');
 6366     }
 6367     $new_env =~ s/$par_rx/\\par /g;
 6368     $$after_R = $_;
 6369     $new_env;
 6370 }
 6371 
 6372 sub get_body_renewenvironment {
 6373     local($ALLOW_REDEFINE) = 1;
 6374     local($renewed, $after) = &process_body_newenvironment(1,@_);
 6375     'renewed'.$renewed;
 6376 }
 6377 
 6378 sub do_cmd_renewedenvironment {
 6379     local($ALLOW_REDEFINE) = 1;
 6380     local($_) = @_;
 6381     &process_body_newenvironment(2,\$_);
 6382     $_;
 6383 }
 6384 
 6385 # Instead of substituting as with newcommand and newenvironment,
 6386 # or generating code to handle each new theorem environment,
 6387 # it now does nothing. This forces theorem environments to be passed
 6388 # to latex. Although it would be possible to handle theorem
 6389 # formatting in HTML as it was done previously it is impossible
 6390 # to keep the theorem counters in step with other counters (e.g. equations)
 6391 # to which only latex has access to. Sad...
 6392 sub get_body_newtheorem {
 6393 #    local(*_) = @_;
 6394     local($after_R) = @_;
 6395     local($_) = $$after_R;
 6396     my ($orig, $body) = ($_, '');
 6397     my ($title, $env, $ctr, $within, $cmd, $tmp, $begin, $end, $pat);
 6398     my ($new_thm) = 'theorem';
 6399     # Just chop off the arguments and append to $next_def
 6400     ($env,$pat) = &get_next(1); $new_thm .= $pat;
 6401     ($ctr,$pat) = &get_next(0); $new_thm .= $pat;
 6402     ($title,$pat) = &get_next(1); $new_thm .= $pat;
 6403     ($within,$pat) = &get_next(0); $new_thm .= $pat;
 6404 
 6405     #check the style parameters
 6406     my ($hfont,$bfont,$thm_style);
 6407     my ($before_thm) = join('',@processed);
 6408     my ($which,$cmds);
 6409     while ($before_thm =~ /$theorem_cmd_rx/) {
 6410 	$which = $1;
 6411 	$before_thm = $';
 6412 	$before_thm =~ s/$next_pair_rx/$cmds = $2;''/e;
 6413 	$cmds =~ s/\\/\|/g;  # escape any backslash
 6414 	if ($which =~ /style/) { $thm_style = $cmds }
 6415 	elsif ($which =~ /header/) { $hfont = $cmds }
 6416 	elsif ($which =~ /body/)   { $bfont = $cmds }
 6417     }
 6418     $hfont = '['.$hfont.']';
 6419     $bfont = '['.$bfont.']';
 6420     $thm_style = '['.$thm_style.']';
 6421     undef $before_thm;
 6422 
 6423     if (!($ctr)) {
 6424 	# define the new counter
 6425 	$ctr = $env;
 6426 	do {
 6427 ###	    local($_) = "\\arabic<<1>>$ctr<<1>>";
 6428 ###	    $_ = join('',"\\the$within", "." , $_) if ($within);
 6429 	    $body = "\\arabic<<1>>$ctr<<1>>";
 6430 	    $body = join('',"\\the$within", "." , $body) if ($within);
 6431 	    &make_unique($body);
 6432 	    $cmd = "the$ctr";
 6433 	    $tmp = "do_cmd_$cmd";
 6434 	    do {
 6435                 $new_command{$cmd} = join(':!:',0,$body,'}') 
 6436 	    } unless (defined &$tmp);
 6437 	    &write_mydb("new_command", $cmd, $new_command{$cmd});
 6438 	    eval "sub do_cmd_$cmd {\n"
 6439 		. 'local($_,$ot) = @_;'."\n"
 6440 		. 'local($open_tags_R) = defined $ot ? $ot : $open_tags_R;'."\n"
 6441 		. '&translate_commands(' . "\"$body\"" . ");\n}\n";
 6442 	    print STDERR "\n*** sub $tmp failed:\n$@\n" if ($@);
 6443 	    $raw_arg_cmds{$cmd} = 1;
 6444 	    undef $body;
 6445 	};
 6446 	&do_body_newcounter($ctr);
 6447     } else {
 6448 	do {
 6449 ###	    local($_) = "\\arabic<<1>>$ctr<<1>>";
 6450 	    $body = "\\arabic<<1>>$ctr<<1>>";
 6451 	    &make_unique($body);
 6452 	    $cmd = "the$env";
 6453 	    $tmp = "do_cmd_$cmd";
 6454 	    do {
 6455                 $new_command{$cmd} = join(':!:',0,$body,'}') 
 6456 	    } unless (defined &$tmp);
 6457 	    &write_mydb("new_command", $cmd, $new_command{$cmd});
 6458 	    eval "sub do_cmd_$cmd {\n"
 6459 		. 'local($_,$ot) = @_;'
 6460 		. 'local($open_tags_R) = defined $ot ? $ot : $open_tags_R;'
 6461 		. '&translate_commands(' . "\"$body\"" . ");\n}\n";
 6462 	    print STDERR "\n*** sub $tmp failed:\n$@\n" if ($@);
 6463 	    $raw_arg_cmds{$cmd} = 1;
 6464 	    undef $body;
 6465 	};
 6466     }
 6467 
 6468     # record the counter dependency
 6469     &addto_dependents($within,$ctr) if ($within);
 6470 
 6471     # save the text-label in the %new_theorem hash
 6472     $new_theorem{$env} = $title;
 6473 
 6474     # define a new environment
 6475     my ($id) = ++$global{'max_id'};
 6476     $begin = "\\begin<<$id>>theorem_type<<$id>>"
 6477 	. "[$env][$ctr][$within]$thm_style$hfont$bfont\n";
 6478     $id = ++$global{'max_id'};
 6479     $end = "\\end<<$id>>theorem_type<<$id>>\n";
 6480     $tmp = "do_env_$env";
 6481     if ((defined &$tmp)&&($ALLOW_REDEFINE)) {
 6482 	print STDOUT "\n*** redefining theorem environment {$env} ***\n";
 6483     }
 6484     $new_environment{$env} = join(':!:', '', $begin, $end, '')
 6485 	unless ((defined &$tmp)&&(! $ALLOW_REDEFINE));
 6486 
 6487     if (!$PREAMBLE) {
 6488 	my ($new_cmd) = join(''
 6489 	    , 'theorem{}' );
 6490 	&add_to_preamble('theorem', "\\new".$new_cmd );
 6491 	$$after_R = $_;
 6492 	return();
 6493     }
 6494     $$after_R = $_;
 6495     'newed'.$new_thm;
 6496 }
 6497 
 6498 sub do_cmd_theoremstyle {
 6499     local($_) = @_;
 6500     local($thm_type);
 6501     $thm_type = &missing_braces unless (
 6502 	(s/$next_pair_pr_rx/$thm_type=$2;''/e)
 6503 	||(s/$next_pair_rx/$thm_type=$2;''/e));
 6504 #   $THM_STYLE = $thm_type;
 6505     $_;
 6506 }
 6507 sub do_cmd_theoremheaderfont {
 6508     local($_) = @_;
 6509     local($thm_type);
 6510     $thm_type = &missing_braces unless (
 6511 	(s/$next_pair_pr_rx/$thm_type=$2;''/e)
 6512 	||(s/$next_pair_rx/$thm_type=$2;''/e));
 6513 #   $THM_HFONT = $thm_type;
 6514     $_;
 6515 }
 6516 sub do_cmd_theorembodyfont {
 6517     local($_) = @_;
 6518     local($thm_type);
 6519     $thm_type = &missing_braces unless (
 6520 	(s/$next_pair_pr_rx/$thm_type=$2;''/e)
 6521 	||(s/$next_pair_rx/$thm_type=$2;''/e));
 6522 #   $THM_BFONT = $thm_type;
 6523     $_;
 6524 }
 6525 
 6526 sub do_env_theorem_type {
 6527     local($_) = @_;
 6528     local($dum,$env,$ctr,$within, $label, $name, $title, $text, $index);
 6529     ($env, $dum) = &get_next_optional_argument;
 6530     ($ctr, $dum) = &get_next_optional_argument;
 6531     ($within, $dum) = &get_next_optional_argument;
 6532 
 6533     local($thm_num, $thm_style);
 6534     # defaults for plain theorem-style
 6535     my ($hfont,$bfont) = ('','');
 6536 
 6537     ($thm_style, $dum) = &get_next_optional_argument;
 6538     ($hfont, $dum) = &get_next_optional_argument;
 6539     $hfont =~ s/\|/\\/og;
 6540     ($bfont, $dum) = &get_next_optional_argument;
 6541     $bfont =~ s/\|/\\/og;
 6542 
 6543     # the pre-defined alternative theorem-styles
 6544     if ($thm_style =~ /definition/) {
 6545 	$bfont = '\normalfont' unless $bfont;
 6546     } elsif ($thm_style =~ /remark/) {
 6547 	$hfont = '\itshape' unless $hfont;
 6548 	$bfont = '\normalfont' unless $bfont;
 6549     }
 6550 
 6551     # defaults for plain theorem-style
 6552     $hfont = '\bfseries' unless $hfont;
 6553     $bfont = '\itshape' unless $bfont;
 6554 
 6555     ($name, $dum) = &get_next_optional_argument;
 6556     $name = &translate_environments("${O}0$C".$name."${O}0$C") if $name;
 6557     $name = &translate_commands($name) if ($name =~ /\\/);
 6558 
 6559     $index = $section_commands{$ctr};
 6560     if ($index) { 
 6561 	# environment actually starts a new (sub-)section
 6562 	$curr_sec_id[$index]++;
 6563 	local($this) = &translate_commands("\\the$ctr");
 6564 	local($hash) = &sanitize($name." $this");
 6565 	local($section_tag) = join('', @curr_sec_id);
 6566 	$encoded_section_number{$hash} = join($;, $section_tag);
 6567 	&reset_dependents($ctr) if ($dependent{$ctr});
 6568 	$thm_num = &translate_commands("\\the$ctr");
 6569 	$thm_num =~ s/(\w)\.(\.\w)/$1$2/g;
 6570 
 6571 	# construct the sectioning title from the counter values
 6572 	$title = join( '', $new_theorem{$env}, " "
 6573 	    , &translate_commands("\\the$ctr") );
 6574 	$toc_section_info{join(' ',@curr_sec_id)} = \
 6575 	    "$current_depth$delim$CURRENT_FILE$delim$title"
 6576 		if ($current_depth <= $MAX_SPLIT_DEPTH + $MAX_LINK_DEPTH);
 6577 	$section_info{join(' ',@curr_sec_id)} = \
 6578 	    "$current_depth$delim$CURRENT_FILE$delim$title$delim";
 6579 	$title = join('',"<A ID=\"SECTION$section_tag\"><B>"
 6580 		      , $title , "</B></A>" );
 6581     } else {
 6582 	if ($ctr) {
 6583 	    print STDOUT "\nSTP:$ctr:+1" if ($VERBOSITY > 3);
 6584 	    $global{$ctr}++;
 6585 	    print STDOUT "=".$global{$ctr}." " if ($VERBOSITY > 3);
 6586 	    &reset_dependents($ctr) if ($dependent{$ctr});
 6587 	    $thm_num = "\\the$ctr ";
 6588 	} else { $thm_num = ''; }
 6589 
 6590 	# construct the full title from the counter values
 6591 	$title = $new_theorem{$env};
 6592 	if (($thm_style =~ /margin/)&&($HTML_VERSION > 2.1)) {
 6593 	    # don't use the number yet
 6594 	} elsif ($thm_style =~ /change/) {
 6595 	    $title = join(' ', $thm_num, "\\space", $title)
 6596 	} else {
 6597 	    $title = join(' ', $title, "\\space", $thm_num);
 6598 	}
 6599 
 6600 	if ($hfont) {
 6601 	    $title = join('',$O,++$global{'max_id'},$C,$hfont," "
 6602 		      , $title, $O,++$global{'max_id'},$C);
 6603 	    $title = &translate_environments($title);
 6604 	    $title = &translate_commands($title);
 6605 	} else {
 6606 	    $title = join('',"<B>",&translate_commands($title),"</B>");
 6607 	}
 6608 	$title =~ s/(\w)\.(\.\w)/$1$2/g;
 6609     }
 6610     # extract any name or label that may occur at the start
 6611     s/^\s*(\\label(($O|$OP)\d+($C|$CP))([^<]*)\2)?\s*(\(([^\)]*)\))?/
 6612 	$label=$1; $text=$5; $name=$7 if ($7); ''/eo;
 6613     if ($label) {
 6614 	$label = &anchor_label($text,$CURRENT_FILE,'');
 6615 	$label =~ s/$anchor_mark/$title/;
 6616 	$title = $label;
 6617     }
 6618     if ($name) {
 6619 	$name =~ s/^\s*|\s*$//g; 
 6620 	$name = join('', " (", $name, ") ") if $name;
 6621     }
 6622     local($attribs, $border);
 6623     if (s/$htmlborder_rx//o) { $attribs = $2; $border = (($4)? "$4" : 1) }
 6624     elsif (s/$htmlborder_pr_rx//o) { $attribs = $2; $border = (($4)? "$4" : 1) }
 6625 
 6626     $_ = join('', $O,++$global{'max_id'},$C, $bfont
 6627 	    , " ", $_ ,$O,++$global{'max_id'},$C) if ($bfont);
 6628 
 6629     my($cmd) = 'do_thm_'.$env;
 6630     if (defined &$cmd) {
 6631 	$_ = &$cmd($ctr, $title, $_);
 6632     } else {
 6633 	$_ = &translate_environments($_);
 6634 	$_ = &translate_commands($_);
 6635     }
 6636 
 6637     if ($thm_style =~ /margin/) {
 6638 	local($valign);
 6639 	$valign = ($NETSCAPE_HTML ? ' VALIGN="BASELINE"':'');
 6640 	if ($hfont) {
 6641 	    $thm_num = join('',$O,++$global{'max_id'},$C,$hfont," "
 6642 		      , $thm_num, $O,++$global{'max_id'},$C);
 6643 	    $thm_num = &translate_environments($thm_num);
 6644 	    $thm_num = &translate_commands($thm_num);
 6645 	} else {
 6646 	    $thm_num = join('',"<B>",&translate_commands($thm_num),"</B>");
 6647 	}
 6648 	$thm_num =~ s/(\w)\.(\.\w)/$1$2/g;
 6649 
 6650 	# code copied from  &make_table
 6651 	local($Tattribs);
 6652 	if ($attribs) {
 6653 	    if (!($attribs =~ /=/)) {
 6654 		$Tattribs = &parse_valuesonly($attribs,"TABLE");
 6655 	    } else {
 6656 		$Tattribs = &parse_keyvalues($attribs,"TABLE");
 6657 	    }
 6658 	    $Tattribs = ' '.$Tattribs if ($Tattribs);
 6659 	}
 6660 	$_ = join ('', "\n<P><DIV$env_id><TABLE"
 6661 		, (($border) ? " BORDER=\"$border\"" : '')
 6662 		, $Tattribs , ">\n<TR VALIGN=\"TOP\">"
 6663 		, "<TD$valign>", &translate_commands($thm_num)
 6664 		, "</TD>\n<TD>", $title, $name
 6665 		, (($thm_style =~ /break/)? "\n<BR>":" \&nbsp; \n")
 6666 		, $_ , "\n</TD></TR></TABLE></DIV>");
 6667     } else {
 6668 	$_ = join('', "<P><DIV$env_id>"
 6669 		, $title, $name
 6670 		, (($thm_style =~ /break/)? "\n<BR>":" \&nbsp; \n")
 6671 		, $_
 6672 		,"</DIV><P></P>\n");
 6673 	if (($border||($attribs))&&($HTML_VERSION > 2.1 )) { 
 6674 	    &make_table( $border, $attribs, '', '', '', $_ ) 
 6675 	} else { $_ }
 6676     }
 6677 }
 6678 
 6679 # Modifies $_ in the caller and as a side-effect it modifies $next_def
 6680 # which is local to substitute_meta_cmds
 6681 sub get_next {
 6682     local($what) = @_;
 6683     local($next, $pat, $tmp);
 6684     if ($what == 1) {
 6685 	($next, $tmp, $pat) = &get_next_argument;
 6686     }
 6687     elsif ($what == 2) {
 6688 	($next, $pat) = &get_next_tex_cmd;
 6689     }
 6690     elsif ($what == 3) {
 6691 	($next, $pat) = &get_next_def_arg;
 6692     }
 6693     elsif ($what == 4) {
 6694 	($next, $tmp, $pat) = &get_next_argument;
 6695     }
 6696     else {
 6697 	($next, $pat) =  &get_next_optional_argument;
 6698     }
 6699     do {
 6700 	$next_def .= &revert_to_raw_tex($pat) if $pat;
 6701     } unless ($renewed); # don't add \renewcommand to preamble
 6702 #    $next =~ s/(^\s*)|(\s*$)//g unless ($what == 4); #don't lose white space on body
 6703     $next =~ s/(^\s*)|(\s*$)//g unless ($what =~ /[14]/); #retain white space in body
 6704     ($next, $pat);
 6705 }
 6706 
 6707 # The following get_next_<something> ARE ALL DESTRUCTIVE.
 6708 sub get_next_argument {
 6709     local($next, $br_id, $pat);
 6710     if (!(s/$next_pair_rx/$br_id=$1;$next=$2;$pat=$&;''/seo)) {
 6711 	print " *** Could not find argument for command \\$cmd ***\n";
 6712 	print "$_\n";
 6713     };
 6714     ($next, $br_id, $pat);
 6715 }
 6716 
 6717 sub get_next_pair_or_char_pr {
 6718     local($next, $br_id, $pat, $epat);
 6719     if ( /^\{([^\}]*)\}/o && (! $`)) {
 6720 	($next, $pat) = ($1, $&);
 6721     } elsif ( (/^\s*([^\s\\<])/o && (! $`))) {
 6722 	($next, $pat) = ($1, $&);
 6723     } elsif ( /$next_pair_pr_rx/o && (! $`)) {
 6724 	($next, $br_id, $pat) = ($2, $1, $&);
 6725     };
 6726     $epat = &escape_rx_chars($pat);
 6727     s/$epat// if $pat;
 6728     ($next, $br_id, $pat);
 6729 }
 6730 
 6731 sub get_next_optional_argument {
 6732     local($next, $pat);
 6733     s/$optional_arg_rx/$next=$1;$pat=$&;''/eo
 6734 	if (/\s*[[]/ && (! $`)); # if the first character is a [
 6735     #remove trailing spaces and/or comments
 6736     s/^($comment_mark(\d+\n?)?|$EOL)//gos;
 6737 
 6738     # if  nested inside {}s  we need to get more tokens  
 6739     if ($pat) {
 6740 	# check for \item, indicating something has gone wrong
 6741 	if ($pat =~ /\\item\b/ ) {
 6742 	    print "\n*** optional argument badly formed:\n" . $pat . "\n\n";
 6743 	    $_ = $pat . $_;
 6744 	    return('','');
 6745 	}
 6746 	# check for being nested inside {}s
 6747 	local($found) = $pat;
 6748 	while ($found =~ s/$O(\d+)$C[\s\S]*$O\1$C//g) {
 6749 	    if ($found =~ /$O(\d+)$C/) {
 6750 		local($br_id) = $1;
 6751 		if (s/$O$br_id$C//) {
 6752 		    $found .= $`.$&;
 6753 		    $pat .= "]".$`.$&;
 6754 		    $next .= "]".$`.$&;
 6755 		    $_ = $';
 6756 		    s/^([^]]*)\]/$next.=$1;$pat.=$&;''/e;
 6757 		    $found .= $&;
 6758 		} else { last } # give up if no closing brace
 6759 	    }
 6760 	}
 6761     } else {
 6762 	s/^\s*\[\]/$pat=$&;''/e; # This is not picked by $optional_arg_rx
 6763     }
 6764     ($next, $pat);
 6765 }
 6766 
 6767 #JCL(jcl-del) - use new form of $single_cmd_rx.
 6768 sub get_next_tex_cmd {
 6769     local($next, $pat);
 6770     s/^\s*\=?\s*$single_cmd_rx/$4/;
 6771     ($next, $pat) = ($1.$2,"\\".$1.$2);
 6772 }
 6773 
 6774 sub get_next_def_arg {
 6775     local($next, $pat);
 6776 
 6777     # Sets is_simple_def for caller.  Start by turning it off, then
 6778     # turn it on if we find one of the "simple" patterns.
 6779 
 6780     # This has got to be hit-or-miss to an extent, given the
 6781     # thoroughly incestuous relationship between the TeX macroprocessor
 6782     # ('mouth') and typesetting back-end ('stomach').  Anything which
 6783     # even does catcode hacking is going to lose BAD.
 6784 
 6785     s/^\s*//so;			# Remove whitespace
 6786 
 6787     $is_simple_def = 0;
 6788 
 6789     # no arguments
 6790 
 6791     if (/^$O/ && (! $`)) { $next=0; $pat=''; $is_simple_def=1; }
 6792 
 6793     # 'simple' arguments
 6794 
 6795     if (! $is_simple_def && /$tex_def_arg_rx/o && (! $`)) {
 6796 	s/$tex_def_arg_rx/$next=$1; $pat=$&; $is_simple_def=1; $2/seo; }
 6797 
 6798     # MESSY arguments
 6799 
 6800     if (! $is_simple_def) {
 6801  	print "Arguments to $cmd are too complex ...\n";
 6802 	print "It will not be processed unless used in another environment\n";
 6803 	print "which is passed to LaTeX whole for processing.\n";
 6804 
 6805 	s/^[^<]*(<[^<]+)*<</$next=''; $pat=$&; $O/seo;
 6806     }
 6807 
 6808     $pat =~ s/$O$//so;
 6809 
 6810     ($next, $pat);
 6811 }
 6812 
 6813 #### Key-value parsing added by RRM
 6814 #
 6815 #   This cleans-up the key-value pairs for a given tag, 
 6816 #   by removing unnecessary spaces and commas, inserting quotes
 6817 #   around the value and puts a preceding space.
 6818 #   The key becomes upper-case, while the value becomes lower-case.
 6819 #   If specific `tags' are provided, then checking is done to verify 
 6820 #   that the keys and values are valid for these tags, eliminating
 6821 #   any that are not; unmatched keys or values are handled as well.
 6822 #   If no tags are provided, then just a list of pairs is returned.
 6823 #
 6824 sub parse_keyvalues {
 6825     local($_,@tags) = @_;
 6826     local($key,$KEY,$attribs,$atts,%attributes)=('','','','');
 6827 
 6828     # beware active " in german
 6829     local($is_german);
 6830     if (s/\&#34;/'/g) { 
 6831 	$is_german=1;
 6832 	s/(^|[\s,=])(\&\#\d\d\d;)/$1'$2/g
 6833     }
 6834     local($saved) = &revert_to_raw_tex(&translate_commands($_));
 6835     print "\nATTRIBS: $saved\n" if ($VERBOSITY > 6);
 6836 
 6837     $saved =~ s/$percent_mark/%/g;
 6838     $saved =~ s/((^|[\s,=])')\\\W\{(\w)\}/$1$3/g
 6839 	if $is_german;  #unwanted accents, from active "
 6840     if (@tags) {
 6841 	foreach $tag (@tags) {
 6842 	    $_ = $saved;
 6843 	    local($name)= $tag."_attribs";
 6844 	    $taglist = $$name;
 6845 	    $name .= "_rx_list";
 6846 	    $taglist .= $$name;
 6847 	    $taglist =~ s/,,/,/;
 6848 #	    s/(^|,)\s*([a-zA-Z]+)\s*\=\s*"?([\#\%\w\d]+)"?\s*/$attributes{$2}="$3";''/eg;
 6849 #	    s/(^|,)\s*([a-zA-Z]+)\s*\=\s*(\"([^"]*)\"|\'([^\']*)\'|([#%\w\d]*))\s*/
 6850 #	    s/(^|,)\s*([a-zA-Z]+)\s*\=\s*(\"([^"]*)\"|\'([^\']*)\'|([#%&@;:+-\/\w\d]*))\s*/
 6851 	    s/(^|,)\s*([a-zA-Z]+)\s*\=\s*(\"([^"]*)\"|\'([^\']*)\'|([^<>,=\s]*))\s*/
 6852 		$attributes{$2}=($4?$4:($5?$5:$6));' '/eg;
 6853 	    foreach $key (sort keys %attributes){ 
 6854 		$KEY = $key;
 6855 		$KEY =~ tr/a-z/A-Z/;
 6856 		if ($taglist =~ /,$KEY,/i) {	        
 6857 		    local($keyname) = $tag."__".$KEY; 
 6858 		    local($keyvalues) = '';
 6859 		    if ($$keyname) {
 6860 			$keyvalues = $$keyname;
 6861 			$atts = $attributes{$key};
 6862 			if ($keyvalues =~ /\,$atts\,/i ) {
 6863 #			    $atts =~ tr/A-Z/a-z/;
 6864 			    $attribs .= " $KEY=\"$atts\"";
 6865 			    print "\n$KEY=$atts " if ($VERBOSITY > 3);
 6866 			} else { &invalid_tag($tag,$KEY,$atts); }
 6867 		    } else {	# test for a regular expression
 6868 		        $keyname = $keyname."_rx";
 6869 			if ($$keyname) {
 6870 			    $keyvalues = $$keyname;
 6871 			    $atts = $attributes{$key};
 6872 			    if ($atts =~ /$keyvalues/) {
 6873 #				$atts =~ tr/A-Z/a-z/;
 6874 				$attribs .= " $KEY=\"$atts\"";				
 6875 				print "\n$KEY=$atts " if ($VERBOSITY > 3);
 6876 			    } else { &invalid_tag($tag,$KEY,$atts) }
 6877 			} else {
 6878 			    $atts = $attributes{$key};
 6879 #			    $atts =~ tr/A-Z/a-z/;
 6880 			    $attribs .= " $KEY=\"$atts\"";
 6881 			    print "\n$KEY=$atts " if ($VERBOSITY > 3);
 6882 			}
 6883 		    }
 6884 		} else {
 6885 		    print "\n$key not in $taglist for $tag" if ($VERBOSITY > 3);
 6886 		}
 6887 	    }
 6888 	}
 6889         s/(^|\s,)\'([^\s,]*)\'(\s|$)/$1$2 /g if $is_german;
 6890 	$attribs .= &parse_valuesonly($_,@tags);
 6891     } else {
 6892 	# with no tags provided, just list the key-value pairs
 6893 	$_ = $saved;
 6894 	s/\s*(\w+)\s*=\s*\"?(\w+)\"?\s*,?/$attributes{$1}=$2;''/eg;
 6895 	foreach $key (sort keys %attributes){ 
 6896 	    $KEY = $key;
 6897 	    $KEY =~ tr/a-z/A-Z/;
 6898 	    $atts = $attributes{$key};
 6899 	    $atts =~ tr/A-Z/a-z/;
 6900 	    $attribs .= " $KEY=\"$atts\"";
 6901 	}
 6902     }
 6903     $attribs;
 6904 }
 6905 
 6906 sub invalid_tag {
 6907     local($tag,$key,$value) = @_;
 6908     &write_warnings("$key=$value is an invalid value in the <$tag> tag\n");
 6909 }
 6910 
 6911 # RRM
 6912 #   This creates key-value pairs from values only, 
 6913 #   by checking whether the data matches any key to the provided tags.
 6914 #   Only the first match found is retained.
 6915 #   Attributes with no values are also recognised here.
 6916 #
 6917 sub parse_valuesonly {
 6918     local($values,@tags) = @_;
 6919     local($i,$tag,$key,$KEY,$attribs,$atts)=(0,'','','','','');
 6920     local($saved) = &revert_to_raw_tex(&translate_commands($values));
 6921     $saved =~ s/$percent_mark/%/g;
 6922     foreach $tag (@tags) {
 6923 	local($name)= $tag."_attribs";
 6924 	$taglist = $$name;
 6925 	$values = $saved;
 6926         $values =~ s/\s*\"?([^,\s\"]+)\"?\s*,?/$i++;$attributes{$i}=$1;''/eg;
 6927         local($j) = 0;
 6928 	while ($j < $i) {
 6929 	    $j++;
 6930 	    $key = $attributes{$j};
 6931 	    if ($taglist =~ /,$key,/i) {
 6932 		$KEY = $key;
 6933 		$KEY =~ tr/a-z/A-Z/;
 6934 		$attribs .= " $KEY";
 6935 		print " $KEY" if ($VERBOSITY > 3);
 6936 	    } else {
 6937 		$atts = $attributes{$j};
 6938 		$key = &find_attribute($key,$tag);
 6939 	        if ($key) {
 6940 		    $KEY = $key;
 6941 		    $KEY =~ tr/a-z/A-Z/;
 6942 		    $atts =~ tr/A-Z/a-z/;
 6943 	            $attribs .= " $KEY=\"$atts\"";
 6944 		    print " $KEY = $atts" if ($VERBOSITY > 3);
 6945 		} else { }
 6946 	    }
 6947 	}
 6948     }
 6949     $attribs;
 6950 }
 6951 
 6952 # RRM
 6953 #   Extracts key-value pairs using a supplied (comma-separated) list.
 6954 #   When no list is given, it checks for a pre-defined list for the tag.
 6955 #   
 6956 sub extract_attributes {
 6957     local($tag,$taglist,$_) = @_;
 6958     local($key,$attribs,$unused,%attributes);
 6959     if (! ($taglist)) {
 6960 	local($name) = "$tag"."_attribs";
 6961 	if ($$name) { $taglist = $$name }
 6962     }
 6963     s/\s*(\w+)\s*=\s*\"?(\w+)\"?\s*,?/$attributes{$1}=$2;''/eg;
 6964     foreach $key (sort keys %attributes){ 
 6965 	if ($taglist =~ /\,$key\,/) {
 6966 	    $attribs .= " $key=\"$attributes{$key}\"";
 6967 	    &write_warnings("valid attribute $key for $tag\n");
 6968 	} else {
 6969 	    &write_warnings("unknown attribute $key for $tag\n");
 6970 	    $unused .= " $key=\"$attributes{$key}\"";
 6971 	}
 6972     }
 6973     ($attribs,$unused);
 6974 }
 6975 
 6976 # RRM
 6977 #   Finds the attribute of a given tag, for which a given value is valid.
 6978 #   Requires variables: <tag>_<key> to be a comma-separated list of keys.
 6979 #   So far it cannot recognise data-types, only names.
 6980 #
 6981 sub find_attribute {
 6982     local($key,$attrib,$tag) = ('',@_);
 6983     local($name) = $tag."_attribs";
 6984     local($attrib_list)=$$name;
 6985     if ($attrib_list) {
 6986 	$attrib_list =~ s/^\,//o;
 6987 	$attrib_list =~ s/\,$//o;
 6988 	local(@keys) = split(',',$attrib_list);
 6989 	local($attrib_vals) = '';
 6990 	foreach $key (@keys) {
 6991 	    $name = $tag."__".$key;
 6992 	    $attrib_vals = $$name;
 6993 	    return ($key) if ($attrib_vals =~ /\,$attrib\,/i ); 
 6994 	}
 6995     }
 6996     $name = $tag."_attribs_rx_list";
 6997     $attrib_list=$$name;
 6998     if (!($attrib_list)) { return(); }
 6999     $attrib_list =~ s/^\,//o;
 7000     $attrib_list =~ s/\,$//o;
 7001     @keys = split(',',$attrib_list);
 7002     foreach $key (@keys) {
 7003 	next if ($attribs =~ / $key=/);
 7004 	$name = $tag."__".$key."_rx";
 7005 	$attrib_vals = $$name;
 7006 	if ( $attrib =~ /^$attrib_vals$/ ) { 
 7007 	    return ($key);
 7008 	}
 7009     }
 7010     0;
 7011 }
 7012 
 7013 # in case \HTML is defined differently in packages
 7014 sub do_cmd_HTML { &do_cmd_HTMLcode(@_) }
 7015 
 7016 sub do_cmd_HTMLcode {
 7017     local($_) = @_;
 7018     local($tag,$attribs,$dum);
 7019     local($attribs, $dum) = &get_next_optional_argument;
 7020     $tag = &missing_braces unless (
 7021 	(s/$next_pair_pr_rx/$tag = $2;''/eo)
 7022 	||(s/$next_pair_rx/$tag = $2;''/eo));
 7023     $tag = &translate_commands($tag) if ($tag =~ /\\/);
 7024     if (! $tag) {
 7025 	print "*** no tag given with \\HTML command, ignoring it";
 7026 	return($_);
 7027     }
 7028     local($afterHTML) = $_;
 7029     local($value,$TAGattribs,$etag);
 7030     if (defined $unclosed_tags_list{$tag}) {
 7031     } elsif (defined $closed_tags_list{$tag}) {
 7032 	$value = &missing_braces unless (
 7033 	    (s/$next_pair_pr_rx/$value = $2;''/eo)
 7034 	    ||(s/$next_pair_rx/$value = $2;''/eo));
 7035 	$etag = "</$tag>";
 7036 	$afterHTML = $_;
 7037     } else {
 7038 	print "\n*** <$tag> is not a valid tag for HTML $HTML_VERSION";
 7039 	print "\n rejecting: \\HTML".(($attribs)? "[$attribs]" : '')."{$tag}";
 7040 	return $_ ;
 7041     }
 7042     if ($dum) {
 7043 	$attribs = &translate_commands($attribs) if ($attribs=~/\\/);
 7044         if ($attribs) {
 7045             if (!($attribs =~ /=/)) {
 7046                 $TAGattribs = &parse_valuesonly($attribs,$tag);
 7047             } else {
 7048                 $TAGattribs = &parse_keyvalues($attribs,$tag);
 7049             }
 7050         }
 7051     } else { }  # default if no [...]
 7052     local($needed) = join(','
 7053 	    , $closed_tags_list{$tag},$unclosed_tags_list{$tag});
 7054     $needed =~ s/,,/,/g; $needed =~ s/^,|,$//g;
 7055     if ($TAGattribs) {
 7056 	if ($needed) {
 7057 	    $needed =~ s/,,/,/g;
 7058 	    local($this, @needed);
 7059 	    (@needed) = split(',',$needed);
 7060 	    foreach $this (@needed) {
 7061 		next unless ($this);
 7062 		next if ($TAGattribs =~ /\b$this\b/);
 7063 		print "\n*** attribute $this required for <$tag> ***";
 7064 		print "\n rejecting: \\HTML".(($attribs)? "[$attribs]" : '')."{$tag}";
 7065 		return($value.$afterHTML);
 7066 	    }
 7067 	}
 7068 	$value = &translate_environments($value);
 7069 	$value = &translate_commands($value) if ($value =~ /\\/);
 7070 	$_ = join('', "<$tag", $TAGattribs, ">", $value, $etag);
 7071    } elsif ($needed) {
 7072 	print STDOUT "\n*** attributes $needed are required for <$tag> ***";
 7073 	return($value.$after);
 7074     } elsif ($value) {
 7075 	$value = &translate_environments($value);
 7076 	$value = &translate_commands($value) if ($value =~ /\\/);
 7077 	$_ = join('', "<$tag>", $value, $etag);
 7078     } else {
 7079 	$_ = join('', "<$tag>", $etag);
 7080     }
 7081     $_.$afterHTML; 
 7082 }
 7083 
 7084 sub do_cmd_HTMLget {
 7085     local($_) = @_;
 7086     local($which,$value,$hash,$dummy);
 7087     local($hash, $dummy) = &get_next_optional_argument;
 7088     $which = &missing_braces unless (
 7089 	(s/$next_pair_pr_rx/$which = $2;''/eo)
 7090 	||(s/$next_pair_rx/$which = $2;''/eo));
 7091     if ($hash) {
 7092 	local($tmp) = "\%$hash";
 7093 	if (eval "defined \%{$hash}") { $! = '';
 7094 	    $value = ${$hash}{'$which'};
 7095 	} else { print "\nhash: \%$hash not defined" }
 7096     } elsif ($which) {
 7097 	$value = ${$which};
 7098     }
 7099     $value.$_;
 7100 }
 7101 
 7102 sub do_cmd_HTMLset {
 7103     local($_) = @_;
 7104     local($which,$value,$hash,$dummy);
 7105     local($hash, $dummy) = &get_next_optional_argument;
 7106     $which = &missing_braces unless (
 7107 	(s/$next_pair_pr_rx/$which = $2;''/eo)
 7108 	||(s/$next_pair_rx/$which = $2;''/eo));
 7109     $value = &missing_braces unless (
 7110 	(s/$next_pair_pr_rx/$value = $2;''/eo)
 7111 	||(s/$next_pair_rx/$value = $2;''/eo));
 7112     if ($hash) {
 7113 	local($tmp) = "\%$hash";
 7114 	if (eval "defined \%{$hash}") { $! = '';
 7115 #	    eval "\$$hash{'$which'} = \"$value\";";
 7116 	    ${$hash}{'$which'} = $value;
 7117 	    print "\nHTMLset failed: $! " if ($!);
 7118 	} else { print "\nhash: \%$hash not defined" }
 7119     } elsif ($which) { $! = '';
 7120 	eval "\${$which} = \"$value\";";
 7121 	print "\nHTMLset failed: $! " if ($!);
 7122     }
 7123     $_;
 7124 }
 7125 
 7126 sub do_cmd_HTMLsetenv { &do_cmd_HTMLset(@_) }
 7127 
 7128 ####
 7129 
 7130 
 7131 # Appends $next_def to the preamble if it is not already there.
 7132 sub add_to_preamble {
 7133     local($type, $next_def) = @_;
 7134     local($name);
 7135     if ($type =~ /def|include|special|graphicspath/) {
 7136         local($pat) = &escape_rx_chars ($next_def);
 7137 #	$preamble .= $next_def . "\n" unless ($preamble =~ /$pat/);
 7138 	push(@preamble, $pat); 
 7139     } 
 7140     elsif ($type =~ /command|environment|theorem|counter/) {
 7141 	push(@preamble, $next_def ); 
 7142     }
 7143     else {
 7144 	($name) = $next_def =~ /$marker\s*({[^}]+})/; # matches type{name}
 7145 	$name = &escape_rx_chars($name);
 7146 #	$preamble .= $next_def . "\n" unless ($preamble =~ /$marker\s*$name/);
 7147 	push(@preamble, $name ); 
 7148     }
 7149 }
 7150 
 7151 sub make_latex {
 7152 # This is the environment in which to process constructs that cannot be
 7153 # translated to HTML.
 7154 # The environment tex2html_wrap will be wrapped around any shorthand
 7155 # environments (e.g. $, \(, \[).
 7156 # The tex2html_wrap environment will be treated as an unrecognised
 7157 # evironment by the translator and its contents (i.e. the 'shorthand'
 7158 # environment) will be passed to latex for processing as usual.
 7159     local($contents) = @_;
 7160     local($preamble) = $preamble;
 7161     local($aux_preamble) = $aux_preamble;
 7162     while ($preamble =~ s/^(\@.*\n)/$prelatex .= $1;''/e) {}
 7163     print "\nPRE-LATEX: $prelatex" if (($prelatex)&&($VERBOSITY > 1));
 7164 
 7165     %newed_commands =
 7166 	 ( 'newedcommand' , 'newcommand'
 7167 	 , 'renewedcommand' , 'renewcommand'
 7168 	 , 'providedcommand' , 'providecommand'
 7169 	 , 'newedenvironment' , 'newenvironment'
 7170 	 , 'newedboolean' , 'newboolean'
 7171 	 , 'newedcounter' , 'newcounter'
 7172 	 , 'newedtheorem' , 'newtheorem'
 7173 	 , 'newedfont' , 'newfont' , 'newedif', 'newif'
 7174 	 );
 7175 		     
 7176 
 7177     # Make the @ character a normal letter ...
 7178     $preamble =~ s/\\par([^A-Za-z]|$)/\n$1/g;
 7179     $preamble =~ s/(\\document(class|style)(\[[^\]]+\])?\{\w+\})/$1\n/;
 7180     $preamble =~ s/(\\document(class|style)(\[[^\]]+\])?\{\w+\})/$1\n\\RequirePackage{ifthen}\n/
 7181 			 unless ($preamble =~/\{ifthen\}/);
 7182 #    $preamble =~ s/(\\document(class|style)(\[[^\]]+\])?\{\w+\})/$1\n\\makeatletter/;
 7183     # ... and make it special again after the preamble
 7184     # remove the  \begin/\end  for  tex2html_nowrap and tex2html_deferred environments
 7185     $preamble =~s/\\(begin|end)\s*\{(tex2html_(nowrap|deferred|nomath|preform)[_a-z]*|imagesonly)\}//g;
 7186     $preamble =~s/\n?\s?<tex2html_(end)?file>\#[^#]*\#//mg;
 7187 
 7188     $preamble = "\\documentclass\{article\}%\n\\usepackage{html}\n"
 7189 	unless ($preamble);
 7190     if (($LATEX_DUMP)&&(!($preamble =~ /\\usepackage\{ldump\}/))) {
 7191 	# MRO: replaced $* with /m
 7192 	$preamble =~ s/(\\document(class|style)[^\n]*\n)/$1\\usepackage\{ldump\}\n/m;
 7193     }
 7194     $LOAD_LATEX_COLOR = "\n\\usepackage{xcolor}" unless $LOAD_LATEX_COLOR;
 7195     if ($preamble =~ /(^|\s*[^%])\s*\\documentstyle/) {
 7196 	# \usepackage is invalid in LaTeX 2.09 and LaTeX-2e compatibility mode
 7197 	$LATEX_COLOR = ''; $LOAD_LATEX_COLOR = '';
 7198 	# ... so is \providecommand 
 7199 	$preamble =~ s/\\documentstyle[^{]*{[^}]*}\n?/
 7200 		$&."\n\\let\\providecommand\\newcommand\n"/eo;
 7201     }
 7202 
 7203     $preamble .= $LOAD_LATEX_COLOR."\n"
 7204 	unless ($preamble =~ /[,\{](xcolor|color|pstricks)[,\}]/);
 7205     if ($LATEX_COLOR && $preamble !~ /\\pagecolor/) {
 7206 	$preamble .= "\n\\definecolor{background}{HTML}{".$LATEX_COLOR."}\n".
 7207 	    "\\pagecolor{background}\n";
 7208 	$ENV{'TRANSPARENT_COLOR'} = '#'.$LATEX_COLOR;	# pass to pstoimg
 7209     }
 7210 
 7211     ### commented out: just inherit any inputenc commands from preamble of latex doc
 7212 #    do {
 7213 #	if ($ISOLATIN_CHARS) { $INPUTENC = $INPUTENC || 'latin1' };
 7214 #	$preamble .= "\n\\usepackage[".$INPUTENC."]\{inputenc\}\n";
 7215 #	} unless ($preamble =~ /\{inputenc/    ||
 7216 #		  $preamble =~ /\{luainputenc/ ||
 7217 #		  $POLYGLOSSIA);      # inputenc is meaningless for polyglossia
 7218 
 7219     $aux_preamble = '' unless (($aux_preamble)&&($contents =~ /\\(hyper)?(ref|cite)/));
 7220 
 7221     $preamble =~ s/\\((provide|(re)?new)ed(command|counter|if|theorem|environment|font))\b/
 7222 			 "%\n\\".$newed_commands{$1}/eg;
 7223     $preamble =~ s/(\\(re)?newcommand)\s*(\{(\\?)(\}|[^\}]+)\})/
 7224 		$1.(($4)? $3 : "{\\".$5.'}' )/eg;
 7225 
 7226     $preamble =~s/$verbatim_mark(imagesonly)(\d+)#/$verbatim{$2}/eg; # for images.tex only
 7227 
 7228 #    local($key);
 7229 #    foreach $key (keys %newed_commands) {
 7230 #	$preamble .= "\n\\let\\$key\\".$newed_commands{$key}
 7231 #    }
 7232     $preamble .= "\n";
 7233 
 7234     local($paperwidth) = '';
 7235     if ($PAPERSIZE) { $paperwidth = &adjust_textwidth($PAPERSIZE); }
 7236     else { $paperwidth = &adjust_textwidth("a5"); }
 7237     local($kern) = ($EXTRA_IMAGE_SCALE ? $EXTRA_IMAGE_SCALE/2 : ".5" );
 7238     $kern = $kern * $MATH_SCALE_FACTOR;
 7239     $prelatex . ($DEBUG ? "\\nonstopmode" : "\\batchmode") .
 7240     "\n$preamble\n\n\\makeatletter\n$aux_preamble\n" .
 7241     "\\makeatletter\n\\count\@=\\the\\catcode`\\_ \\catcode`\\_=8 \n" .
 7242     "\\newenvironment{tex2html_wrap}{}{}%\n" .
 7243     "\\catcode`\\<=12\\catcode`\\_=\\count\@\n" .
 7244     "\\newcommand{\\providedcommand}[1]{\\expandafter\\providecommand\\csname #1\\endcsname}%\n" .
 7245     "\\newcommand{\\renewedcommand}[1]{\\expandafter\\providecommand\\csname #1\\endcsname{}%\n" .
 7246     "  \\expandafter\\renewcommand\\csname #1\\endcsname}%\n" .
 7247     "\\newcommand{\\newedenvironment}[1]{\\newenvironment{#1}{}{}\\renewenvironment{#1}}%\n" .
 7248     "\\let\\newedcommand\\renewedcommand\n" .
 7249     "\\let\\renewedenvironment\\newedenvironment\n" .
 7250     "\\makeatother\n" .
 7251     "\\let\\mathon=\$\n\\let\\mathoff=\$\n" .
 7252     "\\ifx\\AtBeginDocument\\undefined \\newcommand{\\AtBeginDocument}[1]{}\\fi\n" .
 7253     "\\newbox\\sizebox\n" . "$paperwidth" .
 7254     "\\newwrite\\lthtmlwrite\n" . "\\makeatletter\n" .
 7255     "\\let\\realnormalsize=\\normalsize\n\\global\\topskip=2sp\n\\def\\preveqno{}" .
 7256     "\\let\\real\@float=\\\@float \\let\\realend\@float=\\end\@float\n" .
 7257     "\\def\\\@float{\\let\\\@savefreelist\\\@freelist\\real\@float}\n" .
 7258 #    "\\def\\\@float{\\\@dbflt}\n" .
 7259     "\\def\\liih\@math{\\ifmmode\$\\else\\bad\@math\\fi}\n" .
 7260     "\\def\\end\@float{\\realend\@float\\global\\let\\\@freelist\\\@savefreelist}\n" . 
 7261     "\\let\\real\@dbflt=\\\@dbflt \\let\\end\@dblfloat=\\end\@float\n" .
 7262     "\\let\\\@largefloatcheck=\\relax\n" .
 7263     "\\let\\if\@boxedmulticols=\\iftrue\n" .
 7264     "\\def\\\@dbflt{\\let\\\@savefreelist\\\@freelist\\real\@dbflt}\n" .
 7265     "\\def\\adjustnormalsize{\\def\\normalsize{\\mathsurround=0pt \\realnormalsize\n" .
 7266     " \\parindent=0pt\\abovedisplayskip=0pt\\belowdisplayskip=0pt}%\n" .
 7267     " \\def\\phantompar{\\csname par\\endcsname}\\normalsize}%\n" .
 7268     "\\def\\lthtmltypeout#1{{\\let\\protect\\string \\immediate\\write\\lthtmlwrite{#1}}}%\n" .
 7269     (($USE_DVIPNG || $IMAGE_TYPE eq 'svg') ? <<'</dvipng>' :
 7270 \usepackage[tightpage,active]{preview}
 7271 \PreviewBorder=1bp
 7272 \newbox\lthtmlPageBox
 7273 \newdimen\lthtmlCropMarkHeight
 7274 \newdimen\lthtmlCropMarkDepth
 7275 \long\def\lthtmlTightVBoxA#1{\def\lthtmllabel{#1}
 7276     \setbox\lthtmlPageBox\vbox\bgroup\catcode`\_=8 }%
 7277 \long\def\lthtmlTightVBoxZ{\egroup
 7278     \lthtmlCropMarkHeight=\ht\lthtmlPageBox \advance \lthtmlCropMarkHeight 6pt
 7279     \lthtmlCropMarkDepth=\dp\lthtmlPageBox
 7280     \lthtmltypeout{^^J:\lthtmllabel:lthtmlCropMarkHeight:=\the\lthtmlCropMarkHeight}%
 7281     \lthtmltypeout{^^J:\lthtmllabel:lthtmlCropMarkDepth:=\the\lthtmlCropMarkDepth:1ex:=\the \dimexpr 1ex}%
 7282     \begin{preview}\copy\lthtmlPageBox\end{preview}}%
 7283 \long\def\lthtmlTightFBoxA#1{\def\lthtmllabel{#1}%
 7284     \adjustnormalsize\setbox\lthtmlPageBox=\vbox\bgroup\hbox\bgroup %
 7285     \let\ifinner=\iffalse \let\)\liih@math %
 7286     \bgroup\catcode`\_=8 }%
 7287 \long\def\lthtmlTightFBoxZ{\egroup\egroup
 7288     \@next\next\@currlist{}{\def\next{\voidb@x}}%
 7289     \expandafter\box\next\egroup %
 7290     \lthtmlCropMarkHeight=\ht\lthtmlPageBox \advance \lthtmlCropMarkHeight 6pt
 7291     \lthtmlCropMarkDepth=\dp\lthtmlPageBox
 7292     \lthtmltypeout{^^J:\lthtmllabel:lthtmlCropMarkHeight:=\the\lthtmlCropMarkHeight}%
 7293     \lthtmltypeout{^^J:\lthtmllabel:lthtmlCropMarkDepth:=\the\lthtmlCropMarkDepth:1ex:=\the \dimexpr 1ex}%
 7294     \begin{preview}\copy\lthtmlPageBox\end{preview}}%
 7295     \long\def\lthtmlinlinemathA#1#2\lthtmlindisplaymathZ{\lthtmlTightVBoxA{#1}{\hbox\bgroup#2\egroup}\lthtmlTightVBoxZ}
 7296     \def\lthtmlinlineA#1#2\lthtmlinlineZ{\lthtmlTightVBoxA{#1}{\hbox\bgroup#2\egroup}\lthtmlTightVBoxZ}
 7297     \long\def\lthtmldisplayA#1#2\lthtmldisplayZ{\lthtmlTightVBoxA{#1}{#2}\lthtmlTightVBoxZ}
 7298     \long\def\lthtmldisplayB#1#2\lthtmldisplayZ{\\edef\preveqno{(\theequation)}%
 7299         \lthtmlTightVBoxA{#1}{\let\@eqnnum\relax#2}\lthtmlTightVBoxZ}
 7300     \long\def\lthtmlfigureA#1{\let\@savefreelist\@freelist
 7301         \lthtmlTightFBoxA{#1}}
 7302     \long\def\lthtmlfigureZ{
 7303         \lthtmlTightFBoxZ\global\let\@freelist\@savefreelist}
 7304     \long\def\lthtmlpictureA#1{\let\@savefreelist\@freelist
 7305         \lthtmlTightVBoxA{#1}}
 7306     \long\def\lthtmlpictureZ{
 7307         \lthtmlTightVBoxZ\global\let\@freelist\@savefreelist}
 7308 </dvipng>
 7309     "\\newcommand\\lthtmlhboxmathA{\\adjustnormalsize\\setbox\\sizebox=\\hbox\\bgroup\\kern.05em }%\n" .
 7310     "\\newcommand\\lthtmlhboxmathB{\\adjustnormalsize\\setbox\\sizebox=\\hbox to\\hsize\\bgroup\\hfill }%\n" .
 7311     "\\newcommand\\lthtmlvboxmathA{\\adjustnormalsize\\setbox\\sizebox=\\vbox\\bgroup %\n".
 7312     " \\let\\ifinner=\\iffalse \\let\\)\\liih\@math }%\n" .
 7313     "\\newcommand\\lthtmlboxmathZ{\\\@next\\next\\\@currlist{}{\\def\\next{\\voidb\@x}}%\n" .
 7314 #    " \\expandafter\\box\\next\\edef\\next{\\egroup\\def\\noexpand\\thiseqn{\\theequation}}\\next}%\n" .
 7315     " \\expandafter\\box\\next\\egroup}%\n" .
 7316     "\\newcommand\\lthtmlmathtype[1]{\\gdef\\lthtmlmathenv{#1}}%\n" .
 7317     "\\newcommand\\lthtmllogmath{\\dimen0\\ht\\sizebox \\advance\\dimen0\\dp\\sizebox\n" .
 7318     "  \\ifdim\\dimen0>.95\\vsize\n" .  "   \\lthtmltypeout{%\n" .
 7319     "*** image for \\lthtmlmathenv\\space is too tall at \\the\\dimen0, reducing to .95 vsize ***}%\n" .
 7320     "   \\ht\\sizebox.95\\vsize \\dp\\sizebox\\z\@ \\fi\n" .  "  \\lthtmltypeout{l2hSize %\n" .
 7321     ":\\lthtmlmathenv:\\the\\ht\\sizebox::\\the\\dp\\sizebox::\\the\\wd\\sizebox.\\preveqno}}%\n" .
 7322     "\\newcommand\\lthtmlfigureA[1]{\\let\\\@savefreelist\\\@freelist
 7323        \\lthtmlmathtype{#1}\\lthtmlvboxmathA}%\n" .
 7324     "\\newcommand\\lthtmlpictureA{\\bgroup\\catcode`\\_=8 \\lthtmlpictureB}%\n" . 
 7325     "\\newcommand\\lthtmlpictureB[1]{\\lthtmlmathtype{#1}\\egroup
 7326        \\let\\\@savefreelist\\\@freelist \\lthtmlhboxmathB}%\n" .
 7327     "\\newcommand\\lthtmlpictureZ[1]{\\hfill\\lthtmlfigureZ}%\n" .
 7328     "\\newcommand\\lthtmlfigureZ{\\lthtmlboxmathZ\\lthtmllogmath\\copy\\sizebox
 7329        \\global\\let\\\@freelist\\\@savefreelist}%\n" .
 7330     "\\newcommand\\lthtmldisplayA{\\bgroup\\catcode`\\_=8 \\lthtmldisplayAi}%\n" .
 7331     "\\newcommand\\lthtmldisplayAi[1]{\\lthtmlmathtype{#1}\\egroup\\lthtmlvboxmathA}%\n" .
 7332     "\\newcommand\\lthtmldisplayB[1]{\\edef\\preveqno{(\\theequation)}%\n" .
 7333     "  \\lthtmldisplayA{#1}\\let\\\@eqnnum\\relax}%\n" .
 7334     "\\newcommand\\lthtmldisplayZ{\\lthtmlboxmathZ\\lthtmllogmath\\lthtmlsetmath}%\n" .
 7335     "\\newcommand\\lthtmlinlinemathA{\\bgroup\\catcode`\\_=8 \\lthtmlinlinemathB}\n" .
 7336     "\\newcommand\\lthtmlinlinemathB[1]{\\lthtmlmathtype{#1}\\egroup\\lthtmlhboxmathA\n" .
 7337     "  \\vrule height1.5ex width0pt }%\n" .
 7338     "\\newcommand\\lthtmlinlineA{\\bgroup\\catcode`\\_=8 \\lthtmlinlineB}%\n" .
 7339     "\\newcommand\\lthtmlinlineB[1]{\\lthtmlmathtype{#1}\\egroup\\lthtmlhboxmathA}%\n" .
 7340     "\\newcommand\\lthtmlinlineZ{\\egroup\\expandafter\\ifdim\\dp\\sizebox>0pt %\n" .
 7341     "  \\expandafter\\centerinlinemath\\fi\\lthtmllogmath\\lthtmlsetinline}\n" .
 7342     "\\newcommand\\lthtmlinlinemathZ{\\egroup\\expandafter\\ifdim\\dp\\sizebox>0pt %\n" .
 7343     "  \\expandafter\\centerinlinemath\\fi\\lthtmllogmath\\lthtmlsetmath}\n" .
 7344     "\\newcommand\\lthtmlindisplaymathZ{\\egroup %\n" .
 7345     "  \\centerinlinemath\\lthtmllogmath\\lthtmlsetmath}\n" .
 7346     "\\def\\lthtmlsetinline{\\hbox{\\vrule width.1em \\vtop{\\vbox{%\n" .
 7347     "  \\kern.1em\\copy\\sizebox}\\ifdim\\dp\\sizebox>0pt\\kern.1em\\else\\kern.3pt\\fi\n" .
 7348     "  \\ifdim\\hsize>\\wd\\sizebox \\hrule depth1pt\\fi}}}\n" .
 7349     "\\def\\lthtmlsetmath{\\hbox{\\vrule width.1em\\kern-.05em\\vtop{\\vbox{%\n" .
 7350     "  \\kern.1em\\kern$kern pt\\hbox{\\hglue.17em\\copy\\sizebox\\hglue$kern pt}}\\kern.3pt%\n" .
 7351     "  \\ifdim\\dp\\sizebox>0pt\\kern.1em\\fi \\kern$kern pt%\n" .
 7352     "  \\ifdim\\hsize>\\wd\\sizebox \\hrule depth1pt\\fi}}}\n" .
 7353     "\\def\\centerinlinemath{%\n" . 
 7354     "  \\dimen1=\\ifdim\\ht\\sizebox<\\dp\\sizebox \\dp\\sizebox\\else\\ht\\sizebox\\fi\n" .
 7355     "  \\advance\\dimen1by.5pt \\vrule width0pt height\\dimen1 depth\\dimen1 \n".
 7356     " \\dp\\sizebox=\\dimen1\\ht\\sizebox=\\dimen1\\relax}\n\n") .
 7357     "\\def\\lthtmlcheckvsize{\\ifdim\\ht\\sizebox<\\vsize \n" .
 7358     "  \\ifdim\\wd\\sizebox<\\hsize\\expandafter\\hfill\\fi \\expandafter\\vfill\n" .
 7359     "  \\else\\expandafter\\vss\\fi}%\n" .
 7360     "\\providecommand{\\selectlanguage}[1]{}%\n" .
 7361 #    "\\def\\\@enddocumenthook{\\ifnum\\count0>1 \\ifvoid\\\@cclv\\penalty-\\\@MM\\fi\\fi}\n" .
 7362     "\\makeatletter \\tracingstats = 1 \n"
 7363     . ($itrans_loaded ? $itrans_tex_mod : '')
 7364     . $LaTeXmacros . "\n"  # macros defined in extension files
 7365 #    "\\usepackage{lthimages}\n" .
 7366     . (($LATEX_DUMP)? "\\latexdump\n" : '')
 7367     . "\n\\begin{document}\n" .
 7368     "\\pagestyle{empty}\\thispagestyle{empty}\\lthtmltypeout{}%\n" .
 7369     "\\lthtmltypeout{latex2htmlLength hsize=\\the\\hsize}\\lthtmltypeout{}%\n" .
 7370     "\\lthtmltypeout{latex2htmlLength vsize=\\the\\vsize}\\lthtmltypeout{}%\n" .
 7371     "\\lthtmltypeout{latex2htmlLength hoffset=\\the\\hoffset}\\lthtmltypeout{}%\n" .
 7372     "\\lthtmltypeout{latex2htmlLength voffset=\\the\\voffset}\\lthtmltypeout{}%\n" .
 7373     "\\lthtmltypeout{latex2htmlLength topmargin=\\the\\topmargin}\\lthtmltypeout{}%\n" .
 7374     "\\lthtmltypeout{latex2htmlLength topskip=\\the\\topskip}\\lthtmltypeout{}%\n" .
 7375     "\\lthtmltypeout{latex2htmlLength headheight=\\the\\headheight}\\lthtmltypeout{}%\n" .
 7376     "\\lthtmltypeout{latex2htmlLength headsep=\\the\\headsep}\\lthtmltypeout{}%\n" .
 7377     "\\lthtmltypeout{latex2htmlLength parskip=\\the\\parskip}\\lthtmltypeout{}%\n" .
 7378     "\\lthtmltypeout{latex2htmlLength oddsidemargin=\\the\\oddsidemargin}\\lthtmltypeout{}%\n" .
 7379     "\\makeatletter\n" .
 7380     "\\if\@twoside\\lthtmltypeout{latex2htmlLength evensidemargin=\\the\\evensidemargin}%\n" .
 7381     "\\else\\lthtmltypeout{latex2htmlLength evensidemargin=\\the\\oddsidemargin}\\fi%\n" .
 7382     "\\lthtmltypeout{}%\n" .
 7383     "\\makeatother\n\\setcounter{page}{1}\n\\onecolumn\n\n% !!! IMAGES START HERE !!!\n\n"
 7384     . "$contents\n"
 7385 #    "\\clearpage\n" .
 7386     . "\\end{document}";
 7387 }
 7388 
 7389 # This routine sets some lengths in images.tex, but it no longer sets
 7390 # the textwidth.  We let latex do that natively, for example if the
 7391 # input uses the geometry package.
 7392 sub adjust_textwidth {
 7393     local($_) = @_;
 7394     local($width,$length) = ('','');
 7395     if (/a4/) {$width = 595; $length= 842; }
 7396     elsif (/letter/) {$width = 612; $length= 792; }
 7397     elsif (/legal/) {$width = 612; $length= 1008; }
 7398     elsif (/note/) {$width = 540; $length= 720; }
 7399     elsif (/b5/) {$width = 501; $length= 709; }
 7400     elsif (/a5/) {$width = 421; $length= 595; }
 7401     elsif (/a6/) {$width = 297; $length= 421; }
 7402     elsif (/a7/) {$width = 210; $length= 297; }
 7403     elsif (/a8/) {$width = 148; $length= 210; }
 7404     elsif (/a9/) {$width = 105; $length= 148; }
 7405     elsif (/a10/) {$width = 74; $length= 105; }
 7406     elsif (/b4/) {$width = 709; $length= 1002; }
 7407     elsif (/a3/) {$width = 842; $length= 1190; }
 7408     elsif (/b3/) {$width = 1002; $length= 1418; }
 7409     elsif (/a2/) {$width = 1190; $length= 1684; }
 7410     elsif (/b2/) {$width = 1418; $length= 2004; }
 7411     elsif (/a1/) {$width = 1684; $length= 2380; }
 7412     elsif (/b1/) {$width = 2004; $length= 2836; }
 7413     elsif (/a0/) {$width = 2380; $length= 3368; }
 7414     elsif (/b0/) {$width = 2836; $length= 4013; }
 7415     else {
 7416 	&write_warnings("\nPAPERSIZE: $_ unknown, using LaTeX's size.");
 7417 	return();
 7418      }
 7419     if ($width > 500) { $width = $width - 144; $length = $length - 288; }
 7420     elsif ($width > 250) { $width = $width - 72; $length = $length - 144; }
 7421     elsif ($width > 125) { $width = $width - 36; $length = $length - 72; }
 7422 #    "\\setlength{\\oddsidemargin}{0pt}\n" .
 7423 #    "\\setlength{\\evensidemargin}{0pt}\n" .
 7424 #    "\\setlength{\\parskip}{0pt}\\setlength{\\topskip}{0pt}\n" .
 7425     "\\setlength{\\hoffset}{0pt}\\setlength{\\voffset}{0pt}\n" .
 7426     "\\addtolength{\\textheight}{\\footskip}\\setlength{\\footskip}{0pt}\n" .
 7427     "\\addtolength{\\textheight}{\\topmargin}\\setlength{\\topmargin}{0pt}\n" .
 7428     "\\addtolength{\\textheight}{\\headheight}\\setlength{\\headheight}{0pt}\n" .
 7429     "\\addtolength{\\textheight}{\\headsep}\\setlength{\\headsep}{0pt}\n" .
 7430 #    "\\setlength{\\textwidth}{${width}pt}\n" .
 7431     (($length > 500) ? "\\setlength{\\textheight}{${length}pt}\n" : '')
 7432 }
 7433 
 7434 # Given the depth of the current sectioning declaration and the current
 7435 # section numbers it returns the new section numbers.
 7436 # It increments the $depth-ieth element of the @curr_sec_id list and
 7437 # 0's the elements after the $depth-ieth element.
 7438 sub new_level {
 7439     local($depth, @curr_sec_id) = @_;
 7440     $depth = $section_commands{$outermost_level} unless $depth;
 7441     local($i) = 0;
 7442     grep( do { if ($i == $depth) {$_++ ;}
 7443 	       elsif ($i > $depth) {$_ = 0 ;};
 7444 	       $i++;
 7445 	       0;
 7446 	   },
 7447 	 @curr_sec_id);
 7448     @curr_sec_id;
 7449 }
 7450 
 7451 sub make_head_and_body {
 7452     local($title,$body,$before_body) = @_;
 7453     local($version,$isolanguage) = ($HTML_VERSION, 'EN');
 7454     local(%isolanguages) = (  'english',  'EN'   , 'USenglish', 'EN-US'
 7455 			    , 'original', 'EN'   , 'german'   , 'DE'
 7456 			    , 'austrian', 'DE-AT', 'french'   , 'FR'
 7457 			    , 'spanish',  'ES', russian=>'RU'
 7458 			    , %isolanguages );
 7459 #    $isolanguage = $isolanguages{$default_language};  # DTD is in EN
 7460     $isolanguage = 'EN' unless $isolanguage;
 7461 #JCL(jcl-tcl)
 7462 # clean title as necessary
 7463 # the first words ... is a kludge, but reasonable (or not?) 
 7464 #RRM: why bother? --- as long as it is pure text.
 7465     $title = &purify($title,1);
 7466     eval("\$title = ". $default_title ) unless ($title);
 7467 #    $title = &get_first_words($title, $WORDS_IN_NAVIGATION_PANEL_TITLES);
 7468 
 7469     # allow user-modification of the <TITLE> tag; thanks Dan Young
 7470     if (defined &custom_TITLE_hook) {
 7471 	$title = &custom_TITLE_hook($title, $toc_sec_title);
 7472     }
 7473 
 7474     if (!defined $DTDcomment) {
 7475 	if ($DOCTYPE =~ /\/\/[\w\.]+\s*$/) { # language spec included
 7476 	    $DTDcomment = '<!DOCTYPE HTML PUBLIC "'. $DOCTYPE .'"';
 7477 	} else {
 7478 	    $DTDcomment = '<!DOCTYPE HTML PUBLIC "'. $DOCTYPE .'//'
 7479 					     . ($ISO_LANGUAGE ? $ISO_LANGUAGE : $isolanguage) . '"'
 7480 	}
 7481 	$DTDcomment .= ($PUBLIC_REF ? "\n  \"".$PUBLIC_REF.'"' : '' ) . '>'."\n";
 7482     }
 7483     $STYLESHEET = $FILE.".css" unless defined($STYLESHEET);
 7484 
 7485     my ($this_charset) = $charset;
 7486     if ($USE_UTF) { $charset = $utf8_str; $NO_UTF = ''; }
 7487     if (!$charset && $CHARSET) {
 7488 	$this_charset = $CHARSET;
 7489 	$this_charset =~ s/_/\-/go;
 7490     }
 7491     if ($NO_UTF && $charset =~/utf/) {
 7492 	$this_charset = $PREV_CHARSET||$CHARSET; 
 7493 	$this_charset =~ s/_/\-/go;
 7494     }
 7495 
 7496     join("\n", (($DOCTYPE)? $DTDcomment : '' )
 7497 	,"<!--Converted with LaTeX2HTML $TEX2HTMLVERSION"
 7498 	    . " -->\n<HTML lang=\"". ($ISO_LANGUAGE ? $ISO_LANGUAGE : $isolanguage)
 7499 	 . "\">\n<HEAD>\n<TITLE>".$title."</TITLE>"
 7500 	, &meta_information($title)
 7501 	,  ($CHARSET && $HTML_VERSION ge "2.1" ? 
 7502 	      "<META HTTP-EQUIV=\"Content-Type\" CONTENT=\"text/html; charset=$this_charset\">" 
 7503 	    : "" )
 7504         , "<META NAME=\"viewport\" CONTENT=\"width=device-width, initial-scale=1.0\">"
 7505 	, $LATEX2HTML_META
 7506 	, ($BASE ? "<BASE HREF=\"$BASE\">" : "" )
 7507 	, $STYLESHEET_CASCADE
 7508 	, ($STYLESHEET ? "<LINK REL=\"STYLESHEET\" HREF=\"$STYLESHEET\">" : '' )
 7509 	, $more_links_mark
 7510 	, "</HEAD>" , ($before_body? $before_body : '')
 7511 	, "<BODY $body>", '');
 7512 }
 7513 
 7514 
 7515 sub style_sheet {
 7516     local($env,$id,$style);
 7517     #AXR:  don't overwrite existing .css
 7518     #MRO: This is supposed to be $FILE.css, no?
 7519     #RRM: only by default, others can be specified as well, via $EXTERNAL_STYLESHEET
 7520     #return if (-f $EXTERNAL_STYLESHEET);
 7521     return if (-r "$FILE.css" && -s _ && !$REFRESH_STYLES );
 7522 
 7523     unless(open(STYLESHEET, ">$FILE.css")) {
 7524         print "\nError: Cannot write '$FILE.css': $!\n";
 7525         return;
 7526     }
 7527     if ( -f $EXTERNAL_STYLESHEET ) {
 7528         if(open(EXT_STYLES, "<$EXTERNAL_STYLESHEET")) {
 7529             while (<EXT_STYLES>) { print STYLESHEET $_; }
 7530             close(EXT_STYLES);
 7531         } else {
 7532             print "\nError: Cannot read '$EXTERNAL_STYLESHEET': $!\n";
 7533         }
 7534     } else {
 7535 	print STYLESHEET <<"EOF"
 7536 /* Century Schoolbook font is very similar to Computer Modern Math: cmmi */
 7537 .MATH    { font-family: \"Century Schoolbook\", serif; }
 7538 .MATH I  { font-family: \"Century Schoolbook\", serif; font-style: italic }
 7539 .BOLDMATH { font-family: \"Century Schoolbook\", serif; font-weight: bold }
 7540 SPAN.MATH { display:inline-block; }	/* don't stretch spaces inside eqn */
 7541 
 7542 DIV.author_info { text-align:center; } /* latex centers author */
 7543 
 7544 .LEFT    { text-align:left; }
 7545 .FLOATLEFT    { float:left; }
 7546 .CENTER  { text-align:center; }
 7547 .CENTER > * { margin:auto; }
 7548 .RIGHT   { text-align:right; }
 7549 .FLOATRIGHT   { float:right; }
 7550 .TOP     { vertical-align:top; }
 7551 .MIDDLE  { vertical-align:middle; }
 7552 .BOTTOM  { vertical-align:bottom; }
 7553 
 7554 IMG.LEFT    { float:left; }
 7555 IMG.RIGHT   { float:right; }
 7556 IMG.TOP     { vertical-align:top; }
 7557 IMG.BOTTOM  { vertical-align:baseline; }
 7558 
 7559 /* captions for latex tables and figures appear at bottom */
 7560 CAPTION { caption-side:bottom; }
 7561 
 7562 DL.COMPACT > dt { float:left; padding-right: 1em; }
 7563 BODY { width:95%; max-width:50em; margin:auto; }
 7564 
 7565 /* implement both fixed-size and relative sizes */
 7566 .XTINY		{ font-size : xx-small }
 7567 .TINY		{ font-size : x-small  }
 7568 .SCRIPTSIZE	{ font-size : smaller  }
 7569 .FOOTNOTESIZE	{ font-size : small    }
 7570 .SMALL		{ font-size : small    }
 7571 .LARGE		{ font-size : large }
 7572 .XLARGE		{ font-size : large    }
 7573 .XXLARGE		{ font-size : x-large  }
 7574 .HUGE		{ font-size : larger   }
 7575 .XHUGE		{ font-size : xx-large }
 7576 
 7577 /* heading styles */
 7578 H1		{  }
 7579 H2		{  }
 7580 H3		{  }
 7581 H4		{  }
 7582 H5		{  }
 7583 
 7584 /* mathematics styles */
 7585 DIV.displaymath { text-align:center; margin-top:1em; margin-bottom:1em; }
 7586 	/* math displays: margins for \\abovedisplayskip \\belowdisplayskip */
 7587 TD.eqno			{ width:0; }	/* equation-number cells */
 7588 TABLE.PAD TD	{ padding:3px; }
 7589 TABLE.BORDER TD	{ border:1px solid black; }
 7590 TABLE.equation	{ width:100%; }	/* place eq nos at right/left edge */
 7591 TABLE.equation > *	{ vertical-align:baseline; }
 7592 TABLE.equation TD	{ white-space:nowrap; padding-bottom:5px; }
 7593 TABLE		{ border-collapse: collapse; }
 7594 
 7595 /* document-specific styles come next */
 7596 EOF
 7597     }
 7598     print "\n *** Adding document-specific styles *** ";
 7599     for $env (sort keys %env_style) {
 7600         $style = $env_style{$env};
 7601         if ($env =~ /\./) {
 7602             $env =~ s/\.$//;
 7603             print STYLESHEET "$env\t\t{ $style }\n";
 7604         } elsif ($env =~ /inline|^(text|math)?((tt|rm|sf)(family)?|(up|it|sl|sc)(shape)?|(bf|md)(series)?|normal(font)?)$/) {
 7605             print STYLESHEET "SPAN.$env\t\t{ $style }\n";
 7606         } elsif ($env =~ /\./) {
 7607             print STYLESHEET "$env\t\t{ $style }\n";
 7608         } elsif ($env =~ /^(preform|lstlisting|\w*[Vv]erbatim(star)?)$/) {
 7609             print STYLESHEET "PRE.$env\t\t{ $style }\n";
 7610         } elsif ($env =~ /figure|table|tabular|equation|$array_env_rx/) {
 7611             print STYLESHEET "TABLE.$env\t\t{ $style }\n";
 7612         } else {
 7613             print STYLESHEET "DIV.$env\t\t{ $style }\n";
 7614         }
 7615     }
 7616     for $env (sort keys %txt_style) {
 7617         $style = $txt_style{$env};
 7618         print STYLESHEET "SPAN.$env\t\t{ $style }\n";
 7619     }
 7620     for $env (sort keys %img_style) {
 7621         $style = $img_style{$env};
 7622         print STYLESHEET "IMG.$env\t\t{ $style }\n";
 7623     }
 7624 
 7625     my ($style);
 7626     foreach $id (sort(keys  %styleID)) {
 7627         $style =  $styleID{$id};
 7628         $style =~ s/font-(color)/$1/;
 7629         print STYLESHEET "\#$id\t\t{ $style }\n"
 7630             if ($styleID{$id} ne '');
 7631     }
 7632     close(STYLESHEET);
 7633 }
 7634 
 7635 sub clear_styleID {
 7636     return unless ($USING_STYLES);
 7637     local($env_id,$id) = ("grp", @_); 
 7638     undef $styleID{$env_id} if ($id =~ /^\d+$/);
 7639 }
 7640 
 7641 sub make_address { 
 7642     local($addr) = &make_real_address(@_);
 7643     $addr .= "\n</BODY>\n</HTML>\n";
 7644     &lowercase_tags($addr) if $LOWER_CASE_TAGS;
 7645     $addr;
 7646 }
 7647 
 7648 sub make_real_address {
 7649     local($addr) = $ADDRESS;
 7650     if ((defined &custom_address)&&($addr)) {
 7651 	&custom_address($addr)
 7652     } elsif ($addr) {
 7653 	"<ADDRESS>\n$addr\n</ADDRESS>";
 7654     } else { '' }
 7655 }
 7656 
 7657 sub purify_caption {
 7658     local($_) = @_;
 7659     local($text) = &recover_image_code($_);
 7660     $text =~ s/\\protect|ALT\=|%EQNO:\d+//g;
 7661     $text =~ s/[\\\#\'\"\`]//g;
 7662     $text;
 7663 }
 7664 
 7665 sub recover_image_code {
 7666     local($key) = @_;
 7667     local($text) = $img_params{$key};
 7668     if (!$text) {
 7669 	if ($text = $id_map{$key}) {
 7670 	    if ($orig_name_map{$text}) {
 7671 		$text = $img_params{$orig_name_map{$text}}
 7672 	    }
 7673 	} elsif ($cached_env_img{$key}) {
 7674 	    $text = $img_params{$cached_env_img{$key}};
 7675 	}
 7676 	if ($text =~ /\#*ALT="([^"]+)"(>|#)/s) { $text = $1 }
 7677     }
 7678     $text =~ s/\\protect|%EQNO:\d+//g;
 7679     $text =~ s/&(gt|lt|amp|quot);/&special_html_inv($1)/eg;
 7680     $text;
 7681 }
 7682 
 7683 sub encode_title {
 7684     local($_) = @_;
 7685     $_ = &encode($_);
 7686     while (/(<[^<>]*>)/o) {s/$1//g}; # Remove HTML tags
 7687     s/#[^#]*#//g;               # Remove #-delimited markers
 7688     $_;
 7689 }
 7690 
 7691 # Encodes the contents of enviroments that are passed to latex. The code
 7692 # is then used as key to a hash table pointing to the URL of the resulting
 7693 # picture.  Returns "" if contents are too long.  Long keys do not work with
 7694 # some DBM modules, and are unlikely to reappear verbatim in the latex files.
 7695 sub encode {
 7696     local($_) = @_;
 7697     # Remove invocation-specific stuff
 7698     1 while(s/\\(begin|end)\s*(($O|$OP)\d+($C|$CP))?|{?tex2html_(wrap|nowrap|deferred|)(_\w+)?}?(\2)?//go);
 7699     $_ = &revert_to_raw_tex($_);
 7700     s/\\protect//g;		# remove redundant \protect macros
 7701     #$_ = pack("u*", $_);	# uuencode
 7702     s/\\\$/dollar/g;		# replace funnies, may cause problems in a hash key
 7703     s/\//slash/g;		# replace funnies, may cause problems in a hash key
 7704     s/\$|\/|\\//g;		# remove funnies, may cause problems in a hash key
 7705     s/\s*|\n//g;		# Remove spaces  and newlines
 7706     if (length($_) > 160) {
 7707 	"";			# no caching for long environments
 7708     } else {
 7709 	$_;
 7710     }
 7711 }
 7712 
 7713 
 7714 ##################### Hypertext Section Links ########################
 7715 sub post_process {
 7716     # Put hyperlinks between sections, add HTML headers and addresses,
 7717     # do cross references and citations.
 7718     # Uses the %section_info array created in sub translate.
 7719     # Binds the global variables
 7720     # $PREVIOUS, $PREVIOUS_TITLE
 7721     # $NEXT, $NEXT_TITLE
 7722     # $UP, $UP_TITLE
 7723     # $CONTENTS, $CONTENTS_TITLE 
 7724     # $INDEX, $INDEX_TITLE
 7725     # $NEXT_GROUP, $NEXT_GROUP_TITLE
 7726     # $PREVIOUS_GROUP, $PREVIOUS_GROUP_TITLE
 7727     # Converting to and from lists and strings is very inefficient.
 7728     # Maybe proper lists of lists should be used (or wait for Perl5?)
 7729     # JKR:  Now using top_navigation and bot_navigation instead of navigation
 7730     local($_, $key, $depth, $file, $title, $header, @link, @old_link,
 7731 	  $top_navigation, $bot_navigation, @keys,
 7732 	  @tmp_keys, $flag, $child_links, $body, $more_links);
 7733 
 7734     @tmp_keys = @keys = sort numerically keys %section_info;
 7735     print "\nDoing section links ...";
 7736     while (@tmp_keys) {
 7737 	$key = shift @tmp_keys;
 7738 	next if ($MULTIPLE_FILES &&!($key =~ /^$THIS_FILE/));
 7739 	print ".";
 7740 	$more_links = "";
 7741 	($depth, $file, $title, $body) = split($delim,$section_info{$key});
 7742 	print STDOUT "\n$key $file $title $body" if ($VERBOSITY > 3);
 7743 	next if ($body =~ /external/);
 7744 	$PREVIOUS = $PREVIOUS_TITLE = $NEXT = $NEXT_TITLE = $UP = $UP_TITLE
 7745 	    = $CONTENTS = $CONTENTS_TITLE = $INDEX = $INDEX_TITLE
 7746 	    = $NEXT_GROUP = $NEXT_GROUP_TITLE
 7747 	    = $PREVIOUS_GROUP = $PREVIOUS_GROUP_TITLE
 7748 	    = $_ = $top_navigation = $bot_navigation = undef;
 7749 	&add_link_tag('previous',$file);
 7750 	@link =  split(' ',$key);
 7751         ($PREVIOUS, $PREVIOUS_TITLE) =
 7752 	    &add_link($previous_page_visible_mark,$file,@old_link);
 7753 	@old_link = @link;
 7754 	unless ($done{$file}) {
 7755 	    ++$link[$depth];
 7756 #	    if ($MULTIPLE_FILES && !$depth && $multiple_toc ) {
 7757 #	    	local($save_depth) = $link[$depth];
 7758 #	    	$link[$depth] = 1;
 7759 #		($NEXT_GROUP, $NEXT_GROUP_TITLE) =
 7760 #		    &add_link($next_visible_mark, $file, @link);
 7761 #		&add_link_tag('next', $file, @link);
 7762 #		$link[$depth] = $save_depth;
 7763 #	    } else {
 7764 		($NEXT_GROUP, $NEXT_GROUP_TITLE) =
 7765 		    &add_link($next_visible_mark, $file, @link);
 7766 		&add_link_tag('next', $file, @link);
 7767 #	    }
 7768 
 7769 	    $link[$depth]--;$link[$depth]--;
 7770 	    if ($MULTIPLE_FILES && !$depth ) {
 7771 	    } else {
 7772 		($PREVIOUS_GROUP, $PREVIOUS_GROUP_TITLE) =
 7773 		    &add_link($previous_visible_mark, $file,@link);
 7774 		&add_link_tag('previous', $file,@link);
 7775 	    }
 7776 
 7777 	    $link[$depth] = 0;
 7778 	    ($UP, $UP_TITLE) =
 7779 		&add_link($up_visible_mark, $file, @link);
 7780 
 7781 	    if ($CONTENTS_IN_NAVIGATION) {
 7782 		($CONTENTS, $CONTENTS_LINK) = 
 7783 		    &add_special_link($contents_visible_mark, $tocfile, $file);
 7784 		&add_link_tag('contents', $file, $delim.$tocfile);
 7785 	    }
 7786 
 7787 	    if ($INDEX_IN_NAVIGATION) {
 7788 		($INDEX, $INDEX_LINK) = 
 7789 		    &add_special_link($index_visible_mark, $idxfile, $file);
 7790 		&add_link_tag('index', $file, $delim.$idxfile,);
 7791 	    }
 7792 
 7793 	    @link = split(' ',$tmp_keys[0]);
 7794 	    # the required `next' link may be several sub-sections along
 7795 	    local($nextdepth,$nextfile,$nextkey,$nexttitle,$nextbody)=
 7796 	        ($depth,$file,$key,'','');
 7797 	    $nextkey = shift @tmp_keys;
 7798 	    ($nextdepth, $nextfile,$nexttitle,$nextbody) = split($delim,$section_info{$nextkey});
 7799 	    if (($nextdepth<$MAX_SPLIT_DEPTH)&&(!($nextbody=~/external/))) {
 7800 		($NEXT, $NEXT_TITLE) =
 7801 		    &add_link($next_page_visible_mark, $file, @link);
 7802 		&add_link_tag('next', $file, @link);
 7803 	    } else {
 7804 		($NEXT, $NEXT_TITLE) = ('','');
 7805 		$nextfile = $file;
 7806 	    }
 7807 	    if ((!$NEXT || $NEXT =~ /next_page_inactive_visible_mark/)&&(@tmp_keys)) {
 7808 		# the required `next' link may be several sub-sections along
 7809 		while ((@tmp_keys)&&(($MAX_SPLIT_DEPTH < $nextdepth+1)||($nextfile eq $file))) {
 7810 		    $nextkey = shift @tmp_keys;
 7811 		    ($nextdepth, $nextfile,$nexttitle,$nextbody) = split($delim,$section_info{$nextkey});
 7812 		    if ($nextbody =~ /external/) {
 7813 			$nextfile = $file;
 7814 			next;
 7815 		    };
 7816 		    print ",";
 7817 		    print STDOUT "\n $nextkey" if ($VERBOSITY > 3);
 7818 		}
 7819 		@link = split(' ',$nextkey);
 7820 		if (($nextkey)&&($nextdepth<$MAX_SPLIT_DEPTH)) {
 7821 		    ($NEXT, $NEXT_TITLE) =
 7822 			&add_link($next_page_visible_mark, $file, @link);
 7823 		    &add_link_tag('next', $file, @link);
 7824 		} else {
 7825 		    ($NEXT, $NEXT_TITLE) = ($NEXT_GROUP, $NEXT_GROUP_TITLE);
 7826 		    $NEXT =~ s/next_page_(inactive_)?visible_mark/next_page_$1visible_mark/;
 7827 		    ($PREVIOUS, $PREVIOUS_TITLE) = ($PREVIOUS_GROUP, $PREVIOUS_GROUP_TITLE);
 7828 		    $PREVIOUS =~ s/previous_(inactive_)?visible_mark/previous_page_$1visible_mark/;
 7829 		}
 7830 	    }
 7831 	    unshift (@tmp_keys,$nextkey) if ($nextkey);
 7832 #
 7833 	    $top_navigation = (defined(&top_navigation_panel) ?
 7834 			       &top_navigation_panel : &navigation_panel)
 7835 		unless $NO_NAVIGATION || !$TOP_NAVIGATION;
 7836 	    $bot_navigation = (defined(&bot_navigation_panel) ?
 7837 			       &bot_navigation_panel : &navigation_panel)
 7838 		unless $NO_NAVIGATION;
 7839 	    local($end_navigation) = "\n<!--End of Navigation Panel-->\n";
 7840 	    if ($USING_STYLES) {
 7841 		$top_navigation = "\n".'<DIV CLASS="navigation">' . $top_navigation
 7842 			if $top_navigation;
 7843 		$bot_navigation = "\n".'<DIV CLASS="navigation">' . $bot_navigation
 7844 			if $bot_navigation;
 7845 		$end_navigation = '</DIV>' . $end_navigation;
 7846 		$env_style{'navigation'} = " ";
 7847 	    }
 7848 
 7849 	    $header = &make_head_and_body($title, $body);
 7850 	    $header = join('', $header, $top_navigation, $end_navigation) if ($top_navigation);
 7851 
 7852 	    local($this_file) = $file;
 7853 	    if ($MULTIPLE_FILES && $ROOTED) {
 7854 		if ($this_file =~ /\Q$dd\E([^$dd$dd]+)$/) { $this_file = $1 }
 7855 	    }
 7856 	    &slurp_input($this_file);
 7857 	    open(OUTFILE, ">$this_file")
 7858                 || die "\nError: Cannot write file '$this_file': $!\n";
 7859 
 7860 	    if (($INDEX) && ($SHORT_INDEX) && ($SEGMENT eq 1)) {
 7861 		&make_index_segment($title,$file); }
 7862 
 7863 	    local($child_star,$child_links);
 7864 	    local($CURRENT_FILE) = $this_file; # ensure $CURRENT_FILE is set correctly
 7865 	    if (/$childlinks_on_mark\#(\d)\#/) { $child_star = $1 }
 7866 	    $child_links = &add_child_links('',$file, $depth, $child_star,$key, @keys)
 7867 		unless (/$childlinks_null_mark\#(\d)\#/);
 7868 	    if (($child_links)&&(!/$childlinks_mark/)&&($MAX_SPLIT_DEPTH > 1)) {
 7869 		if ($depth < $MAX_SPLIT_DEPTH -1) {
 7870 		    $_ = join('', $header, $_, &child_line(), $childlinks_mark, "\#0\#" );
 7871 		} else {
 7872 		    $_ = join('', $header, "\n$childlinks_mark\#0\#", &upper_child_line(), $_ );
 7873 		}
 7874 	    } else {
 7875 		$_ = join('', $header, $_ );
 7876 	    }
 7877 	    $flag = (($BOTTOM_NAVIGATION || &auto_navigation) && $bot_navigation);
 7878 	    $_ .= $bot_navigation . $end_navigation if ($flag &&($bot_navigation));
 7879 	    $_ .= &child_line() unless $flag;
 7880 	    print STDOUT "\n *** replace markers *** " if ($VERBOSITY > 1);
 7881 	    &replace_markers;
 7882 	    print STDOUT "\n *** post-post-process *** " if ($VERBOSITY > 1);
 7883 	    &post_post_process if (defined &post_post_process);
 7884 	    &adjust_encoding;
 7885 	    print OUTFILE $_;
 7886 	    print OUTFILE &make_address;
 7887 	    close OUTFILE;
 7888 	    $done{$file}++;
 7889 	}
 7890     }
 7891     &post_process_footnotes if ($footfile);
 7892 }
 7893 
 7894 sub adjust_encoding {
 7895     &convert_to_utf8($_) if ($CHARSET eq 'utf-8' && !$NO_UTF);
 7896     &lowercase_tags($_) if $LOWER_CASE_TAGS;
 7897 }
 7898 
 7899 sub post_replace_markers {
 7900     # MRO: replaced $* with /m
 7901     # clean up starts and ends of  P, BR and DIV tags
 7902     s/(<\/?(P|BR|DIV)>)\s*(\w)/$1\n$3/gom unless ($file eq $citefile);
 7903     s/([^\s])(<(BR|DIV))/$1\n$2/gom unless ($file eq $citefile);
 7904     local($keep,$after);
 7905 
 7906     # anchor images when otherwise there is an invisible-anchor
 7907 #    s/(<A[^>]*>)\&\#160;<\/A>\s?(<(P|DIV)[^>]*>)\s*(<IMG[^>]*>)\s*(<\/(P|DIV)>)/
 7908     s/(<A[^>]*>)($anchor_mark|$anchor_invisible_mark)<\/A>\s?(<(P|DIV)[^>]*>)\s*(<IMG[^>]*>)\s*(<\/(P|DIV)>)/
 7909 	do{ $keep="$3$1$5<\/A>";
 7910 	    $after = $6;
 7911 	    join('',$keep, &after_punct_break($after), $after);
 7912 	} /egom;
 7913 
 7914     # absorb named anchor (e.g. from index-entry) into preceding or following anchor
 7915 #    s/(<A ID=\"[^\"]+\")>\&#160;<\/A>\s*\b?<A( HREF=\"[^\"]+\">)/$1$2/gom;
 7916 #    s/(<A HREF=\"[^\"]+\")(>\s*\b?([^<]+|<([^>\/]+|\/[^>A]+)>\s*)*<\/A>)\s*\b?<A( ID=\"[^\"]+\")>\&#160;<\/A>/$1$5$2/gom;
 7917 
 7918     # clean up empty table cells
 7919     s/(<TD[^>]*>)\s*(<\/TD>)/<TD>$2/gom;
 7920 
 7921     # clean up list items (only desirable in the bibliography ?)
 7922     # s/\n<P>(<DT[^>]*>)/\n<P><\/P>\n$1/gom;
 7923 
 7924     # remove blank lines and comment-markers
 7925 #    s/\n\n/\n/g;  # no, cause this kills intended ones in verbatims
 7926     s/$comment_mark(\d+\n?)?//gm;
 7927     s/\&quot;/"/gm;  # replace  &quot;  entities
 7928 
 7929     # italic \LaTeX looks bad
 7930     s:<(I|EM)>(($Laname|$AmSname)?$TeXname)</\1>:$2:gm;
 7931 }
 7932 
 7933 sub lowercase_tags {
 7934     # MRO: modified to use $_[0]
 7935     # local(*stream) = @_;
 7936     my ($tags,$attribs);
 7937     $_[0] =~ s!<(/?\w+)( [^>]*)?>!
 7938 	$tags = $1; $attribs = $2;
 7939 	$attribs =~ s/ ([\w\d-]+)(=| |$)/' '.lc($1).$2/eg;
 7940 	join('', '<', lc($tags) , $attribs , '>')!eg;
 7941 }
 7942 
 7943 sub after_punct_break {
 7944     # MRO: modified to use $_[0]
 7945     # local(*stream) = @_;
 7946 #    $stream =~ s/^([ \t]*)([,;\.\)\!\"\'\?])[ \t]*(\n)?/(($2)? "$2" : "$1")."\n"/em;
 7947 #    $stream;
 7948     $_[0] =~ s/^([ \t]*)([,;\.\)\!\"\'\?\>]|\&gt;)[ \t]*(\n)?//em;
 7949     ($2 ? $2 : $1)."\n";
 7950 }
 7951 
 7952 sub make_index_segment {
 7953     local($title,$file)= @_ ;
 7954 #JCL(jcl-tcl)
 7955 #    s/<[^>]*>//g;
 7956 #
 7957     $index_segment{$PREFIX} = "$title";
 7958     if (!($ref_files{"segment"."$PREFIX"} eq "$file")) {
 7959 	$ref_files{"segment"."$PREFIX"} = "$file";
 7960 	$changed = 1
 7961     }
 7962     $SEGMENT = 2;
 7963 }
 7964 
 7965 
 7966 sub add_link {
 7967     # Returns a pair (iconic link, textual link)
 7968     local($icon, $current_file, @link) = @_;
 7969     local($dummy, $file, $title, $lbody) = split($delim,$section_info{join(' ',@link)});
 7970     if ($lbody =~ /external/) { return ('','') };
 7971 
 7972 #    local($dummy, $file, $title) = split($delim,$toc_section_info{join(' ',@link)});
 7973 
 7974     if ($MULTIPLE_FILES && $ROOTED && $file) {
 7975         if (!($DESTDIR =~ /\Q$FIXEDDIR\E[$dd$dd]?$/)) { $file = "..$dd$file" }
 7976     }
 7977 #    if ($title && ($file ne $current_file || $icon ne $up_visible_mark)) {
 7978     if ($title && ($file ne $current_file)) {
 7979 	#RRM: allow user-customisation of the link-text; thanks Dan Young
 7980 	if (defined &custom_link_hook ) {
 7981 	    $title = &custom_link_hook($title,$toc_section_info{join(' ',@link)});
 7982 	} else {
 7983             $title = &purify($title);
 7984 	    $title = &get_first_words($title, $WORDS_IN_NAVIGATION_PANEL_TITLES+($SHOW_SECTION_NUMBERS?1:0));
 7985 	}
 7986 	return ("\n".&make_named_href('', $file, $icon),
 7987 		&make_named_href('', $file, "$title"))
 7988     }
 7989 #    elsif ($icon eq $up_visible_mark && $file eq $current_file && $EXTERNAL_UP_LINK) {
 7990     elsif ($icon eq $up_visible_mark && $EXTERNAL_UP_LINK) {
 7991 	return ("\n".&make_named_href('', $EXTERNAL_UP_LINK, $icon),
 7992 		&make_named_href('', $EXTERNAL_UP_LINK, "$EXTERNAL_UP_TITLE"))
 7993     }
 7994     elsif (($icon eq $previous_visible_mark || $icon eq $previous_page_visible_mark)
 7995     	&& $EXTERNAL_PREV_LINK && $EXTERNAL_PREV_TITLE) {
 7996 	return ("\n".&make_named_href('', $EXTERNAL_PREV_LINK, $icon),
 7997 		&make_named_href('', $EXTERNAL_PREV_LINK, "$EXTERNAL_PREV_TITLE"))
 7998     }
 7999     elsif (($icon eq $next_visible_mark ||  $icon eq $next_page_visible_mark)
 8000     	&& $EXTERNAL_DOWN_LINK && $EXTERNAL_DOWN_TITLE) {
 8001 	return ("\n".&make_named_href('', $EXTERNAL_DOWN_LINK, $icon),
 8002 		&make_named_href('', $EXTERNAL_DOWN_LINK, "$EXTERNAL_DOWN_TITLE"))
 8003     }
 8004     (&inactive_img($icon), "");
 8005 }
 8006 
 8007 sub add_special_link { &add_real_special_link(@_) }
 8008 sub add_real_special_link {
 8009     local($icon, $file, $current_file) = @_;
 8010     local($text);
 8011     if ($icon eq $contents_visible_mark) { $text = $toc_title }
 8012     elsif ($icon eq $index_visible_mark) { $text = $idx_title }
 8013     elsif ($icon eq $biblio_visible_mark) { $text = $bib_title }
 8014     (($file && ($file ne $current_file)) ? 
 8015     	("\n" . &make_href($file, $icon), 
 8016     	    ($text ? " ". &make_href($file, $text) : undef))
 8017     	: ( undef, undef ))
 8018 }
 8019 
 8020 #RRM: add <LINK ...> tag to the HTML head.
 8021 #     suggested by Marcus Hennecke
 8022 #
 8023 sub add_link_tag {
 8024     local($rel, $currentfile, @link ) = @_;
 8025 #    local($dummy, $file, $title) = split($delim,$toc_section_info{join(' ',@link)});
 8026     local($dummy, $file, $title) = split($delim,$section_info{join(' ',@link)});
 8027     ($dummy, $file, $title) = split($delim,$toc_section_info{join(' ',@link)})
 8028 	unless ($title);
 8029 
 8030     if ($MULTIPLE_FILES && $ROOTED && $file) {
 8031         if (!($DESTDIR =~ /\Q$FIXEDDIR\E[$dd$dd]?$/)) { $file = "..$dd$file" }
 8032     }
 8033     if ($file && !($file eq $currentfile) && (!$NO_NAVIGATION)) {
 8034 	#RRM: allow user-customisation of the REL attribute
 8035 	if (defined &custom_REL_hook ) {
 8036 	    $rel = &custom_REL_hook($rel,$toc_section_info{join(' ',@link)});
 8037 	}
 8038         $more_links .= "\n<LINK REL=\"$rel\" HREF=\"$file\">";
 8039     }
 8040 }
 8041 
 8042 sub remove_markers {
 8043 # modifies $_
 8044     s/$lof_mark//go;
 8045     s/$lot_mark//go;
 8046     &remove_bbl_marks;
 8047     s/$toc_mark//go;
 8048     s/$idx_mark//go;
 8049     &remove_cross_ref_marks;
 8050     &remove_external_ref_marks;
 8051     &remove_cite_marks;
 8052     &remove_file_marks;
 8053 # sensitive markers
 8054     &remove_image_marks;
 8055     &remove_icon_marks;
 8056     &remove_verbatim_marks;
 8057     &remove_verb_marks;
 8058     &remove_child_marks;
 8059 # uncaught markers
 8060     s/$percent_mark/%/go;
 8061     s/$ampersand_mark/\&amp;/go;
 8062     s/$comment_mark\s*(\d+\n?)?//sgo;
 8063     s/$caption_mark//go;
 8064     s/<tex2html[^>]*>//g;
 8065     s/$OP\d+\$CP//g;
 8066     $_;
 8067 }
 8068 
 8069 sub replace_markers {
 8070     &find_quote_ligatures;
 8071     &replace_general_markers;
 8072     &text_cleanup;
 8073     # Must NOT clean the ~'s out of the navigation icons (in panel or text),
 8074     # and must not interfere with verbatim-like environments
 8075     &replace_sensitive_markers;
 8076     &replace_init_file_mark if (/$init_file_mark/);
 8077     &replace_file_marks;
 8078     &post_replace_markers;
 8079 }
 8080 
 8081 sub replace_general_markers {
 8082     if (defined &replace_infopage_hook) {&replace_infopage_hook if (/$info_page_mark/);}
 8083     else { &replace_infopage if (/$info_page_mark/); }
 8084     if (defined &add_idx_hook) {&add_idx_hook if (/$idx_mark/);}
 8085     else {&add_idx if (/$idx_mark/);}
 8086 
 8087     if ($segment_figure_captions) {
 8088 #	s/$lof_mark/<UL>$segment_figure_captions<\/UL>/o
 8089 #   } else { s/$lof_mark/<UL>$figure_captions<\/UL>/o }
 8090 	s/$lof_mark/$segment_figure_captions/o
 8091     } else { s/$lof_mark/$figure_captions/o }
 8092     if ($segment_table_captions) {
 8093 #	s/$lot_mark/<UL>$segment_table_captions<\/UL>/o
 8094 #   } else { s/$lot_mark/<UL>$table_captions<\/UL>/o }
 8095 	s/$lot_mark/$segment_table_captions/o
 8096     } else { s/$lot_mark/$table_captions/o }
 8097     &replace_morelinks();
 8098     if (defined &replace_citations_hook) {&replace_citations_hook if /$bbl_mark/;}
 8099     else {&replace_bbl_marks if /$bbl_mark/;}
 8100     if (defined &add_toc_hook) {&add_toc_hook if (/$toc_mark/);}
 8101     else {&add_toc if (/$toc_mark/);}
 8102     if (defined &add_childs_hook) {&add_childs_hook if (/$childlinks_on_mark/);}
 8103     else {&add_childlinks if (/$childlinks_on_mark/);}
 8104     &remove_child_marks;
 8105 
 8106     if (defined &replace_cross_references_hook) {&replace_cross_references_hook;}
 8107     else {&replace_cross_ref_marks if /$cross_ref_mark||$cross_ref_visible_mark/;}
 8108     if (defined &replace_external_references_hook) {&replace_external_references_hook;}
 8109     else {&replace_external_ref_marks if /$external_ref_mark/;}
 8110     if (defined &replace_cite_references_hook) {&replace_cite_references_hook;}
 8111     else { &replace_cite_marks if /$cite_mark/; }
 8112     if (defined &replace_user_references) {
 8113  	&replace_user_references if /$user_ref_mark/; }
 8114 }
 8115 
 8116 sub replace_sensitive_markers {
 8117     if (defined &replace_images_hook) {&replace_images_hook;}
 8118     else {&replace_image_marks if /$image_mark/;}
 8119     if (defined &replace_icons_hook) {&replace_icons_hook;}
 8120     else {&replace_icon_marks if /$icon_mark_rx/;}
 8121     if (defined &replace_verbatim_hook) {&replace_verbatim_hook;}
 8122     else {&replace_verbatim_marks if /$verbatim_mark/;}
 8123     if (defined &replace_verb_hook) {&replace_verb_hook;}
 8124     else {&replace_verb_marks if /$verb_mark|$verbstar_mark|$verblst_mark/;}
 8125     s/;SPMdollar;/\$/g; s/;SPMtilde;/\~/g; s/;SPMpct;/\%/g;
 8126     s/;SPM/\&/go;
 8127     s/$percent_mark/%/go;
 8128     s/$ampersand_mark/\&amp;/go;
 8129     #JKR: Turn encoded ~ back to normal
 8130     s/&#126;/~/go;
 8131 }
 8132 
 8133 sub find_quote_ligatures {
 8134     my $ent;
 8135 
 8136 # guillemets, governed by $NO_FRENCH_QUOTES
 8137     do {
 8138 	$ent = &iso_map('laquo', "", 1);
 8139 	if ($NO_UTF && !$USE_UTF && $ent=~/\&\#(\d+);/) {
 8140 	    $ent='' if ($1 > 255);
 8141 	}
 8142 	s/((\&|;SPM)lt;){2}/$ent/ogs if $ent;
 8143 	$ent = &iso_map('raquo', "", 1) if ($ent);
 8144 	s/((\&|;SPM)gt;){2}/$ent/ogs if $ent;
 8145 	# single guillemot chars cannot be easily implemented this way
 8146 	# finding an approp regexp is work for the future
 8147     } unless ($NO_FRENCH_QUOTES);
 8148 
 8149     $ent = &iso_map("gg", "", 1);
 8150     s/;SPMgg;/($ent ? $ent : '&gt;&gt;')/eg unless ($USE_NAMED_ENTITIES);
 8151     $ent = &iso_map("ll", "", 1);
 8152     s/;SPMll;/($ent ? $ent : '&lt;&lt;')/eg unless ($USE_NAMED_ENTITIES);
 8153 
 8154     my $ldquo, $rdquo;
 8155 # "curly" quotes, governed by  $USE_CURLY_QUOTES.
 8156     do {
 8157 	$ldquo = &iso_map("ldquo", "", 1);
 8158 	if ($NO_UTF && !$USE_UTF && $ldquo =~ /\&\#(\d+);/) {
 8159 	    $ldquo = '' if ($1 > 255);
 8160 	}
 8161 	s/``/$ldquo/ogs if ($ldquo);
 8162 	$rdquo = &iso_map("rdquo", "", 1) if ($ldquo);
 8163 	s/''/$rdquo/ogs if ($rdquo);
 8164 	
 8165 	# single curly quotes cannot be easily implemented this way
 8166 	# finding an approp regexp is work for the future
 8167     } if ($USE_CURLY_QUOTES);
 8168 
 8169 # "german" quotes, governed by  $NO_GERMAN_QUOTES.
 8170     do {
 8171 	$ent = &iso_map('bdquo', "", 1);
 8172 	if ($NO_UTF && !$USE_UTF && $ent =~ /\&\#(\d+);/) {
 8173 	    $ent = '' if ($1 > 255);
 8174 	}
 8175 	s/,,/$ent/eg if $ent;
 8176 
 8177 	# closing upper quotes are not properly displayed in browsers
 8178 	s/($ent[\w\s\&\#;']+)$ldquo/$1``/og
 8179 		if ($USE_CURLY_QUOTES && $ldquo && $ent);
 8180     } unless ($NO_GERMAN_QUOTES);
 8181 }
 8182 
 8183 sub add_childlinks {
 8184     local($before, $after, $star);
 8185     while (/$childlinks_on_mark\#(\d)\#/) {
 8186 	$star = $1;
 8187 	$before = $`;
 8188 	$after = $';
 8189 	$before =~ s/\n\s*$//;
 8190 	$_ = join('', $before, "\n", $child_links, $after);
 8191     }
 8192 }
 8193 
 8194 sub replace_infopage {
 8195     local($INFO)=1 if !(defined $INFO);
 8196     if ($INFO == 1) {
 8197     	local($title);
 8198 	if ((defined &do_cmd_infopagename)||$new_command{'infopagename'}) {
 8199 	    local($br_id)=++$global{'max_id'};
 8200 	    $title = &translate_environments("$O$br_id$C\\infopagename$O$br_id$C");
 8201 	} else { $title = $info_title }
 8202 	    if ($MAX_SPLIT_DEPTH <= $section_commands{$outermost_level}) {
 8203 	        $_ =~ s/(<HR[^>]*>\s*)?$info_title_mark/
 8204 		    ($1? $1 : "\n<HR>")."\n<H2>$title<\/H2>"/eog;
 8205 	    } else {
 8206 	        $_ =~ s/$info_title_mark/"\n<H2>$title<\/H2>"/eog;
 8207 	    }
 8208     }
 8209     while (/$info_page_mark/o) {
 8210 	$_ = join('', $`, &do_cmd_textohtmlinfopage, $');
 8211     }
 8212 }
 8213 
 8214 sub replace_init_file_mark {
 8215     local($init_file, $init_contents, $info_line)=($INIT_FILE,'','');
 8216     if (-f $init_file) {
 8217     } elsif (-f "$orig_cwd$dd$init_file") {
 8218 	$init_file = $orig_cwd.$dd.$init_file;
 8219     } else {
 8220 	s/$init_file_mark//g;
 8221 	return();
 8222     }
 8223     if(open(INIT, "<$init_file")) {
 8224         foreach $info_line (<INIT>) {
 8225 	    $info_line =~ s/[<>"&]/'&'.$html_special_entities{$&}.';'/eg;
 8226 	    $init_contents .= $info_line;
 8227 	}
 8228         close INIT;
 8229     } else {
 8230         print "\nError: Cannot read '$init_file': $!\n";
 8231     }
 8232     s/$init_file_mark/\n<BLOCKQUOTE><PRE>\n$init_contents\n<\/PRE><\/BLOCKQUOTE>\n/g;
 8233 }
 8234 
 8235 sub replace_morelinks {
 8236     $_ =~ s/$more_links_mark/$more_links/e;
 8237 }
 8238 
 8239 # This code is extremely inefficient. At least the subtrees should be
 8240 # filtered according to $MAX_LINK_DEPTH before going into the
 8241 # inner loops.
 8242 # RRM: revamped parts, for $TOC_STARS, fixing some errors.
 8243 #
 8244 sub add_child_links { &add_real_child_links(@_) }
 8245 sub add_real_child_links {
 8246     local($exclude, $base_file, $depth, $star, $current_key, @keys) = @_;
 8247     local $min_depth = $section_commands{$outermost_level} - 1;
 8248     return ('') if ((!$exclude)&&(!$LEAF_LINKS)&&($depth >= $MAX_SPLIT_DEPTH));
 8249     if ((!$depth)&&($outermost_level)) { $depth = $min_depth }
 8250 
 8251     local($_, $child_rx, @subtree, $next, %open, @roottree);
 8252     local($first, $what, $pre, $change_key, $list_class);
 8253     $childlinks_start = "<!--Table of Child-Links-->";
 8254     $childlinks_end = "<!--End of Table of Child-Links-->\n";
 8255     $child_rx = $current_key;
 8256     $child_rx =~ s/( 0)*$//;	# Remove trailing 0's
 8257     if ((!$exclude)&&($depth < $MAX_SPLIT_DEPTH + $MAX_LINK_DEPTH -1 )
 8258 #	    &&($depth >= $MAX_SPLIT_DEPTH-1)) {
 8259 	    &&($depth > $min_depth)) {
 8260 	if ((defined &do_cmd_childlinksname)||$new_command{'childlinksname'}) {
 8261 	    local($br_id)=++$global{'max_id'};
 8262 	    $what = &translate_environments("$O$br_id$C\\childlinksname$O$br_id$C");
 8263 	} else {
 8264 	    $what = "<strong>$child_name</strong>";
 8265 	}
 8266 	$list_class = ' CLASS="ChildLinks"' if ($USING_STYLES);
 8267 	$first = "$childlinks_start\n<A ID=\"CHILD_LINKS\">$what<\/A>\n";
 8268     } elsif ($exclude) {
 8269 	# remove any surrounding braces
 8270 	$exclude =~ s/^($O|$OP)\d+($C|$CP)|($O|$OP)\d+($C|$CP)$//g;
 8271 	# Table-of-Contents
 8272 	$list_class = ' CLASS="TofC"' if ($USING_STYLES);
 8273 	$childlinks_start = "\n<!--Table of Contents-->\n";
 8274 	$childlinks_end = "<!--End of Table of Contents-->";
 8275 	$first = "$childlinks_start";
 8276     } else {
 8277 	$list_class = ' CLASS="ChildLinks"' if ($USING_STYLES);
 8278 	$first = "$childlinks_start\n"
 8279 	    . ($star ? '':"<A ID=\"CHILD_LINKS\">$anchor_mark<\/A>\n");
 8280     }
 8281     my $startlist, $endlist;
 8282     $startlist = "<UL$list_class>" unless $CHILD_NOLIST;
 8283     $endlist = '</UL>' unless $CHILD_NOLIST;
 8284     my $alt_item = '<BR>&nbsp;<BR>'."\n";
 8285     my $outer_item = ($CHILD_NOLIST ? $alt_item : '<LI>');
 8286     my $inner_item = '<LI>';
 8287     my $inner_end = '</UL><BR>';
 8288 
 8289     # collect the relevant keys...
 8290     foreach $next (@keys) {
 8291 	if ($MULTIPLE_FILES && $exclude) {
 8292 	    # ...all but with this document as the root
 8293 	    if ($next =~ /^$THIS_FILE /) {
 8294 #		# make current document the root
 8295 #	    	$change_key = '0 '.$';
 8296 		push(@roottree,$next);
 8297 		print "\n$next : m-root" if ($VERBOSITY > 3);
 8298 	    } else {
 8299 		push(@subtree,$next);
 8300 		print "\n$next : m-sub" if ($VERBOSITY > 3);
 8301 	    }
 8302 	} elsif (($next =~ /^$child_rx /)&&($next ne $current_key)) {
 8303 	# ...which start as $current_key
 8304 	    push(@subtree,$next);
 8305 	    print "\n$next : sub $child_rx" if ($VERBOSITY > 3);
 8306 	} else {
 8307 	    print "\n$next : out $current_key" if ($VERBOSITY > 3);
 8308 	}
 8309     }
 8310     if (@subtree) { @subtree = sort numerically @subtree; }
 8311     if (@roottree) {
 8312     	@roottree = sort numerically @roottree;
 8313     	@subtree = ( @roottree, @subtree );
 8314     }
 8315     # @subtree now contains the subtree rooted at the current node
 8316 
 8317     local($countUL); #counter to ensure correct tag matching
 8318     my $root_file, $href;
 8319     if (@subtree) {
 8320 	local($next_depth, $file, $title, $sec_title, $star, $ldepth,$this_file, $prev_file);
 8321 	$ldepth = $depth;
 8322 	$prev_file = $base_file;
 8323 #	@subtree = sort numerically @subtree;
 8324 	foreach $next (@subtree) {
 8325 	    $title = '';
 8326 	    if ($exclude) {
 8327 		# making TOC
 8328 		($next_depth, $file, $title, $star) =
 8329 			split($delim,$toc_section_info{$next});
 8330 		# use the %section_info  title, in case there are images
 8331 		$title = $sec_title if ($sec_title =~ /image_mark>\#/);
 8332 	    } else {
 8333 		# making mini-TOC i.e. the child-links tables
 8334 		$star = '';
 8335 		($next_depth, $file, $title) =
 8336 			split($delim,$section_info{$next});
 8337 	    }
 8338 	    $root_file = $file unless $root_file;
 8339 	    if ($root_file && $root_file =~ /_mn\./) { $root_file=$` };
 8340 	    # remove any surrounding braces
 8341 	    $title =~ s/^($O|$OP)\d+($C|$CP)|($O|$OP)\d+($C|$CP)$//g;
 8342 	    next if ($exclude && $title =~ /^$exclude$/);
 8343 	    if (!$title) {
 8344 		($next_depth, $file, $title, $star) =
 8345 			split($delim,$toc_section_info{$next});
 8346 	    }
 8347 	    $this_file = $file;
 8348 	    $title = "\n".$title if !($title =~/^\n/);
 8349 	    next if ( $exclude &&(				# doing Table-of-Contents
 8350 		( $TOC_DEPTH &&($next_depth > $TOC_DEPTH))	# and  too deep
 8351 		||($star && !$TOC_STARS ) ));			# or no starred sections 
 8352 	    $file = "" if (!$MAX_SPLIT_DEPTH); # Martin Wilck
 8353 	    next if ($exclude && !$MULTIPLE_FILES &&($title =~ /^\s*$exclude\s*$/));
 8354 	    next if (!$exclude && $next_depth > $MAX_LINK_DEPTH + $depth);
 8355 	    print "\n$next :" if ($VERBOSITY > 3);
 8356 	    if ($this_file =~ /^(\Q$prev_file\E|\Q$base_file\E)$/) {
 8357 		$file .= join('', "#SECTION", split(' ', $next));
 8358 	    } else { $prev_file = $file }
 8359 
 8360 	    if (!$next_depth && $MULTIPLE_FILES) { ++$next_depth }
 8361 	    local($num_open) = (split('/',%open))[0];
 8362 	    if ((($next_depth > $ldepth)||$first)
 8363 		&& ((split('/',%open))[0] < $MAX_LINK_DEPTH + $depth )
 8364 		) {
 8365 		# start a new <UL> list
 8366 		if ($first) {
 8367 		    $_ = "$first\n$startlist\n"; $countUL++;
 8368 		    local $i = 1;
 8369 		    while ($i <= $ldepth) {
 8370 			$open{$i}=0; $i++
 8371 		    }
 8372 		    $first = '';	# include NAME tag first time only
 8373 		    while ($i < $next_depth) {
 8374 			$open{$i}=1; $i++; 
 8375 			$_ .= ($countUL >1 ? $inner_item : $outer_item)."<UL>\n";
 8376 			$countUL++;
 8377 		    }
 8378 		} else {
 8379 		    $_ .= "<UL>\n"; $countUL++;
 8380 		}
 8381 		$ldepth = $next_depth;
 8382 		$open{$ldepth}++; 
 8383 		# append item to this list
 8384 		print " yes " if ($VERBOSITY > 3);
 8385 		if (defined &add_frame_child_links) {
 8386 		    $href = &make_href($file,$title);
 8387 		    if ($href =~ s/($root_file)_mn/$1_ct/) {
 8388 			$href =~ s/(target=")main(")/$1contents$2/i;
 8389 		    };
 8390 		    $_ .= ($countUL >1 ? $inner_item : $outer_item)
 8391 			. $href . "\n";
 8392 		} else {
 8393 		    $_ .= ($countUL >1 ? $inner_item : $outer_item)
 8394 			. &make_href($file,$title) . "\n";
 8395 		}
 8396 	    }
 8397 	    elsif (($next_depth)&&($next_depth <= $ldepth)
 8398 		&&((split('/',%open))[0] <= $MAX_LINK_DEPTH + $depth )
 8399 		) {
 8400 		# append item to existing <UL> list
 8401 		while (($next_depth < $ldepth) && %open ) {
 8402 		# ...closing-off any nested <UL> lists
 8403 		    if ($open{$ldepth}) {
 8404 			if (!(defined $open{$next_depth}))  {
 8405 			    $open{$next_depth}++;
 8406 			} else {
 8407 			    $_ .= ($countUL==2 ? $inner_end : '</UL>')."\n";
 8408 			    $countUL--;
 8409 			}
 8410 			delete $open{$ldepth};
 8411 		    };
 8412 		    $ldepth--;
 8413 		}
 8414 		$ldepth = $next_depth;
 8415 		print " yes" if ($VERBOSITY > 3);
 8416 		if (defined &add_frame_child_links) {
 8417 		    $href = &make_href($file,$title);
 8418 		    if ($href =~ s/($root_file)_mn/$1_ct/) {
 8419 			$href =~ s/(target=")main(")/$1contents$2/i;
 8420 		    };
 8421 		    $_ .= ($countUL >1 ? $inner_item : $outer_item)
 8422 			. $href . "\n";
 8423 		} else {
 8424 		    $_ .= ($countUL >1 ? $inner_item : $outer_item)
 8425 			. &make_href($file,$title) . "\n";
 8426 		}
 8427 	    } else {
 8428 		# ignore items that are deeper than $MAX_LINK_DEPTH
 8429 		print " no" if ($VERBOSITY > 3);
 8430 	    }
 8431 	}
 8432 
 8433 	if (%open) {
 8434 	# close-off any remaining <UL> lists
 8435 	    $countUL-- if $CHILD_NOLIST;
 8436 	    local $cnt = (split('/',%open))[0];
 8437 	    local $i = $cnt;
 8438 		while ($i > $depth) { 
 8439 		    if ($open{$i}) {
 8440 			$_ .= '</UL>' if $countUL;
 8441 			$countUL--;
 8442 			delete $open{$i};
 8443 		    }
 8444 		$i--;
 8445 	    }
 8446 	}
 8447     }
 8448     # just in case the count is wrong
 8449     $countUL-- if ($CHILD_NOLIST && $countUL > 0);
 8450     $countUL = '' if ($countUL < 0);
 8451     while ($countUL) { $_ .= '</UL>'; $countUL-- }
 8452     ($_ ? join('', $_, "\n$childlinks_end") : '');
 8453 }
 8454 
 8455 sub child_line {($CHILDLINE) ? "$CHILDLINE" : "<BR>\n<HR>";}
 8456 sub upper_child_line { "<HR>\n"; }
 8457 
 8458 sub adjust_root_keys {
 8459     return() unless ($MULTIPLE_FILES && $ROOTED);
 8460     local($next,$change_key,$current_rx);
 8461     local(@keys) = (keys %toc_section_info);
 8462     
 8463     local($current_key) = join(' ',@curr_sec_id);
 8464     $current_key =~ /^(\d+ )/;
 8465     $current_rx = $1;
 8466     return() unless $current_rx;
 8467 
 8468     # alter the keys which start as $current_key
 8469     foreach $next (@keys) {
 8470 	if ($next =~ /^$current_rx/) {
 8471 	    # make current document the root
 8472 	    $change_key = '0 '.$';
 8473 	    $toc_section_info{$change_key} = $toc_section_info{$next};
 8474 	    $section_info{$change_key} = $section_info{$next};
 8475 #	    if (!($next eq $current_key)) {
 8476 #		$toc_section_info{$next} = $section_info{$next} = '';
 8477 #	    }
 8478 	}
 8479     }
 8480 }
 8481 
 8482 sub top_page {
 8483     local($file, @navigation_panel) = @_;
 8484     # It is the top page if there is a link to itself
 8485     join('', @navigation_panel) =~ /$file/;
 8486 }
 8487 
 8488 # Sets global variable $AUX_FILE
 8489 sub process_aux_file {
 8490     local(@exts) = ('aux');
 8491     push(@exts, 'lof') if (/\\listoffigures/s);
 8492     push(@exts, 'lot') if (/\\listoftables/s);
 8493     local($_, $status);		# To protect caller from &process_ext_file
 8494     $AUX_FILE = 1;
 8495     foreach $auxfile (@exts) {
 8496 	$status = &process_ext_file($auxfile);
 8497 	if ($auxfile eq "aux" && ! $status) {
 8498 	    print "\nCannot open $FILE.aux $!\n";
 8499 	    &write_warnings("\nThe $FILE.aux file was not found," .
 8500 			    " so sections will not be numbered \nand cross-references "
 8501 			    . "will be shown as icons.\n");
 8502 	}
 8503     }
 8504     $AUX_FILE = 0;
 8505 }
 8506 
 8507 sub do_cmd_htmlurl {
 8508     local($_) = @_;
 8509     local($url);
 8510     $url = &missing_braces unless (
 8511 	(s/$next_pair_pr_rx/$br_id=$1;$url=$2;''/e)
 8512 	||(s/$next_pair_rx/$br_id=$1;$url=$2;''/e));
 8513     $url =~ s/\\(html)?url\s*($O|$OP)([^<]*)\2/$3/;
 8514     $url =~ s/\\?~/;SPMtilde;/og;
 8515     join('','<kbd>', &make_href($url,$url), '</kbd>', $_);
 8516 }
 8517 sub do_cmd_url { &do_cmd_htmlurl(@_) }
 8518 
 8519 sub make_href { &make_real_href(@_) }
 8520 sub make_real_href {
 8521     local($link, $text) = @_;
 8522     $href_name++;
 8523     my $htarget = '';
 8524     $htarget = ' target="'.$target.'"'
 8525 	if (($target)&&($HTML_VERSION > 3.2));
 8526     #HWS: Nested anchors not allowed.
 8527     $text =~ s/<A .*><\/A>//go;
 8528     #JKR: ~ is handled different - &#126; is turned to ~ later.
 8529     #$link =~ s/&#126;/$percent_mark . "7E"/geo;
 8530     if ($text eq $link) { $text =~ s/~/&#126;/g; }
 8531     $link =~ s/~/&#126;/g;
 8532     # catch \url or \htmlurl
 8533     $link =~ s/\\(html)?url\s*(($O|$OP)\d+($C|$CP))([^<]*)\2/$5/;
 8534     $link =~ s:(<TT>)?<A [^>]*>([^<]*)</A>(</TT>)?(([^<]*)|$):$2$4:;
 8535     # this should not be here; else TOC, List of Figs, etc. fail:
 8536     # $link =~ s/^\Q$CURRENT_FILE\E(\#)/$1/ unless ($SEGMENT||$SEGMENTED);
 8537     $text = &simplify($text);
 8538     "<A ID=\"tex2html$href_name\"$htarget\n  HREF=\"$link\">$text</A>";
 8539 }
 8540 
 8541 sub make_href_noexpand { # clean
 8542     my ($link, $name, $text) = @_;
 8543     do {$name = "tex2html". $href_name++} unless $name;
 8544     #HWS: Nested anchors not allowed.
 8545     $text =~ s/<A .*><\/A>//go;
 8546     #JKR: ~ is handled different - &#126; is turned to ~ later.
 8547     #$link =~ s/&#126;/$percent_mark . "7E"/geo;
 8548     if ($text eq $link) { $text =~ s/~/&#126;/g; }
 8549     $link =~ s/~/&#126;/g;
 8550     # catch \url or \htmlurl
 8551     $link =~ s/\\(html)?url\s*(($O|$OP)\d+($C|$CP))([^<]*)\2/$5/;
 8552     $link =~ s:(<TT>)?<A [^>]*>([^<]*)</A>(</TT>)?(([^<]*)|$):$2$4:;
 8553     "<A ID=\"$name\"\n HREF=\"$link\">$text</A>";
 8554 }
 8555 
 8556 sub make_named_href {
 8557     local($name, $link, $text) = @_;
 8558     $text =~ s/<A .*><\/A>//go;
 8559     $text = &simplify($text);
 8560     if ($text eq $link) { $text =~ s/~/&#126;/g; }
 8561     $link =~ s/~/&#126;/g;
 8562     # catch \url or \htmlurl
 8563     $link =~ s/\\(html)?url\s*(($O|$OP)\d+($C|$CP))([^<]*)\2/$5/;
 8564     $link =~ s:(<TT>)?<A [^>]*>([^<]*)</A>(</TT>)?(([^<]*)|$):$2$4:;
 8565     if (!($name)) {"<A\n HREF=\"$link\">$text</A>";}
 8566     elsif ($text =~ /^\w/) {"<A ID=\"$name\"\n HREF=\"$link\">$text</A>";}
 8567     else {"<A ID=\"$name\"\n HREF=\"$link\">$text</A>";}
 8568 }
 8569 
 8570 sub make_section_heading {
 8571     local($text, $level, $anchors) = @_;
 8572     local($elevel) = $level; $elevel =~ s/^(\w+)\s.*$/$1/;
 8573     local($section_tag) = join('', @curr_sec_id);
 8574     local($align,$pre_anchors);
 8575 
 8576     # separate any invisible anchors or alignment, if this has not already been done
 8577     if (!($anchors)){ ($anchors,$text) = &extract_anchors($text) }
 8578     else { 
 8579 	$anchors =~ s/(class=\"\w*\")/$align = " $1";''/e;
 8580 	$align = '' if ($HTML_VERSION < 2.2);
 8581 	$anchors = &translate_commands($anchors) if ($anchors =~ /\\/);
 8582     }
 8583 
 8584     # strip off remains of bracketings
 8585     $text =~ s/$OP\d+$CP//g;
 8586     if (!($text)) {
 8587 	# anchor to a single `.' only
 8588 	$text = "<A ID=\"SECTION$section_tag\">.</A>$anchors\n";
 8589     } elsif ($anchors) {
 8590 #	# put anchors immediately after, except if title is too long
 8591 #	if ((length($text)<60 )&&(!($align)||($align =~/left/))) {
 8592 #	    $text = "<A ID=\"SECTION$section_tag\">$text</A>\n" . $anchors;
 8593 	# ...put anchors preceding the title, on a separate when left-aligned
 8594 #	} else {
 8595 	    $text = "<A ID=\"SECTION$section_tag\">$anchor_invisible_mark</A>$anchors"
 8596 		. (!($align)||($align =~ /left/i ) ? "<BR>" : "") . "\n". $text;
 8597 #	}
 8598     } elsif (!($text =~ /<A[^\w]/io)) {
 8599 	# no embedded anchors, so anchor it all
 8600 	$text = "<A ID=\"SECTION$section_tag\">\n" . $text . "</A>";
 8601     } else {
 8602 	# there are embedded anchors; these cannot be nested
 8603 	local ($tmp) = $text;
 8604 	$tmp =~ s/<//o ;	# find 1st <
 8605 	if ($`) {		# anchor text before the first < 
 8606 #	    $text = "<A ID=\"SECTION$section_tag\">\n" . $` . "</A>\n<" . $';
 8607 	    $text = "<A ID=\"SECTION$section_tag\">\n" . $` . "</A>";
 8608 	    $pre_anchors = "<" . $';
 8609 	    if ($pre_anchors =~ /^(<A ID=\"[^\"]+>${anchor_invisible_mark}<\/A>\s*)+$/) {
 8610 		$pre_anchors .= "\n"
 8611 	    } else { $text .= $pre_anchors; $pre_anchors = '' }
 8612 	} else {
 8613 	    # $text starts with a tag
 8614 	    local($after,$tmp) = ($','');
 8615 	    if ( $after =~ /^A[^\w]/i ) {	
 8616 		# it is an anchor already, so need a separate line
 8617 		$text = "<A ID=\"SECTION$section_tag\">$anchor_invisible_mark</A><BR>\n$text";
 8618 	    } else {
 8619 		# Is it a tag enclosing the anchor ?
 8620 		$after =~ s/^(\w)*[\s|>]/$tmp = $1;''/eo;
 8621 		if ($after =~ /<A.*<\/$tmp>/) {
 8622 		    # it encloses an anchor, so use anchor_mark + break
 8623 		    $text = "<A ID=\"SECTION$section_tag\">$anchor_invisible_mark</A><BR>\n$text";
 8624 		} else {
 8625 		    # take up to the anchor
 8626 		    $text =~ s/^(.*)<A([^\w])/"<A ID=\"SECTION$section_tag\">$1<A$2"/oe;
 8627 		}
 8628 	    }
 8629 	}
 8630     }
 8631     "$pre_anchors\n<$level$align>$text\n<\/$elevel>";
 8632 }
 8633 
 8634 sub do_cmd_captionstar { &process_cmd_caption(1, @_) }
 8635 sub do_cmd_caption { &process_cmd_caption('', @_) }
 8636 sub process_cmd_caption {
 8637     local($noLOTentry, $_) = @_;
 8638     local($text,$opt,$br_id, $contents);
 8639     local($opt) = &get_next_optional_argument;
 8640     $text = &missing_braces unless (
 8641 	(s/$next_pair_pr_rx/$br_id=$1;$text=$2;''/e)
 8642 	||(s/$next_pair_rx/$br_id=$1;$text=$2;''/e));
 8643 
 8644     # put it in $contents, so &extract_captions can find it
 8645     local($contents) = join('','\caption', ($opt ? "[$opt]" : '')
 8646 	   , "$O$br_id$C" , $text , "$O$br_id$C");
 8647 
 8648     # $cap_env is set by the surrounding figure/table
 8649     &extract_captions($cap_env);
 8650     $contents.$_;
 8651 }
 8652 
 8653 sub extract_captions {
 8654     # Uses and modifies $contents and $cap_anchors, defined in translate_environments
 8655     # and modifies $figure_captions, $table_captions, $before and $after
 8656     # MRO: no effect! local($env,*cap_width) = @_;
 8657     local($env) = @_;
 8658     local(%captions, %optional_captions, $key, $caption, $optional_caption,
 8659 	  $item, $type, $list, $extra_list, $number, @tmp, $br_id, $_);
 8660     # associate the br_id of the caption with the argument of the caption
 8661     $contents =~ s/$caption_rx(\n)?/do {
 8662 	$key = $9; $caption = $10; $optional_caption = $3;
 8663 	$key = &filter_caption_key($key) if (defined &filter_caption_key);
 8664 	$optional_captions{$key} = $optional_caption||$caption;
 8665 	$captions{$key} = $10; ''}/ego;
 8666 #	$captions{$9} = $10; $caption_mark }/ego;
 8667     $key = $caption = $optional_caption = '';
 8668 
 8669     #catch any  \captionwidth  settings that may remain
 8670     $contents =~ s/$caption_width_rx(\n)?/&translate_commands($&);''/eo;
 8671     
 8672 #    $after = join("","<P>",$after) if ($&);
 8673 #    $before .= "</P>" if ($&);
 8674     #JKR: Replaced "Figure" and "Table" with variables (see latex2html.config too).
 8675     if ($env eq 'figure') {
 8676 	if ((defined &do_cmd_figurename)||$new_command{'figurename'}){
 8677 	    $br_id = ++$global{'max_id'};
 8678 	    $type = &translate_environments("$O$br_id$C\\figurename$O$br_id$C")
 8679 		unless ($noLOFentry);
 8680 	} else { $type = $fig_name }
 8681 	$list = "\$figure_captions";
 8682 #	$extra_list = "\$segment_figure_captions" if ($figure_table_captions);
 8683 	$extra_list = "\$segment_figure_captions" if ($segment_figure_captions);
 8684     }
 8685     elsif ($env =~ /table/) {
 8686 	if ((defined &do_cmd_tablename)||$new_command{'tablename'}) {
 8687 	    $br_id = ++$global{'max_id'};
 8688 	    $type = &translate_environments("$O$br_id$C\\tablename$O$br_id$C")
 8689 		unless ($noLOTentry);
 8690 	} else { $type = $tab_name }
 8691 	$list = "\$table_captions";
 8692 	$extra_list = "\$segment_table_captions" if ($segment_table_captions);
 8693     }
 8694 
 8695 #    $captions = "";
 8696     $cap_anchors = "";
 8697     local($this);
 8698     foreach $key (sort {$a <=> $b;} keys %captions){ # Sort numerically
 8699 	$this = $captions{$key};
 8700 	$this =~ s/\\label\s*($O\d+$C)[^<]+\1//g; # remove \label commands
 8701        	local($br_id) = ++$global{'max_id'};
 8702 	local($open_tags_R) = []; # locally, initially no style
 8703 	$caption = &translate_commands(
 8704 	     &translate_environments("$O$br_id$C$this$O$br_id$C"));
 8705 
 8706 	# same again for the optional caption
 8707 	$this = $optional_captions{$key};
 8708 	$this =~ s/\\label\s*($O\d+$C)[^<]+\1//g; # remove \label commands
 8709 	local($open_tags_R) = []; local($br_id) = ++$global{'max_id'};
 8710 	$this = &translate_environments("$O$br_id$C$this$O$br_id$C");
 8711 	$optional_caption = &translate_commands($this);
 8712 
 8713 	$cap_anchors .= "<A ID=\"$key\">$anchor_mark</A>";
 8714 	$_ = $optional_caption || $caption;
 8715 
 8716 
 8717 	# split at embedded anchor or citation marker
 8718 	local($pre_anchor,$post_anchor) = ('','');
 8719 	if (/\s*(<A\W|\#[^#]*\#<tex2html_cite_[^>]*>)/){
 8720 	    $pre_anchor = "$`";
 8721 	    $post_anchor = "$&$'";
 8722 	    $pre_anchor = $anchor_invisible_mark
 8723 		unless (($pre_anchor)||($SHOW_SECTION_NUMBERS));
 8724 	} else {
 8725 	    $pre_anchor = "$_";
 8726 	}
 8727 
 8728 #JCL(jcl-tcl)
 8729 ##	&text_cleanup;
 8730 ##	$_ = &encode_title($_);
 8731 ##	s/&nbsp;//g;            # HWS - LaTeX changes ~ in its .aux files
 8732 #	$_ = &sanitize($_);
 8733 ##
 8734 #	$_ = &revert_to_raw_tex($_);
 8735 
 8736 	#replace image-markers by the image params
 8737 	s/$image_mark\#([^\#]+)\#/&purify_caption($1)/e;
 8738 
 8739 	local($checking_caption, $cap_key) = (1, $_);
 8740 	$cap_key = &simplify($cap_key);
 8741 	$cap_key = &sanitize($cap_key);
 8742 	@tmp = split(/$;/, eval ("\$encoded_$env" . "_number{\$cap_key}"));
 8743 	$number = shift(@tmp);
 8744 	$number = "" if ($number eq "-1");
 8745 
 8746 	if (!$number) {
 8747 	    $cap_key = &revert_to_raw_tex($cap_key);
 8748 	    @tmp = split(/$;/
 8749 	       , eval ("\$encoded_$env" . "_number{\$cap_key}"));
 8750 	    $number = shift(@tmp);
 8751 	    $number = "" if ($number eq "-1");
 8752 	}
 8753 
 8754 	#resolve any embedded cross-references first
 8755 	$checking_caption = '';
 8756 	$_ = &simplify($_);
 8757 	$_ = &sanitize($_);
 8758 
 8759 
 8760 #	@tmp = split(/$;/, eval ("\$encoded_$env" . "_number{\$_}"));
 8761 #	$number = shift(@tmp);
 8762 #	$number = "" if ($number eq "-1");
 8763 
 8764 	&write_warnings(qq|\nNo number for "$_"|) if (! $number);
 8765 	eval("\$encoded_$env" . "_number{\$_} = join(\$;, \@tmp)");
 8766 
 8767 	$item = join( '', ($SHOW_SECTION_NUMBERS ? $number."\. " : '')
 8768 	    , &make_href("$CURRENT_FILE#$key", $pre_anchor)
 8769 	    , $post_anchor);
 8770 	undef $_;
 8771 	undef @tmp;
 8772 
 8773 	$captions = join("", ($captions ? $captions."\n<BR>\n" : '')
 8774 		, "<STRONG>$type" , ($number ? " $number:" : ":")
 8775 		, "</STRONG>\n$caption" , (($captions) ? "\n" : "" ));
 8776 
 8777 	do {
 8778 	    eval "$extra_list .= \"\n<LI>\" .\$item" if ($extra_list);
 8779 	    eval "$list .= \"\n<LI>\" .\$item" }
 8780 		 unless ( $noLOTentry || $noLOFentry);
 8781 #	eval("print \"\nCAPTIONS:\".$extra_list.\n\"");
 8782     }
 8783 }
 8784 
 8785 
 8786 # This processes \label commands found in environments that will
 8787 # be handed over to Latex. Sets the table %symbolic_labels
 8788 sub do_labels {
 8789     local($context,$new_context) = @_;
 8790     local($label);
 8791     # MRO: replaced $* by /m
 8792     $context =~ s/\s*$labels_rx/do {
 8793 	$label = &do_labels_helper($2);
 8794 	$new_context = &anchor_label($label,$CURRENT_FILE,$new_context);""}/geom;
 8795     $new_context;
 8796 }
 8797 
 8798 sub extract_labels {
 8799     local($_) = @_;
 8800     local($label,$anchors);
 8801     # MRO: replaced $* by /m
 8802     while (s/[ \t]*$labels_rx//om) {
 8803         $label = &do_labels_helper($2);
 8804         $anchors .= &anchor_label($label,$CURRENT_FILE,'');
 8805     }
 8806     ($_, $anchors);
 8807 }
 8808 
 8809 # This should be done inside the substitution but it doesn't work ...
 8810 sub do_labels_helper {
 8811     local($_) = @_;
 8812     s/$label_rx/_/g;  # replace non-alphanumeric characters
 8813     $symbolic_labels{$_} = $latex_labels{$_}; # May be empty;
 8814     $_;
 8815 }
 8816 
 8817 sub convert_to_description_list {
 8818     # MRO: modified to use $_[1]
 8819     # local($which, *list) = @_;
 8820     my $which = $_[0];
 8821     $_[1] =~ s!(</A>\s*)<[OU]L([^>]*)>!$1<DD><DL$2>!ig;
 8822     $_[1] =~ s!<(/?)[OU]L([^>]*)>!$1? "<$1DL$2>":"<DL$2>"!eig;
 8823     $_[1] =~ s!(</?)LI>!$1D$which>!ig;
 8824 #    $_[1] =~ s/^\s*<DD>//;
 8825 }
 8826 
 8827 sub add_toc { &add_real_toc(@_) }
 8828 sub add_real_toc {
 8829     local($temp1, $temp2);
 8830     print "\nDoing table of contents ...";
 8831     local(@keys) = keys %toc_section_info;
 8832     @keys = sort numerically @keys;
 8833     $temp1 = $MAX_LINK_DEPTH; $temp2 = $MAX_SPLIT_DEPTH;
 8834     $MAX_SPLIT_DEPTH = $MAX_LINK_DEPTH = 1000;
 8835     #JKR: Here was a "Contents" - replaced it with $toc_title
 8836     local($base_key) = $keys[0];
 8837     if ($MULTIPLE_FILES) {
 8838     	$base_key = $THIS_FILE;
 8839     }
 8840     local($title);
 8841     if ((defined &do_cmd_contentsname)||$new_command{'contentsname'}) {
 8842 	local($br_id)=++$global{'max_id'};
 8843 	$title = &translate_environments("$O$br_id$C\\contentsname$O$br_id$C");
 8844     } else { $title = $toc_title }
 8845     local($toc,$on_first_page) = ('','');
 8846     $on_first_page = $CURRENT_FILE
 8847 	unless ($MAX_SPLIT_DEPTH && $MAX_SPLIT_DEPTH <1000);
 8848     $toc = &add_child_links($title,$on_first_page,'',1,$keys[0],@keys);
 8849     &convert_to_description_list('T',$toc) if ($use_description_list);
 8850     s/$toc_mark/$toc/;
 8851     $MAX_LINK_DEPTH = $temp1; $MAX_SPLIT_DEPTH = $temp2;
 8852 }
 8853 
 8854 # Assign ref value, but postpone naming the label
 8855 sub make_half_href {
 8856     local($link) = $_[0];
 8857     $href_name++;
 8858     "<A ID=\"tex2html$href_name\"\n HREF=\"$link\">";
 8859 }
 8860 
 8861 
 8862 # Redefined in makeidx.perl
 8863 sub add_idx {
 8864     local($sidx_style, $eidx_style) =('<STRONG>','</STRONG>');
 8865     if ($INDEX_STYLES) {
 8866 	if ($INDEX_STYLES =~/,/) {
 8867 	local(@styles) = split(/\s*,\s*/,$INDEX_STYLES);
 8868 	    $sidx_style = join('','<', join('><',@styles) ,'>');
 8869 	    $eidx_style = join('','</', join('></',reverse(@styles)) ,'>');
 8870 	} else {
 8871 	    $sidx_style = join('','<', $INDEX_STYLES,'>');
 8872 	    $eidx_style = join('','</', $INDEX_STYLES,'>');
 8873 	}
 8874     }
 8875     &add_real_idx(@_)
 8876 }
 8877 sub add_real_idx {
 8878     print "\nDoing the index ...";
 8879     local($key, $str, @keys, $index, $level, $count,
 8880 	  @previous, @current);
 8881     @keys = keys %index;
 8882     @keys = sort keysort  @keys;
 8883     $level = 0;
 8884     foreach $key (@keys) {
 8885 	@current = split(/!/, $key);
 8886 	$count = 0;
 8887 	while ($current[$count] eq $previous[$count]) {
 8888 	    $count++;
 8889 	}
 8890 	while ($count > $level) {
 8891 	    $index .= "\n<DL class=\"COMPACT\">";
 8892 	    $level++;
 8893 	}
 8894 	while ($count < $level) {
 8895 	    $index .= "\n</DL>";
 8896 	    $level--;
 8897 	}
 8898 	foreach $term (@current[$count .. $#current-1]) {
 8899 	    # need to "step in" a little
 8900 #	    $index .= "<DT>" . $term . "\n<DL COMPACT>";
 8901 	    $index .= "\n<DT>$sidx_style" . $term . "$eidx_style\n<DD><DL class=\"COMPACT\">";
 8902 	    $level++;
 8903 	}
 8904 	$str = $current[$#current];
 8905 	$str =~ s/\#\#\#\d+$//o; # Remove the unique id's
 8906 	$index .= $index{$key} .
 8907 	    # If it's the same string don't start a new line
 8908 	    (&index_key_eq(join('',@current), join('',@previous)) ?
 8909 	     ", $sidx_style" . $cross_ref_visible_mark . "$eidx_style</A>\n" :
 8910 	     "<DT>$sidx_style" . $str . "$eidx_style</A>\n");
 8911 	@previous = @current;
 8912     }
 8913     while ($count < $level) {
 8914 	$index .= "\n</DL>";
 8915 	$level--;
 8916     }
 8917     $index = '<DD>'.$index unless ($index =~ /^\s*<D(T|D)>/);
 8918 
 8919     $index =~ s/(<A [^>]*>)(<D(T|D)>)/$2$1/g;
 8920     
 8921 #    s/$idx_mark/<DL COMPACT>$index<\/DL>/o;
 8922     s/$idx_mark/$preindex\n<DL class=\"COMPACT\">\n$index<\/DL>\n/o;
 8923 }
 8924 
 8925 sub keysort {
 8926     local($x, $y) = ($a,$b);
 8927     $x = &clean_key($x);
 8928     $y = &clean_key($y);
 8929 #    "\L$x" cmp "\L$y";  # changed sort-rules, by M Ernst.
 8930     # Put alphabetic characters after symbols; already downcased
 8931     $x =~ s/^([a-z])/~~~$1/;
 8932     $y =~ s/^([a-z])/~~~$1/;
 8933     ($x cmp $y) || ($a cmp $b);
 8934 }
 8935 
 8936 sub index_key_eq {
 8937     local($a,$b) = @_;
 8938     $a = &clean_key($a);
 8939     $b = &clean_key($b);
 8940     $a eq $b;
 8941 }
 8942 
 8943 sub clean_key {
 8944     local ($_) = @_;
 8945     tr/A-Z/a-z/;
 8946     s/\s+/ /g;		# squeeze white space and newlines into space
 8947     s/ (\W)/$1/g;	# make foo( ), foo () and foo(), or <TT>foo</TT>
 8948     ;			# and <TT>foo </TT> to be equal
 8949     s/$O\d+$C//go;	# Get rid of bracket id's
 8950     s/$OP\d+$CP//go;	# Get rid of processed bracket id's
 8951     s/\#\#\#\d+$//o;	# Remove the unique id
 8952     $_;
 8953 }
 8954 
 8955 
 8956 sub make_footnotes {
 8957     # Uses $footnotes defined in translate and set in do_cmd_footnote
 8958     # Also uses $footfile
 8959     local($_) = "\n<DL>$footnotes\n<\/DL>";
 8960     $footnotes = ""; # else they get used
 8961     local($title);
 8962     if ((defined &do_cmd_footnotename)||$new_command{'footnotename'}) {
 8963 	local($br_id)=++$global{'max_id'};
 8964 	$title = &translate_environments("$O$br_id$C\\footnotename$O$br_id$C");
 8965     } else {
 8966 	$foot_title = "Footnotes" unless $foot_title;
 8967 	$title = $foot_title;
 8968     }
 8969     print "\nDoing footnotes ...";
 8970 #JCL(jcl-tcl)
 8971 # If the footnotes go into a separate file: see &make_file.
 8972     if ($footfile) {
 8973 	$toc_sec_title = $title;
 8974 	&make_file($footfile, $title, $FOOT_COLOR); # Modifies $_;
 8975 	$_ = "";
 8976     } else {
 8977 	$footnotes = ""; # else they get re-used
 8978 	$_ = join ('', '<BR><HR><H4>', $title, '</H4>', $_ );
 8979     }
 8980     $_;
 8981 }
 8982 
 8983 sub post_process_footnotes {
 8984     &slurp_input($footfile);
 8985     open(OUT, ">$footfile") || die "Cannot write file '$footfile': $!\n";
 8986     &replace_markers;
 8987     &post_post_process if (defined &post_post_process);
 8988     &adjust_encoding;
 8989     print OUT $_;
 8990     close OUT;
 8991 }
 8992 
 8993 sub make_file {
 8994     # Uses and modifies $_ defined in the caller
 8995     local($filename, $title, $layout) = @_;
 8996     $layout = $BODYTEXT unless $layout;
 8997     $_ = join('',&make_head_and_body($title,$layout), $_
 8998 	, (($filename =~ /^\Q$footfile\E$/) ? '' : &make_address )
 8999 	, (($filename =~ /^\Q$footfile\E$/) ? "\n</BODY>\n</HTML>\n" : '')
 9000 	);
 9001     &replace_markers unless ($filename eq $footfile); 
 9002 
 9003     unless(open(FILE,">$filename")) {
 9004         print "\nError: Cannot write '$filename': $!\n";
 9005         return;
 9006     }
 9007     print FILE $_;
 9008     close(FILE);
 9009 }
 9010 
 9011 sub add_to_body {
 9012     local($attrib, $value) = @_;
 9013     local($body) = $BODYTEXT;
 9014     if ($body =~ s/\Q$attrib\E\s*=\s*"[^"]*"/$attrib="$value"/) {
 9015     } else {
 9016 	$body .= " $attrib=\"$value\""; $body =~ s/\s{2,}/ /g;
 9017     }
 9018     $BODYTEXT = $body if $body;
 9019 }
 9020 
 9021 sub replace_verbatim_marks {
 9022     # Modifies $_
 9023     my($tmp);
 9024     s/$math_verbatim_rx/&make_comment('MATH', $verbatim{$1})/eg;
 9025     s/$mathend_verbatim_rx/&make_comment('MATHEND', '')/eg;
 9026 #    s/$verbatim_mark(verbatim\*?)(\d+)#/<PRE>\n$verbatim{$2}\n<\/PRE>/go;
 9027 ##    s/$verbatim_mark(\w*[vV]erbatim\*?)(\d+)#/\n$verbatim{$2}\n/go;
 9028     s!$verbatim_mark(\w*[vV]erbatim\*?|tex2html_code)(\d+)#\n?!$tmp=$verbatim{$2};
 9029 	$tmp.(($tmp =~/\n\s*$/s)? '':"\n")!eg;
 9030 #	"\n".$tmp.(($tmp =~/\n\s*$/s)? '':"\n")!eg;
 9031     s/(<PRE[^>]*>)?$verbatim_mark(lstlisting|lstset|lststyle|lstfile)(\d+)#(<\/PRE>)?\n?/
 9032         &process_lstlisting($1, $4, $2, $verbatim{$3})/eg;
 9033 #    s/$verbatim_mark(rawhtml)(\d+)#/$verbatim{$2}/eg; # Raw HTML
 9034     s/$verbatim_mark(imagesonly)(\d+)#//eg; # imagesonly is *not* replaced
 9035     # Raw HTML, but replacements may have protected characters
 9036     s/$verbatim_mark(rawhtml)(\d+)#/&unprotect_raw_html($verbatim{$2})/eg;
 9037     s/$verbatim_mark$keepcomments_rx(\d+)#/$verbatim{$2}/ego; # Raw TeX
 9038     s/$unfinished_mark$keepcomments_rx(\d+)#/$verbatim{$2}/ego; # Raw TeX
 9039 }
 9040 
 9041 # Actual lstlisting engine, except initialization, moved to styles/listings.perl
 9042 
 9043 # TeX's special characters may have been escaped with a '\'; remove it.
 9044 sub unprotect_raw_html {
 9045     local($raw) = @_;
 9046     $raw =~ s/\\($latex_specials_rx|~|\^|@)/$1/g;
 9047     $raw;
 9048 }
 9049 
 9050 # remove file-markers; special packages may redefine &replace_file_marks
 9051 sub remove_file_marks {
 9052     s/<(DD|LI)>\n?($file_mark|$endfile_mark)\#.*\#\n<\/\1>(\n|(<))/$4/gm;
 9053     s/($file_mark|$endfile_mark)\#.*\#(\n|(<))/$3/gm;
 9054 }
 9055 sub replace_file_marks { &remove_file_marks }
 9056 
 9057 sub remove_verbatim_marks {
 9058     # Modifies $_
 9059     s/($math_verbatim_rx|$mathend_verbatim_rx)//go;
 9060 #    s/$verbatim_mark(verbatim\*?)(\d+)#//go;
 9061     s/$verbatim_mark(\w*[Vv]erbatim\w*\*?)(\d+)#//go;
 9062     s/$verbatim_mark(rawhtml|imagesonly)(\d+)#//go;
 9063     s/$verbatim_mark(lstlisting)(\d+)#//go;
 9064     s/$verbatim_mark$keepcomments_rx(\d+)#//go;
 9065     s/$unfinished_mark$keepcomments_rx(\d+)#//go;
 9066 }
 9067 
 9068 sub replace_verb_marks {
 9069     # Modifies $_
 9070     s/($verb_mark|$verbstar_mark|$verblst_mark)(\d+)$verb_mark/
 9071 	$code = $verb{$2};
 9072 	$code = &replace_comments($code) if ($code =~ m:$comment_mark:);
 9073 	if ($1 eq $verblst_mark)
 9074 	{$code=&process_lstinline($verb_lstopt{$2},$code);}
 9075 	else {$code="<code>$code<\/code>";}
 9076 	$code/eg;
 9077 }
 9078 
 9079 sub replace_comments{
 9080     local($_) = @_;
 9081     $_ =~ s/$comment_mark(\d+)\n?/$verbatim{$1}/go;
 9082     $_ =~ s/$comment_mark\d*\n/%\n/go;
 9083     $_;
 9084 }
 9085 
 9086 sub remove_verb_marks {
 9087     # Modifies $_
 9088     s/($verb_mark|$verbstar_mark|$verblst_mark)(\d+)$verb_mark//go;
 9089 }
 9090 
 9091 # This is used by revert_to_raw_tex
 9092 sub revert_verbatim_marks {
 9093     # Modifies $_
 9094 #    s/$verbatim_mark(verbatim)(\d+)#/\\begin{verbatim}$verbatim{$2}\\end{verbatim}\n/go;
 9095     s/$verbatim_mark(\w*[Vv]erbatim)(\d+)#/\\begin{$1}\n$verbatim{$2}\\end{$1}\n/go;
 9096     s/$verbatim_mark(lstlisting)(\d+)#/\\begin{lstlisting}\n$verbatim{$2}\\end{lstlisting}\n/go;
 9097     s/$verbatim_mark(rawhtml)(\d+)#/\\begin{rawhtml}\n$verbatim{$2}\\end{rawhtml}\n/go;
 9098     s/$verbatim_mark(imagesonly|tex2html_code)(\d+)#\n?/$verbatim{$2}/go;
 9099     s/$verbatim_mark$image_env_rx(\d+)#/\\begin{$1}\n$verbatim{$2}\\end{$1}\n/go;
 9100     s/($math_verbatim_rx|$mathend_verbatim_rx)//go;
 9101 }
 9102 
 9103 sub revert_verb_marks {
 9104     # Modifies $_
 9105     s/$verbstar_mark(\d+)$verb_mark/\\verb*$verb_delim{$1}$verb{$1}$verb_delim{$1}/go;
 9106     s/$verb_mark(\d+)$verb_mark/\\verb$verb_delim{$1}$verb{$1}$verb_delim{$1}/go;
 9107     s/$verblst_mark(\d+)$verb_mark/\\lstinline$verb_lstopt{$1}$verb_delim{$1}$verb{$1}$verb_delim{$1}/go;
 9108 }
 9109 
 9110 sub replace_cross_ref_marks {
 9111     # Modifies $_
 9112     local($label,$id,$ref_label,$ref_mark,$after,$name);
 9113     local($invis) = "<tex2html_anchor_invisible_mark></A>";
 9114 #    s/$cross_ref_mark#([^#]+)#([^>]+)>$cross_ref_mark/
 9115     s/$cross_ref_mark#([^#]+)#([^>]+)>$cross_ref_mark<\/A>(\s*<A( ID=\"\d+)\">$invis)?/
 9116 	do {($label,$id) = ($1,$2); $name = $4;
 9117 	    $ref_label = $external_labels{$label} unless
 9118 		($ref_label = $ref_files{$label});
 9119 	    print "\nXLINK<: $label : $id :$name " if ($VERBOSITY > 3);
 9120 	    $ref_label = '' if ($ref_label eq $CURRENT_FILE);
 9121 	    $ref_mark = &get_ref_mark($label,$id);
 9122 	    &extend_ref if ($name); $name = '';
 9123 	    print "\nXLINK: $label : $ref_label : $ref_mark " if ($VERBOSITY > 3);
 9124 	    '"' . "$ref_label#$label" . "\">" . $ref_mark . "<\/A>"
 9125 	}/geo;
 9126 
 9127     # This is for namerefs, section name without section number
 9128     s/$cross_ref_mark#([^#]+)#([^>]+)>$name_ref_mark<\/A>(\s*<A( ID=\"\d+)\">$invis)?/
 9129 	do {($label,$id) = ($1,$2); $name = $4;
 9130 	    $ref_label = $external_labels{$label} unless
 9131 		($ref_label = $ref_files{$label});
 9132 	    print "\nXLINK<: $label : $id :$name " if ($VERBOSITY > 3);
 9133 	    $ref_label = '' if ($ref_label eq $CURRENT_FILE);
 9134 	    $ref_mark = &get_name_ref_mark($label,$id);
 9135 	    &extend_ref if ($name); $name = '';
 9136 	    print "\nXLINK: $label : $ref_label : $ref_mark " if ($VERBOSITY > 3);
 9137 	    '"' . "$ref_label#$label" . "\">" . $ref_mark . "<\/A>"
 9138 	}/geo;
 9139 
 9140     # This is for pagerefs which cannot have symbolic labels ??? 
 9141 #    s/$cross_ref_mark#(\w+)#\w+>/
 9142     s/$cross_ref_mark#([^#]+)#[^>]+>/
 9143 	do {$label = $1;
 9144 	    $ref_label = $external_labels{$label} unless
 9145 		($ref_label = $ref_files{$label});
 9146 	    $ref_label = '' if ($ref_label eq $CURRENT_FILE);
 9147 	    print "\nXLINKP: $label : $ref_label" if ($VERBOSITY > 3);
 9148 	    '"' . "$ref_files{$label}#$label" . "\">"
 9149 	}/geo;
 9150 }
 9151 
 9152 #RRM: this simply absorbs the name from the invisible anchor following, 
 9153 #     when the anchor itself is not already named.
 9154 sub extend_ref {
 9155     if ($ref_label !~ /ID=/) { $label .= "\"\n".$name  }
 9156 }
 9157 
 9158 sub remove_cross_ref_marks {
 9159     # Modifies $_
 9160 #    s/$cross_ref_mark#(\w+)#(\w+)>$cross_ref_mark/
 9161     s/$cross_ref_mark#([^#]+)#([^>]+)>$cross_ref_mark/
 9162 	print "\nLOST XREF: $1 : $2" if ($VERBOSITY > 3);''/ego;
 9163 #    s/$cross_ref_mark#(\w+)#\w+>//go;
 9164     s/$cross_ref_mark#([^#]+)#[^#>]+>//go;
 9165 }
 9166 
 9167 sub replace_external_ref_marks {
 9168     # Modifies $_
 9169     local($label, $link);
 9170 #    s/$external_ref_mark#(\w+)#(\w+)>$external_ref_mark/
 9171     s/$external_ref_mark#([^#]+)#([^>]+)>$external_ref_mark/
 9172 	do {($label,$id) = ($1,$2); 
 9173 	    $link = $external_labels{$label};
 9174 	    print "\nLINK: $label : $link" if ($VERBOSITY > 3);
 9175 	    '"'. "$link#$label" . "\">\n"
 9176 	       . &get_ref_mark("userdefined$label",$id)
 9177 	}
 9178     /geo;
 9179 }
 9180 
 9181 sub remove_external_ref_marks {
 9182     # Modifies $_
 9183 #    s/$external_ref_mark#(\w+)#(\w+)>$external_ref_mark/
 9184     s/$external_ref_mark#([^#]+)#([^>]+)>$external_ref_mark/
 9185 	print "\nLOST LINK: $1 : $2" if ($VERBOSITY > 3);''/ego;
 9186 }
 9187 
 9188 sub get_ref_mark {
 9189     local($label,$id) = @_;
 9190     local($val,$tmp,$valno,$valnam,$tmpno,$tmpnam);
 9191     $val = ( ( $SHOW_SECTION_NUMBERS && $symbolic_labels{"$label$id"}) ||
 9192 	     $latex_labels{"userdefined$label$id"} ||
 9193 	     $symbolic_labels{"$label$id"} ||
 9194 	     $latex_labels{$label} ||
 9195 	     $external_latex_labels{$label} ||
 9196 	     $cross_ref_visible_mark );
 9197     # Cut out section name, or number, or both, depending on the option given
 9198     $tmp = $val;
 9199     if ((($tmp =~ s/$next_pair_pr_rx/$valno=$&;$tmpno=$2;''/eo) ||
 9200 	 ($tmp =~ s/$next_pair_rx/$valno=$&;$tmpno=$2;''/eo)) &&
 9201 	($tmp =~ s/^\s*//o) &&
 9202 	(($tmp =~ s/$next_pair_pr_rx/$valnam=$&;$tmpnam=$2;''/eo) ||
 9203 	 ($tmp =~ s/$next_pair_rx/$valnam=$&;$tmpnam=$2;''/eo)) &&
 9204 	$tmp eq '') {
 9205       $valno  = $tmpno  = '' if ($CUT_REF_NUM);
 9206       $valnam = $tmpnam = '' unless ($ADD_REF_NAME);
 9207       $tmp = ' ' if ($tmpno ne '' && $tmpnam ne '');
 9208       $val = join ($tmp, $valno, $valnam);
 9209       $val = $cross_ref_visible_mark if ($tmpno eq '' && $tmpnam eq '');
 9210     }
 9211     $val;
 9212 }
 9213 
 9214 sub get_name_ref_mark {
 9215     # a version of &get_ref_mark without section number, for namerefs
 9216     local($label,$id) = @_;
 9217     local($val,$tmp,$valno,$valnam);
 9218     $val = ( ( $SHOW_SECTION_NUMBERS && $symbolic_labels{"$label$id"}) ||
 9219 	     $latex_labels{"userdefined$label$id"} ||
 9220 	     $symbolic_labels{"$label$id"} ||
 9221 	     $latex_labels{$label} ||
 9222 	     $external_latex_labels{$label} ||
 9223 	     $cross_ref_visible_mark );
 9224     $tmp = $val;
 9225     $val = $valnam if (
 9226       (($tmp =~ s/$next_pair_pr_rx/$valno=$&;''/eo) ||
 9227        ($tmp =~ s/$next_pair_rx/$valno=$&;''/eo)) &&
 9228       ($tmp =~ s/^\s*//o) &&
 9229       (($tmp =~ s/$next_pair_pr_rx/$valnam=$&;''/eo) ||
 9230        ($tmp =~ s/$next_pair_rx/$valnam=$&;''/eo)) &&
 9231       $tmp eq '');
 9232     $val;
 9233 }
 9234 
 9235 sub replace_bbl_marks {
 9236     # Modifies $_
 9237     s/$bbl_mark#([^#]+)#/$citations{$1}/go;
 9238 }
 9239 
 9240 sub remove_bbl_marks {
 9241     # Modifies $_
 9242     s/$bbl_mark#([^#]+)#//go;
 9243 }
 9244 
 9245 sub replace_image_marks {
 9246     # Modifies $_
 9247     s/$image_mark#([^#]+)#([\.,;:\)\]])?(\001)?([ \t]*\n?)(\001)?/
 9248 	"$id_map{$1}$2$4"/ego;
 9249 #	"$id_map{$1}$2".(($4)?"\n":'')/ego;
 9250 }
 9251 
 9252 sub remove_image_marks {
 9253     # Modifies $_
 9254     s/$image_mark#([^#]+)#//go;
 9255 }
 9256 
 9257 sub replace_icon_marks {
 9258     # Modifies $_
 9259     if ($HTML_VERSION < 2.2 ) {
 9260 	local($icon);
 9261 	s/$icon_mark_rx/$icon = &img_tag($1);
 9262 	    $icon =~ s| BORDER="?\d+"?||;$icon/ego;
 9263     } else {
 9264 	s/$icon_mark_rx/&img_tag($1)/ego;
 9265     }
 9266 }
 9267 
 9268 sub remove_icon_marks {
 9269     # Modifies $_
 9270     s/$icon_mark_rx//go;
 9271 }
 9272 
 9273 sub replace_cite_marks {
 9274     local($key,$label,$text,$file);
 9275     # Modifies $_
 9276     # Uses $citefile set by the thebibliography environment
 9277     local($citefile) = $citefile;
 9278     $citefile =~ s/\#.*$//;
 9279     
 9280     s/#([^#]+)#$cite_mark#([^#]+)#((($OP\d+$CP)|[^#])*)#$cite_mark#/
 9281 	$text = $3; $label= $1; $file='';
 9282 	$text = $cite_info{$1} unless $text;
 9283 	if ($checking_caption){
 9284 	    "$label"
 9285 	} elsif ($citefiles{$cite2bbl_nr{$label}}){
 9286 	    $file = $citefiles{$cite2bbl_nr{$label}};
 9287             $file =~ s:\#.*$::;
 9288 	    &make_named_href('', "$file#$label","$text");
 9289 	} elsif ($citefiles{$2}){
 9290 	    $file = $citefiles{$2};
 9291             $file =~ s:\#.*$::;
 9292 	    &make_named_href('', "$file#$label","$text");
 9293 	} elsif ($PREAMBLE) {
 9294 	    $text || "\#!$1!\#" ;
 9295 	} elsif ($simplifying) {
 9296 	    $text
 9297 	} else {
 9298 	     &write_warnings("\nno reference for citation: $1");
 9299 	     "\#!$1!\#"
 9300 	}/sge ;
 9301     #
 9302     #RRM: Associate the cite_key with  $citefile , for use by other segments.
 9303     if ($citefile) {
 9304         local($cite_key, $cite_ref);
 9305         for $cite_key (sort keys %cite_info) {
 9306             $cite_ref = $cite_info{$cite_key};
 9307 	    if ($ref_files{'cite_'."$cite_key"} ne $citefile) {
 9308 		$ref_files{'cite_'."$cite_key"} = $citefile;
 9309 		$changed = 1; }
 9310 	}
 9311     }
 9312 }
 9313 
 9314 sub remove_cite_marks {
 9315     # Modifies $_
 9316     s/#([^#]+)#$cite_mark#([^#]+)#([^#]*)#$cite_mark#//go;
 9317 }
 9318 
 9319 sub remove_anchors {
 9320 # modifies $_
 9321     s/<A[^>]*>//g;
 9322     s/<\/A>//g;
 9323 }
 9324 
 9325 
 9326 # We need two matching keys to determine section/figure/etc. numbers.
 9327 # The "keys" are the name of the section/figure/etc. and its
 9328 # equivalent in the .aux file (also carrying the number we desire).
 9329 # But both keys might have been translated slightly different,
 9330 # depending on the usage of math, labels, special characters such
 9331 # as umlauts, or simply spacing!
 9332 #
 9333 # This routine tries to squeeze the HTML translated keys such
 9334 # that they match (hopefully very often). -- JCL
 9335 #
 9336 sub sanitize {
 9337     local($_,$mode) = @_;
 9338     &remove_markers;
 9339     &remove_anchors;
 9340     &text_cleanup;
 9341     s/(\&|;SPM)nbsp;//g;            # HWS - LaTeX changes ~ in its .aux files
 9342     #strip unwanted HTML constructs
 9343     s/<\/?(P|BR|H)[^>]*>//g;
 9344     s/\s+//g; #collapse white space
 9345     $_;
 9346 }
 9347 
 9348 # This one removes any HTML markup, so that pure
 9349 # plain text remains. (perhaps with <SUP>/<SUB> tags)
 9350 # As the result will be part of the HTML file, it will be
 9351 # &text_cleanup'd later together with its context.
 9352 #
 9353 sub purify {
 9354     local($_,$strict) = @_;
 9355     &remove_markers;
 9356     #strip unwanted HTML constructs
 9357 #    s/<[^>]*>/ /g;
 9358     s/<(\/?SU[BP])>/>$1>/g unless ($strict);  # keep sup/subscripts ...
 9359     s/<[^>]*>//g;                             # remove all other tags
 9360     s/>(\/?SU[BP])>/<$1>/g unless ($strict);  # ...reinsert them
 9361     s/^\s+|\001//g; s/\s\s+/ /g;              #collapse white space
 9362     $_;
 9363 }
 9364 
 9365 # This one is not as strict as &sanitize.
 9366 # It is chosen to strip section names etc. a bit from
 9367 # constructs so that it better fits a table of contents,
 9368 # label files, etc.
 9369 # As the result will be part of the HTML file, it will be
 9370 # &text_cleanup'd later together with its context.
 9371 #
 9372 sub simplify {
 9373     local($_) = @_;
 9374     local($simplifying) = 1;
 9375     s/$tex2html_envs_rx//g;
 9376     if (/\\/) {
 9377 	local($USING_STYLES) = 0;
 9378 	$_ = &translate_commands($_);
 9379 	undef $USING_STYLES;
 9380     }
 9381     &replace_external_ref_marks if /$external_ref_mark/;
 9382     &replace_cross_ref_marks if /$cross_ref_mark||$cross_ref_visible_mark/;
 9383     &replace_cite_marks if /$cite_mark/;
 9384     # strip unwanted HTML constructs
 9385 #    s/<\/?H[^>]*>/ /g;
 9386     s/<\/?(H)[^>]*>//g;
 9387     s/<\#\d+\#>//g;
 9388     s/^\s+//;
 9389     $_;
 9390 }
 9391 
 9392 #RRM: This extracts $anchor_mark portions from a given chunk of text,
 9393 #     so they can be positioned separately by the calling subroutine.
 9394 # added for v97.2: 
 9395 #  search within the immediately following text also; so that 
 9396 #  \index and \label after section-headings work as expected.
 9397 #
 9398 sub extract_anchors {
 9399     local($search_text, $start_only) = @_; 
 9400     local($anchors) = '';
 9401     local($untranslated_anchors) = '';
 9402 
 9403     do {
 9404 	while ($search_text =~ s/<A[^>]*>($anchor_mark|$anchor_invisible_mark)<\/A>//) {
 9405 	    $anchors .= $&;
 9406 	}
 9407     } unless ($start_only);
 9408     
 9409     $search_text =~ s/\s*(\\protect)?\\(label|index|markright|markboth\s*(($O|$OP)\d+($C|$CP))[^<]*\3)\s*(($O|$OP)\d+($C|$CP))[^<]*\6/
 9410 	$anchors .= $&;''/eg unless ($start_only);
 9411 
 9412     while ( s/^\s*<A[^>]*>($anchor_mark|$anchor_invisible_mark)<\/A>//m) {
 9413 	$untranslated_anchors .= $&;
 9414     }
 9415     while ( s/^\s*(\\protect)?\\(label|index|markright|markboth\s*(($O|$OP)\d+($C|$CP))[^<]*\3)\s*(($O|$OP)\d+($C|$CP))[^<]*\6//) {
 9416 	$untranslated_anchors .= $&;
 9417     }
 9418     if ($TITLE||$start_only) {
 9419 	$anchors .= &translate_commands($untranslated_anchors);
 9420 	$untranslated_anchors = '';
 9421     }
 9422     ($anchors.$untranslated_anchors,$search_text); 
 9423 }
 9424 
 9425 # This routine must be called once on the text only,
 9426 # else it will "eat up" sensitive constructs.
 9427 sub text_cleanup {
 9428     # MRO: replaced $* with /m
 9429     s/(\s*\n){3,}/\n\n/gom;	# Replace consecutive blank lines with one
 9430     s/<(\/?)P>\s*(\w)/<$1P>\n$2/gom;      # clean up paragraph starts and ends
 9431     s/(<!)?---(>)?/(length($1) || length($2)) ? "$1---$2" : "&mdash;"/ge;
 9432     s/(<!)?--(>)?/(length($1) || length($2)) ? "$1--$2" : "&ndash;"/ge;
 9433     s/$O\d+$C//go;		# Get rid of bracket id's
 9434     s/$OP\d+$CP//go;		# Get rid of processed bracket id's
 9435     # Spacing commands
 9436     s/\\( |$)/ /go;
 9437     #JKR: There should be no more comments in the source now.
 9438     #s/([^\\]?)%/$1/go;        # Remove the comment character
 9439     # Cannot treat \, as a command because , is a delimiter ...
 9440     s/\\,/ /go;
 9441     # Replace tilde's with non-breaking spaces
 9442     s/ *~/&nbsp;/g;
 9443 
 9444     ### DANGEROUS ?? ###
 9445     # remove redundant (not <P></P>) empty tags, incl. with attributes
 9446     s/\n?<([^PD >][^>]*)>\s*<\/\1>//g;
 9447     s/\n?<([^PD >][^>]*)>\s*<\/\1>//g;
 9448     # remove redundant empty tags (not </P><P> or <TD> or <TH>)
 9449     s/<\/(TT|[^PTH][A-Z]+)><\1>//g;
 9450     s/<([^PD ]+)(\s[^>]*)?>\n*<\/\1>//g;
 9451 
 9452     
 9453 #JCL(jcl-hex)
 9454 # Replace ^^ special chars (according to p.47 of the TeX book)
 9455 # Useful when coming from the .aux file (german umlauts, etc.)
 9456     s/\^\^([^0-9a-f])/chr((64+ord($1))&127)/ge;
 9457     s/\^\^([0-9a-f][0-9a-f])/chr(hex($1))/ge;
 9458 }
 9459 
 9460 # This is useful for getting words from a title which are not cluttered
 9461 # with tex2html markers or HTML constructs
 9462 sub extract_pure_text {
 9463     local($mode) = @_;
 9464     &text_cleanup;		# Remove marking brackets
 9465 #
 9466 # HWS <hswan@perc.Arco.com>:  Conditionally doing the following
 9467 #     permits equations in section headings.
 9468 #
 9469     if ($mode eq "strict") {
 9470 	s/$image_mark#[^#]*#//g;	# Remove image marker
 9471 	s/$bbl_mark#[^#]*#//g;		# Remove citations marker
 9472         s/<tex2html_percent_mark>/%/g;  # BMcM: Retain % signs...
 9473         s/<tex2html_ampersand_mark>/\&amp;/g;
 9474 	s/tex2html[\w\d]*//g; 	# Remove other markers
 9475 	}
 9476 
 9477 #
 9478 # HWS <hswan@perc.Arco.com>:  Replace next statement with the following two
 9479 #    to permit symbolic links and images to appear in section headings.
 9480 
 9481 #   s/<[^>]*>//go;			# Remove HTML constructs
 9482     s/$OP[^#]*$CP//go;			# Remove <# * #> constructs
 9483     s/<\s*>//go;			# Remove embedded whitespace
 9484 }
 9485 
 9486 ############################ Misc ####################################
 9487 
 9488 # MRO: Print standardized header
 9489 sub banner {
 9490     print <<"EOF";
 9491 This is LaTeX2HTML Version $TEX2HTMLVERSION
 9492 by Nikos Drakos, Computer Based Learning Unit, University of Leeds.
 9493 
 9494 EOF
 9495 }
 9496 
 9497 # MRO: Extract usage information from POD
 9498 sub usage {
 9499     my $start  = 0;
 9500     my $usage  = 'Usage: ';
 9501     my $indent = '';
 9502 
 9503     print (@_, "\n") if @_;
 9504 
 9505 #if @texlive@
 9506     my $perldoc = "perldoc";
 9507 #else
 9508     my $perldoc = "@PERLSCRIPTDIR@${dd}perldoc";
 9509 #fi
 9510     my $script = $SCRIPT || $0;
 9511     open(PIPE, "$perldoc -t $script |")
 9512         || die "Fatal: can't open pipe: $!";
 9513     while (<PIPE>) {
 9514         if (/^\s*$/) {
 9515             next;
 9516         } elsif (/^SYNOPSIS/) {
 9517             $start = 1;
 9518         } elsif (/^\w/) {
 9519             $start = 0;
 9520         } elsif ($start == 1) {
 9521             ($indent) = /^(\s*)/;
 9522             s/^$indent/$usage/;
 9523             $usage =~ s/./ /g;
 9524             $start = 2;
 9525             print $_;
 9526         } elsif ($start == 2) {
 9527             s/^$indent/$usage/;
 9528             print $_;
 9529         }
 9530     }
 9531     close PIPE;
 9532     1;
 9533 }
 9534 
 9535 # The bibliographic references, the appendices, the lists of figures and tables
 9536 # etc. must appear in the contents table at the same level as the outermost
 9537 # sectioning command. This subroutine finds what is the outermost level and
 9538 # sets the above to the same level;
 9539 sub set_depth_levels {
 9540     # Sets $outermost_level
 9541     local($level);
 9542     # scan the document body, not the preamble, for use of sectioning commands
 9543     my ($contents) = $_;
 9544     if ($contents =~ /\\begin\s*((?:$O|$OP)\d+(?:$C|$CP))document\1|\\startdocument/s) {
 9545 	$contents = $';
 9546     }
 9547     #RRM:  do not alter user-set value for  $MAX_SPLIT_DEPTH
 9548     foreach $level ("part", "chapter", "section", "subsection",
 9549 		    "subsubsection", "paragraph") {
 9550 	last if (($outermost_level) = $contents =~ /\\($level)$delimiter_rx/);
 9551 	last if (($outermost_level) = $contents =~ /\\endsegment\s*\[\s*($level)\s*\]/s);
 9552 	if ($contents =~ /\\segment\s*($O\d+$C)[^<]+\1\s*($O\d+$C)\s*($level)\s*\2/s)
 9553 		{ $outermost_level = $3; last };
 9554     }
 9555     $level = ($outermost_level ? $section_commands{$outermost_level} :
 9556 	      do {$outermost_level = 'section'; 3;});
 9557 
 9558     #RRM:  but calculate value for $MAX_SPLIT_DEPTH when a $REL_DEPTH was given
 9559     if ($REL_DEPTH && $MAX_SPLIT_DEPTH) { 
 9560 	$MAX_SPLIT_DEPTH = $level + $MAX_SPLIT_DEPTH;
 9561     } elsif (!($MAX_SPLIT_DEPTH)) { $MAX_SPLIT_DEPTH = 1 };
 9562 
 9563     %unnumbered_section_commands = (
 9564           'tableofcontents', $level
 9565 	, 'listoffigures', $level
 9566 	, 'listoftables', $level
 9567 	, 'bibliography', $level
 9568 	, 'textohtmlindex', $level
 9569         , %unnumbered_section_commands
 9570         );
 9571 
 9572     # This command should mark new section only if requested explicitly
 9573     $unnumbered_section_commands{'printnomenclature'} = $level
 9574         if ($styles_loaded{'nomencl_intoc'});
 9575 
 9576     %section_commands = ( 
 9577 	  %unnumbered_section_commands
 9578         , %section_commands
 9579         );
 9580 }
 9581 
 9582 # Now ignores accents which cannot be translated to ISO-LATIN-1 characters
 9583 # Also replaces ?' and !' ....
 9584 sub replace_strange_accents { 
 9585     &real_replace_strange_accents(@_); # if ($CHARSET =~ /8859[_\-]1$/);
 9586 }
 9587 sub real_replace_strange_accents {
 9588     # Modifies $_;
 9589     s/\?`/&iso_map("iquest", "")/geo;
 9590     s/!`/&iso_map("iexcl", "")/geo;
 9591     s/\\\^\\i /&iso_map("icirc", "")/geo;
 9592     my ($charset) = "${CHARSET}_character_map_inv";
 9593     $charset =~ s/-/_/g;
 9594     # convert upper 8-bit characters
 9595     if (%$charset &&($CHARSET =~ /8859[_\-]1$/)) {
 9596 	s/([\200-\377])/
 9597 	    $tmp = $$charset{'&#'.ord($1).';'};
 9598 	    &mark_string($tmp) if ($tmp =~ m!\{!);
 9599 	    &translate_commands($tmp)
 9600 	/egos
 9601     }
 9602 };
 9603 
 9604 # Creates a new directory or reuses old, perhaps after deleting its contents
 9605 sub new_dir {
 9606     local($this_dir,$mode) = @_;
 9607     local(@files)=();
 9608     $this_dir = '.' unless $this_dir;
 9609     $this_dir =~ s/[$dd$dd]+$//o;
 9610     local($print_dir) = $this_dir.$dd;
 9611     (!$mode && mkdir($this_dir, 0755)) ||
 9612 	do {
 9613 	    print "\nCannot create directory $print_dir: $!" unless ($mode);
 9614 	    if ($REUSE) {
 9615 		print ", reusing it.\n" unless ($mode);
 9616 		&reuse($this_dir,$print_dir);
 9617 	    } else {
 9618 	    	print "\n" unless ($mode);
 9619 		while (! ($answer =~ /^[dqr]$/)) {
 9620 		    if ($mode) {
 9621 			$answer = $mode;
 9622 		    } else { 
 9623 		        print "(r) Reuse the images in the old directory OR\n"
 9624 			    . (($this_dir eq '.') ?
 9625 		"(d) *** DELETE *** the images in $print_dir  OR\n"
 9626 		: "(d) *** DELETE *** THE CONTENTS OF $print_dir  OR\n" )
 9627 			    . "(q) Quit ?\n:";
 9628 		        $answer = scalar(<STDIN>);
 9629 		    };
 9630 		    if ($answer =~ /^d$/) {
 9631                         @files = ();
 9632 			if(opendir(DIR,$this_dir)) {
 9633 			    @files = readdir DIR;
 9634 			    closedir DIR;
 9635                         } else {
 9636                             print "\nError: Cannot read dir '$this_dir': $!\n";
 9637                         }
 9638 			foreach (@files) {
 9639 			    next if /^\.+$/;
 9640 			    if (-d "$this_dir$dd$_") {
 9641 				&new_dir("$this_dir$dd$_",'d');
 9642 			    } elsif ($this_dir eq '.') {
 9643 				L2hos->Unlink($_) if (/\.(pl|gif|png)$/) 
 9644 			    } else {
 9645 				L2hos->Unlink("$this_dir$dd$_"); 
 9646 			    };
 9647 			}
 9648 			return(1) if ($this_dir eq '.');
 9649 			if($mode) {
 9650                   rmdir($this_dir);
 9651                   rmdir($print_dir);
 9652                         }
 9653 			if (!$mode) { &new_dir($this_dir,'r')};
 9654 			return(1);
 9655 		    } elsif ($answer =~ /^q$/) {
 9656 			die "Bye!\n";
 9657 		    } elsif ($answer =~ /^r$/) {
 9658 			&reuse($this_dir,$print_dir);
 9659 			return(1);
 9660 		    } else {print "Please answer r d or q!\n";};
 9661 		}
 9662 	    };
 9663 	};
 9664     1;
 9665 }
 9666 
 9667 sub reuse {
 9668     local($this_dir,$print_dir) = @_;
 9669     $print_dir = $this_dir.$dd unless ($print_dir);
 9670     if (-f "$this_dir$dd${PREFIX}images.pl") {
 9671 	print STDOUT "Reusing directory $print_dir:\n";
 9672 	if (!L2hos->is_absolute_path($this_dir)) {
 9673 	    $this_dir = ".$dd$this_dir";
 9674 	}
 9675 	local($key);
 9676 	require("$this_dir$dd${PREFIX}images.pl");
 9677     }
 9678 }
 9679 
 9680 
 9681 # JCL(jcl-del) - use $CD rather than a space as delimiter.
 9682 # The commands might take white space, or not, depending on
 9683 # their definition. Eg. \relax takes white space, because it's a
 9684 # letter command, but \/ won't.
 9685 # TeX seems to have an internal separator: If \x is " x",
 9686 # and \y is "y", then \expandafter\y \x expands to "y x", TeX
 9687 # hasn't gobbled the space, meaning that spaces are gobbled once
 9688 # when the \y token is consumed, but then never again after \y.
 9689 #
 9690 # The actions below ensure to insert exactly one space after
 9691 # the command name.	# what happens to  `\ '  ?
 9692 # The substition is done twice to handle \one\delimits\another
 9693 # cases.
 9694 # The internal shortcut $CD is then turned into the single
 9695 # space we desire.
 9696 #
 9697 sub tokenize {
 9698     # Modifies $_;
 9699     local($rx) = @_;
 9700     # $rx must be specially constructed, see &make_new_cmd_rx.
 9701     if (length($rx)) {
 9702 	# $1: non-letter cmd, or $2: letter cmd
 9703 	s/$rx/\\$1$2$CD$4/g;
 9704 	s/$rx/\\$1$2$CD$4/g;
 9705 	s/$CD+/ /g;	# puts space after each command name
 9706     }
 9707 }
 9708 
 9709 # When part of the input text contains special perl characters and the text
 9710 # is to be used as a pattern then these specials must be escaped.
 9711 sub escape_rx_chars {
 9712     my($rx) = @_; # must use a copy of the string
 9713     $rx =~ s:([\\(){}[\]\^\$*+?.|]):\\$1:g; $rx; }
 9714 
 9715 # Does not do much but may need it later ...
 9716 # The document environment has to be removed because it spans
 9717 # more than one sections (the translator can only deal with
 9718 # environments wholly contained with sections).
 9719 
 9720 # (Does a little more now ... the end of the preamble is now marked
 9721 # with an internally-generated command which causes all output
 9722 # erroneously generated from unrecognized commands in the preamble
 9723 # to vanish --- rst).
 9724 
 9725 sub remove_document_env {
 9726 #    s/\\begin$match_br_rx[d]ocument$match_br_rx/\\latextohtmlditchpreceding /o;
 9727     if (/\\begin\s*${match_br_rx}document$match_br_rx/) { 
 9728         s/\\begin\s*$match_br_rx[d]ocument$match_br_rx/\\latextohtmlditchpreceding /
 9729     }
 9730 #   s/\\end$match_br_rx[d]ocument$match_br_rx(.|\n)*//o;
 9731     if (/\\end\s*${match_br_rx}document$match_br_rx/) { $_ = $` }
 9732 }
 9733 
 9734 # And here's the code to handle the marker ...
 9735 
 9736 sub do_cmd_latextohtmlditchpreceding {
 9737     local($_) = @_;
 9738     $ref_before = '';
 9739     $_;
 9740 }
 9741 
 9742 print "\n"; # flushes a cache? This helps, for some unknown reason!!
 9743 
 9744 sub do_AtBeginDocument{
 9745     local($_) = @_;
 9746     eval $AtBeginDocument_hook;
 9747     $_;
 9748 }
 9749 
 9750 sub cleanup {
 9751     local($explicit) = @_;
 9752     return unless $explicit || !$DEBUG;
 9753 
 9754     if (opendir(DIR, '.')) {
 9755 	while (defined($_ = readdir(DIR))) {
 9756 	    L2hos->Unlink($_)
 9757 		if /\.ppm$/ || /^${PREFIX}images\.dvi$/ || /^(TMP[-._]|$$\_(image)?)/;
 9758 	}
 9759 	closedir (DIR);
 9760     }
 9761 
 9762     L2hos->Unlink("WARNINGS") if ($explicit &&(-f "WARNINGS"));
 9763 
 9764     if ($TMPDIR && opendir(DIR, $TMPDIR)) {
 9765 	local(@files) = grep(!/^\.\.?$/,readdir(DIR));
 9766 	local($busy);
 9767 	foreach (@files) {
 9768 	    $busy .= $_." " unless (L2hos->Unlink("$TMPDIR$dd$_"));
 9769 	}
 9770 	closedir (DIR);
 9771 	if ($busy) {
 9772 	    print "\n\nFiles: $busy  are still in use.\n\n" if ($DEBUG);
 9773 	} else {
 9774 	    &write_warnings("\n\n Couldn't remove $TMPDIR : $!")
 9775 		unless (rmdir $TMPDIR);
 9776 	}
 9777     }
 9778     if (opendir(DIR, $TMP_)) {
 9779 	local(@files) = grep(!/^\.\.?$/,readdir(DIR));
 9780 	$busy = '';
 9781 	foreach (@files) {
 9782 	    $busy .= "$_ " unless (L2hos->Unlink("$TMP_$dd$_"));
 9783 	}
 9784 	closedir (DIR);
 9785 	local($full_dir) = L2hos->Make_directory_absolute($TMP_);
 9786 	if ($busy) {
 9787 	    print "\n\nFiles: $busy in $full_dir are still in use.\n\n"
 9788 	        if ($DEBUG);
 9789 	} else {
 9790 	    &write_warnings("\n\nCouldn't remove directory '$full_dir': $!")
 9791 		unless (rmdir $full_dir);
 9792 	}
 9793     }
 9794 }
 9795 
 9796 sub handler {
 9797     print "\nLaTeX2HTML shutting down.\n";
 9798     kill ('INT', $child_pid) if ($child_pid);
 9799     &close_dbm_database;
 9800     &cleanup();
 9801     exit(-1);
 9802 }
 9803 
 9804 # Given a filename or a directory it returns the file and the full pathname
 9805 # relative to the current directory.
 9806 sub get_full_path {
 9807     local($file) = @_;
 9808     local($path,$dir);
 9809     if (-d $file) {	# $file is a directory
 9810 	$path = L2hos->Make_directory_absolute($file);
 9811 	$file = '';
 9812 
 9813 # JCL(jcl-dir)
 9814     } elsif ($file =~ s|\Q$dd\E([^$dd$dd]*)$||o ) {
 9815 	$path = $file;
 9816 	$file = $1;
 9817 	$path = L2hos->Make_directory_absolute($path);
 9818 
 9819 #RRM: check within $TEXINPUTS directories
 9820     } elsif (!($TEXINPUTS =~ /^\.$envkey$/)) {
 9821 	#check along directories in the $TEXINPUTS variable
 9822 	foreach $dir (split(/$envkey/,$TEXINPUTS)) {
 9823 	    $dir =~ s/[$dd$dd]$//o;
 9824 	    if (-f $dir.$dd.$file) {
 9825 		$path = L2hos->Make_directory_absolute($dir);
 9826 		last;
 9827 	    }
 9828 	}
 9829     } else {
 9830 	$path = L2hos->Cwd();
 9831     }
 9832     ($path, $file);
 9833 }
 9834 
 9835 
 9836 # Given a directory name in either relative or absolute form, returns
 9837 # the absolute form.
 9838 # Note: The argument *must* be a directory name.
 9839 # The whole function has been moved to override.pm
 9840 
 9841 
 9842 
 9843 # Given a relative filename from the directory in which the original
 9844 # latex document lives, it tries to expand it to the full pathname.
 9845 sub fulltexpath {
 9846     # Uses $texfilepath defined in sub driver
 9847     local($file) = @_;
 9848     $file =~ s/\s//g;
 9849     $file = "$texfilepath$dd$file"
 9850       unless (L2hos->is_absolute_path($file));
 9851     $file;
 9852 }
 9853 
 9854 #RRM  Extended to allow customised filenames, set $CUSTOM_TITLES
 9855 #     or long title from the section-name, set $LONG_TITLES
 9856 #
 9857 sub make_name {
 9858     local($sec_name, $packed_curr_sec_id) = @_;
 9859     local($title,$making_name,$saved) = ('',1,'');
 9860     local($filename) = '';
 9861     if ($LONG_TITLES) {
 9862 	$saved = $_;
 9863 	&process_command($sections_rx, $_) if /^$sections_rx/;
 9864 	$title = &make_long_title($TITLE)
 9865 	    unless ((! $TITLE) || ($TITLE eq $default_title));
 9866 	$_ = $saved;
 9867     } elsif ($CUSTOM_TITLES) {
 9868 	$saved = $_;
 9869 	&process_command($sections_rx, $_) if /^$sections_rx/;
 9870 	$title = &custom_title_hook($TITLE)
 9871 	    unless ((! $TITLE) || ($TITLE eq $default_title));
 9872 	$_ = $saved;
 9873     }
 9874     if ($title) {
 9875 	#ensure no more than 32 characters, including .html extension
 9876 	$title =~ s/^(.{1,27}).*$/$1/;
 9877     	++$OUT_NODE;
 9878 	$filename = join("", ${PREFIX}, $title, $EXTN);
 9879 	# Avoid duplication of filenames
 9880 	unless ($nodenames{$filename}) {
 9881 	    $nodenames{$filename} = 1;
 9882 	} else {
 9883 	    # Duplication detected: add version number to generated filename
 9884 	    $filename =
 9885 		join("", ${PREFIX}, $title, ++$nodenames{$filename}, $EXTN);
 9886 	}
 9887 	$filename;
 9888     } else {
 9889     # Remove 0's from the end of $packed_curr_sec_id
 9890 	$packed_curr_sec_id =~ s/(_0)*$//;
 9891 	$packed_curr_sec_id =~ s/^\d+$//o; # Top level file
 9892 	join("",($packed_curr_sec_id ? 
 9893 	    "${PREFIX}$NODE_NAME". ++$OUT_NODE : $sec_name), $EXTN);
 9894     }
 9895 }
 9896 
 9897 #RRM: redefine this subroutine, to create customised file-names
 9898 #     based upon the actual section title.
 9899 #     The default is empty, so reverts to:  node1, node2, ...
 9900 #
 9901 sub custom_title_hook {
 9902     local($_)= @_;
 9903     "";
 9904 }
 9905 
 9906 
 9907 sub make_long_title {
 9908     local($_)= @_;
 9909     local($num_words) = $LONG_TITLES;
 9910     #RRM:  scan twice for short words, due to the $4 overlap
 9911     #      Cannot use \b , else words break at accented letters
 9912     $_ =~ s/(^|\s)\s*($GENERIC_WORDS)(\'|(\s))/$4/ig;
 9913     $_ =~ s/(^|\s)\s*($GENERIC_WORDS)(\'|(\s))/$4/ig;
 9914     #remove leading numbering, unless that's all there is.
 9915     local($sec_num);
 9916     if (!(/^\d+(\.\d*)*\s*$/)&&(s/^\s*(\d+(\.\d*)*)\s*/$sec_num=$1;''/e))
 9917 	{ $num_words-- };
 9918     &remove_markers; s/<[^>]*>//g; #remove tags
 9919     #revert entities, etc. to TeX-form...
 9920     s/([\200-\377])/"\&#".ord($1).";"/eg;
 9921     $_ = &revert_to_raw_tex($_);
 9922 
 9923     # get $LONG_TITLES number of words from what remains
 9924     $_ = &get_first_words($_, $num_words) if ($num_words);
 9925     # ...and cleanup accents, spaces and punctuation
 9926     $_ = join('', ($SHOW_SECTION_NUMBERS ? $sec_num : ''), $_);
 9927     s/\\\W\{?|\}//g; s/\s/_/g; s/\W/_/g; s/__+/_/g; s/_+$//;
 9928     $_;
 9929 }
 9930 
 9931 
 9932 sub make_first_key {
 9933     local($_);
 9934     $_ = ('0 ' x keys %section_commands);
 9935     s/^0/$THIS_FILE/ if ($MULTIPLE_FILES);  
 9936     chop;
 9937     $_;
 9938 }
 9939 
 9940 # This copies the preamble into the variable $preamble.
 9941 # It also sets the LaTeX font size, if $FONT_SIZE is set.
 9942 sub add_preamble_head {
 9943     $preamble = join("\n", $preamble, @preamble);
 9944     $preamble = &revert_to_raw_tex($preamble);
 9945     $preamble = join ("\n", &revert_to_raw_tex(/$preamble_rx/o),
 9946 				$preamble);
 9947     local($savedRS) = $/; undef $/;
 9948     # MRO: replaced $* with /m
 9949     $preamble =~ /(\\document(style|class))\s*(\[[^]]*\])?\s*\{/sm;
 9950     local($before,$after) = ($`.$1, '{'.$');
 9951     $/ = $savedRS;
 9952     local ($options) = $3;
 9953     if ($FONT_SIZE) {
 9954 	$options =~ s/(1\dpt)\b//;
 9955 	$options =~ s/(\[|\])//g;
 9956 	$options = "[$FONT_SIZE".($options ? ",$options" : '').']';
 9957 	$preamble = join('', $before, $options, $after );
 9958 	&write_mydb_simple("preamble", $preamble);
 9959 	@preamble = split(/\n/, $preamble);
 9960 	$LATEX_FONT_SIZE = $FONT_SIZE;
 9961     }
 9962     if (($options =~ /(1\dpt)\b/)&&(!$LATEX_FONT_SIZE)) {
 9963 	$LATEX_FONT_SIZE = $1;
 9964     }
 9965     #RRM: need to know the font-size before the .aux file is read
 9966     $LATEX_FONT_SIZE = '10pt' unless ($LATEX_FONT_SIZE);
 9967 }
 9968 
 9969 # It is necessary to filter some parts of the document back to raw
 9970 # tex before passing them to latex for processing.
 9971 sub revert_to_raw_tex {
 9972     local($_) = @_;
 9973     local($character_map) = "";
 9974     if ( $CHARSET && $HTML_VERSION ge "2.1" ) {
 9975 	$character_map = ((($CHARSET =~ /utf/)&&!$NO_UTF)?
 9976 			  'iso_10646' : $CHARSET );
 9977 	$character_map =~ tr/-/_/; }
 9978     while (s/$O\s*\d+\s*$C/\{/o) { s/$&/\}/;}
 9979     while (s/$O\s*\d+\s*$C/\{/o) { s/$&/\}/;} #repeat this.
 9980     # The same for processed markers ...
 9981     while ( s/$OP\s*\d+\s*$CP/\{/o ) { s/$&/\}/; }
 9982     while ( s/$OP\s*\d+\s*$CP/\{/o ) { s/$&/\}/;} #repeat this.
 9983 
 9984     s/<BR>/\\\\/g; # restores the \\ from \parbox's
 9985 
 9986     # revert any math-entities
 9987     s/\&\w+#(\w+);/\\$1/g;
 9988     s/\&limits;/\\limits/g;
 9989     s/\\underscore/\\_/g;
 9990     s/\\circflex/\\^/g;
 9991     s/\\space/\\ /g;
 9992     s/;SPMthinsp;/\\,/g;
 9993     s/;SPMnegsp;/\\!/g;
 9994     s/;SPMsp;/\\:/g;
 9995     s/;SPMthicksp;/\\;/g;
 9996     s/;SPMgg;/\\gg /g;
 9997     s/;SPMll;/\\ll /g;
 9998     s/;SPMquot;/"/g;
 9999 
10000     # revert any super/sub-scripts
10001     s/<SUP>/\^\{/g;
10002     s/<SUB>/\_\{/g;
10003     s/<\/SU(B|P)>/\}/g;
10004 
10005 
10006 #    #revert common character entities  ??
10007 #    s/&#92;/\\/g;
10008 
10009 #    # revert special marks
10010 #    s/$percent_mark/\\%/go;
10011 ##    s/$comment_mark(\d+)\n/%$comments{$1}\n/go;
10012     local($tmp,$tmp2);
10013     # only applies if the comment mark is at the end of the line
10014     s/$comment_mark(\d+)(\n|$|(\$))/$tmp=$verbatim{$1};$tmp2 = $3;
10015         ($tmp=~m!^\%!s ? '':'%').$tmp.(($tmp=~ m!\n\s*$!s)?'':"\n").$tmp2/sego;
10016     s/${verbatim_mark}tex2html_code(\d+)\#/$verbatim{$1}/go;
10017     s/^($file_mark|$endfile_mark).*\#\n//gmo;
10018     s/$comment_mark(\d*)\s*\n/%\n/go;
10019     s/$dol_mark/\$/go;
10020     s/$caption_mark//go;
10021 
10022     # From &pre_process.
10023     # MRO: replaced $* with /m
10024     s/\\\\[ \t]*(\n)?/\\\\$1/gm;
10025 
10026     # revert any array-cell delimiters
10027     s/$array_col_mark/\&/g;
10028     s/$array_row_mark/\\\\/g;
10029     s/$array_text_mark/\\text/g;
10030     s/$array_mbox_mark/\\mbox/g;
10031 
10032     # Replace any verbatim and image markers ...
10033     &revert_verbatim_marks;
10034     &revert_verb_marks;
10035 
10036 
10037 #    &replace_image_marks;
10038     s/$image_mark\#([^\#]+)\#/&recover_image_code($1)/eg;
10039 
10040     # remove artificial environments and commands
10041 
10042     s/(\n*)\\(begin|end)(($O|$OP)\d+($C|$CP))tex2html_b(egin)?group\3\n?/
10043 	($1? "\n":'')."\\".($6? $2:(($2 =~ m|end|)? 'e':'b'))."group\n"
10044     /gem;
10045     s/\\(begin|end)(\{|(($O|$OP)\d+($C|$CP|\})))(tex2html|verbatim)_code(\}|\3)\n?//gm;
10046 
10047     #take care not to concatenate \<cmd> with following letters
10048     local($tmp);
10049     s/(\\\w+)?$tex2html_wrap_rx([^\\\n])?/$tmp=$2;
10050         ((($tmp eq 'end')&&($1)&&!($5)&&($6))? "$1 $6":"$1$5$6")/egs;
10051     undef $tmp;
10052     s/\s*\\newedcommand\s*{/"%\n\\providecommand{\\"/gem;
10053     s/\\newedcommand\s*{/\\providecommand{\\/gom;
10054 #    s/(\n*)\\renewedcommand{/($1? "\n":'')."\\renewcommand{\\"/geo;
10055     s/\s*\\providedcommand\s*{/"%\n\\providecommand{\\"/gem;
10056 #    s/\\providedcommand{/\\providecommand{\\/go;
10057     s/\\renewedenvironment\s*/\\renewenvironment/gom;
10058     s/\\newedboolean\s*{/\\newboolean{/gom;
10059     s/\\newedcounter\s*{/\\newcounter{/gom;
10060     s/\\newedtheorem\s*{/\\newtheorem{/gom;
10061     s/\\xystar/\\xy\*/gom; # the * has a special meaning in Xy-pic
10062 
10063     #fix-up the star'd environment names
10064     s/(\\(begin|end)(($O|$OP)\d+($C|$CP))[^<]*)star\3/$1\*$3/gm;
10065     s/(\\(begin|end)\{[^\}]*)star\}/$1\*\}/gm;
10066     s/\\(begin|end)\{[^\}]*begin(group)\}/\\$1$2/gm;
10067     s/\\(b|e)(egin|end)\{[^\}]*b(group)\}/\\$1$3/gm;
10068 
10069     s/(\\(\w+)TeX)/($language_translations{$2}? "\\selectlanguage{$2}": $1)/egom;
10070 
10071     if ($PREPROCESS_IMAGES) {
10072       while (/$pre_processor_env_rx/m) {
10073 	$done .= $`; $pre_env = $5; $which =$1; $_ = $';
10074         if (($which =~ /begin/)&&($pre_env =~ /indica/)) {
10075 	    ($indic, $dum) = &get_next_optional_argument;
10076 	    $done .= "\#$indic";
10077         } elsif (($which =~ /begin/)&&($pre_env =~ /itrans/)) {
10078 	    ($indic, $dum) = &get_next_optional_argument;
10079 	    $done .= "\#$indic";
10080         } elsif (($which =~ /end/)&&($pre_env =~ /indica/)) {
10081 	    $done .= '\#NIL';
10082         } elsif (($which =~ /end/)&&($pre_env =~ /itrans/)) {
10083 	    $done .= "\#end$indic";
10084 	} elsif ($which =~ /begin/) {
10085 	    $done .= (($which =~ /end/)? $end_preprocessor{$pre_env}
10086 		          : $begin_preprocessor{$pre_env} )
10087 	}
10088 	$_ = $done . $_;
10089       }
10090     }
10091     s/\\ITRANSinfo\{(\w+)\}\{([^}]*)\}/\#$1=$2/gm if $itrans_loaded;
10092 
10093     s/\n{3,}/\n\n/gm; # remove multiple (3+) new-lines 
10094     s/^\n+$//gs; # ...especially if that is all there is!
10095     if ($PREAMBLE) {
10096 	s/$comment_mark(\d+\n?)?//g;
10097 #	$preamble =~ s/\\par\n?/\n/g;
10098 	s/\\par\b/\n/g;
10099 	s/^\s*$//g; #remove blank lines in the preamble
10100     };
10101 
10102     s/($html_specials_inv_rx)/$html_specials_inv{$1}/geo;
10103     # revert entities to TeX code, except if in {rawhtml} environments
10104     if (!($env =~ /rawhtml/)) {
10105         s/$character_entity_rx/( $character_map ?
10106 	  eval "\$${character_map}_character_map_inv\{\"$1\"\}" :
10107 	    $iso_8859_1_character_map_inv{$1} ||
10108 	      $iso_10646_character_map_inv{$1})/geo;
10109         s/$named_entity_rx/( $character_map ? 
10110 	  eval "\$${character_map}_character_map_inv\{\$${character_map}_character_map{'$1'}}" :
10111 	    $iso_8859_1_character_map_inv{$iso_8859_1_character_map{$1}} ||
10112 	      $iso_10646_character_map_inv{$iso_10646_character_map{$1}})/geo;
10113 
10114     } else {
10115         #RRM: check for invalid named entities in {rawhtml} environments
10116 	s/($named_entity_rx)/&write_warnings(
10117 	    "An unknown named entity ($1) appears in the source text.") unless (
10118 		 $character_map && eval 
10119 	  "\$${character_map}_character_map_inv\{\$${character_map}_character_map{'$2'}}");
10120 		     ";SPM$2;"/ego;
10121     }
10122 
10123     #RRM: check for numbered character entity out-of-range
10124     if ($HTML_VERSION < 4.0) {
10125 	s/$character_entity_rx/&write_warnings(
10126 	    "An invalid character entity ($1) appears in the source text.")
10127 	     if ($2 > 255);
10128 	$1/ego; }
10129 
10130     #RRM: check for invalid named entities outside {rawhtml} environments
10131     # --- these should have been caught already, but check again
10132     s/$named_entity_rx/&write_warnings(
10133 	    "An unknown named entity ($1) appears in the source text.") unless (
10134 	$character_map && eval 
10135 	  "\$${character_map}_character_map_inv\{\$${character_map}_character_map{'$1'}}");
10136 		     $1/ego;
10137 
10138     &revert_to_raw_tex_hook if (defined &revert_to_raw_tex_hook);
10139     $_;
10140 }
10141 
10142 sub next_wrapper {
10143     local($dollar) = @_;
10144     local($_,$id);
10145     $wrap_toggle = (($wrap_toggle eq 'end') ? 'begin' : 'end');
10146     $id = ++$global{'max_id'};
10147     $_ = "\\$wrap_toggle$O$id$C"."tex2html_wrap$O$id$C";
10148     $_ = (($wrap_toggle eq 'end') ? $dollar.$_ : $_.$dollar);
10149     $_;
10150 }
10151 
10152 sub make_wrapper {
10153     &make_any_wrapper($_[0], '', "tex2html_wrap");
10154 }
10155 
10156 sub make_nowrapper {
10157     &make_any_wrapper($_[0], 1, "tex2html_nowrap");
10158 }
10159 
10160 sub make_inline_wrapper {
10161     &make_any_wrapper($_[0], '', "tex2html_wrap_inline");
10162 }
10163 
10164 sub make_deferred_wrapper {
10165     &make_any_wrapper($_[0], 1, "tex2html_deferred");
10166 }
10167 
10168 sub make_nomath_wrapper {
10169     &make_any_wrapper($_[0], '', "tex2html_nomath_inline");
10170 }
10171 
10172 sub make_any_wrapper {
10173     local($toggle,$break,$kind) = @_;
10174     local($max_id) = ++$global{'max_id'};
10175     '\\'. (($toggle) ? 'begin' : 'end')
10176 	. "$O$max_id$C"."$kind$O$max_id$C"
10177 	. (($toggle || !$break) ? '' : '');
10178 }
10179 
10180 sub get_last_word {
10181     # Returns the last word in multi-line strings
10182     local($_) = @_;
10183     local ($word,$lastbit,$which);
10184 #JCL(jcl-tcl)
10185 # also remove anchors and other awkward HTML markup
10186 #    &extract_pure_text("strict");
10187 ##    $_ = &purify($_);  ## No. what if it is a verbatim string or image?
10188 #
10189 #    while (/\s(\S+)\s*$/g) { $word = $lastbit = $1;}
10190 
10191     if (!$_ && (defined $keep)) {
10192 	# inside mathematics !
10193 	$_ = $keep . $pre ;
10194     }
10195     if (!$_ && $ref_before) { $_ = $ref_before; }
10196     elsif (!$_) {
10197 	# get it from last thing before the current environment
10198 	$which = $#processedE;
10199 	$_ = $processedE[$which];
10200     }
10201 
10202     while (/((($O|$OP)\d+($C|$CP))[.\n]*\2|\s(\S+))\s*$/g)
10203 	{ $word = $lastbit = $1 }
10204     if (($lastbit =~ s/\$\s*$//)||(defined $keep)) {
10205 	local($br_idA) = ++$global{'max_id'};
10206 	local($br_idB) = ++$global{'max_id'};
10207 	$lastbit = join('', "\\begin $O$br_idA${C}tex2html_wrap_inline$O$br_idA$C\$"
10208 		, $lastbit, "\$\\end $O$br_idB${C}tex2html_wrap_inline$O$br_idB$C");
10209 	$lastbit = &translate_environments($lastbit);
10210 	$lastbit = &translate_commands($lastbit);
10211 	return ($lastbit);
10212     }
10213     if ($lastbit =~ s/($O|$OP)\d+($C|$CP)//g) { return ($lastbit); }
10214     elsif ($lastbit eq '') { return ($_) }
10215 
10216     local($pre_bit);
10217     if ($lastbit =~/>([^>]*)$/) { 
10218 	$word = $1; $pre_bit = $`.'>';
10219 	if ($pre_bit =~ /($verb_mark|$verbstar_mark|$verblst_mark)$/) {
10220 	    $word = $lastbit;
10221 	} elsif ($pre_bit =~ /<\w+_mark>$/) {
10222 	    $word = $& . $word;
10223 	} elsif (!($word)) {
10224 	    if ($lastbit =~ s/<([^\/][^>]*)>$//o)
10225 	        { $word=$1; $pre_bit = $`; }
10226 	    elsif ($lastbit =~ s/>([^<]*)<\/[^>]*>//o)
10227 	        { $word=$1; $pre_bit = $`.'>' }
10228 	    else { $word = ";SPMnbsp;"; }
10229 	}
10230 #	if ($pre_bit =~ /<\w+_mark>$/) { $word = $& . $word }
10231      } else { $word = $lastbit };
10232     $word;
10233 }
10234 
10235 #JCL(jcl-tcl)
10236 # changed completely
10237 #
10238 # We take the first real words specified by $min from the string.
10239 # Allow for simple HTML constructs like <I>...</I> (but not <H*>
10240 # or <P*> and the like), math, or images to remain in the result,
10241 # not counting as words.
10242 # Take care that eg. <I>...</I> grouping tags are not broken.
10243 # This is achieved by lifting the markup, removing superfluous
10244 # words, re-inserting the markup, and throw empty markup away.
10245 # In later versions images could be modified such that they become
10246 # thumbnail sized.
10247 #
10248 # rawhtml or verbatim environments might introduce lots of awkward
10249 # stuff, but yet we leave the according tex2html markers in.
10250 #
10251 sub get_first_words {
10252     local($_, $min) = @_;
10253     local($words,$i);
10254     local($id,%markup);
10255     #no limit if $min is negative
10256     $min = 1000 if ($min < 0);
10257 
10258     &remove_anchors;
10259     #strip unwanted HTML constructs
10260     s/<\/?(P|BR|H)[^>]*>/ /g;
10261     #remove leading white space and \001 characters
10262     s/^\s+|\001//g;
10263     #lift html markup, numbered for recovery
10264     s/(<[^>]*>(#[^#]*#)?)/$markup{++$id}=$1; "\000$id\000"/ge;
10265 
10266     foreach (split /\s+|\-{3,}/) {
10267         # count words (incl. HTML markup as part of the word)
10268         ++$i; 
10269 #	$words .= $_ . " " if (/\000/ || ($i <= $min));
10270 	$words .= $_ . " " if ($i <= $min);
10271     }
10272     $_ = $words;
10273     chop;
10274 
10275     #re-insert markup
10276     s/\000(\d+)\000/$markup{$1}/g;
10277     # remove empty markup
10278     # it's normalized, because generated by LaTeX2HTML only
10279     s/<([A-Z]+)[^>]*>\s*<\/\1>\s*//g;
10280     $_;
10281 }
10282 
10283 sub replace_word {
10284     # Replaces the LAST occurrence of $old with $new in $str;
10285     local($str, $old, $new) = @_;
10286     substr($str,rindex($str,$old),length($old)) = $new;
10287     $str;
10288 }
10289 
10290 # Returns the recognised sectioning commands as a string of alternatives
10291 # for use in regular expressions;
10292 sub get_current_sections {
10293     local($_, $key);
10294     foreach $key (sort keys %section_commands) {
10295 	if ($key =~ /star/) {
10296 	    $_ = $key . "|" . $_}
10297 	else {
10298 	    $_ .= "$key" . '[*]?|';
10299 	}
10300     }
10301     chop;			# Remove the last "|".
10302     $_;
10303 }
10304 
10305 sub numerically {
10306     local(@x) = split(' ',$a);
10307     local(@y) = split(' ',$b);
10308     local($i, $result);
10309     for($i=0;$i<$#x;$i++) {
10310        last if ($result = ($x[$i] <=> $y[$i]));
10311     }
10312     $result
10313 }
10314 
10315 # Assumes that the files to be sorted are of the form
10316 # <NAME><NUMBER>
10317 sub file_sort {
10318     local($i,$j) = ($a,$b);
10319     $i =~ s/^[^\d]*(\d+)$/$1/;
10320     $j =~ s/^[^\d]*(\d+)$/$1/;
10321     $i <=> $j
10322 }
10323 
10324 # If a normalized command name exists, return it.
10325 sub normalize {
10326     # MRO: modified to use $_[1]
10327     # local($cmd,*after) = @_;
10328     my $cmd =$_[0];
10329     my $ncmd;
10330     # Escaped special LaTeX characters
10331     if ($cmd =~ /^($latex_specials_rx)/) {
10332 #	$cmd =~ s/&(.*)$/&amp;$1/o;
10333 	$cmd =~ s/&(.*)$/$ampersand_mark$1/o;
10334         $cmd =~ s/%/$percent_mark/o;
10335 	$_[1] = join('', $cmd, $_[1]);
10336 	$cmd = ""}
10337     elsif ($ncmd = $normalize{$cmd}) {
10338 	$ncmd;
10339     }
10340     else {
10341  	$cmd =~ s/[*]$/star/;
10342  	$cmd =~ s/\@/_at_/g;
10343 	$cmd;
10344     }
10345 }
10346 
10347 sub normalize_sections {
10348     my $dummy = '';
10349     # MRO: s/$sections_rx/'\\' . &normalize($1.$2,*after) . $4/ge;
10350     s/$sections_rx/'\\' . &normalize($1.$2,$dummy) . $4/ge;
10351 }
10352 
10353 sub embed_image {
10354     my ($url,$name,$external,$altst,$thumbnail,$map,$align,
10355 	$usemap,$exscale,$exstr) = @_;
10356     my $imgID = '';
10357     my $urlimg = $url;
10358     my $ismap = $map ? " ISMAP" : '';
10359     my $imagesize;	# sting in format "WIDTH=X HEIGHT=X"
10360     print "\nembedding $url for $name, with $altst\n" if ($VERBOSITY > 1);
10361 
10362     if (! ($NO_IMAGES || $PS_IMAGES)) {
10363 	# for over-scaled GIFs with pre-determined sizes	# RRM 11-9-96
10364 	if (($width{$name})&&(($exscale)||($EXTRA_IMAGE_SCALE))) {
10365 	    $exscale = $EXTRA_IMAGE_SCALE unless ($exscale);
10366 	    if ($name =~ /inline|indisplay|entity|equation|math|eqn|makeimage/){
10367 		($imagesize, $imgID) = &get_image_size($url, $exscale);
10368 	    } else {
10369 		($imagesize, $imgID) = &get_image_size($url,'');
10370 	    }
10371 	} elsif ($USE_DVIPNG && $DVIPNG_DPI && $exscale &&
10372 		 $name !~ /inline|display|entity|equation|math|eqn|makeimage|figure|tab/) {
10373 	    # use scaling calculated by extract_image for dvipng mode
10374 	    ($imagesize,$imgID) = &get_image_size($url, $exscale);
10375 	} else {
10376 	    ($imagesize,$imgID) = &get_image_size($url,'');
10377 	}
10378 	$image_size{$url} = $imagesize
10379 	    unless ((! $imagesize) || ($imagesize eq "WIDTH=\"0\" HEIGHT=\"0\""));
10380 	$url = &find_unique($url);
10381     }
10382 
10383     $urlimg = $url;
10384     $urlimg =~ s/\.$IMAGE_TYPE$/.html/ if ($map);
10385     if ($exstr =~ s/align\s*=\s*(\"?)(\w+)\1($|\s|,)//io) { $align = $2; }
10386     my $usersize = '';
10387     if ($exstr =~ s/width\s*=\s*(\"?)([^\s,]+)\1($|\s|,)//io) {
10388 	my ($pxs,$len) = &convert_length($2);
10389 	$usersize = " WIDTH=\"$pxs\"";
10390     }
10391     if ($exstr =~ s/height\s*=\s*(\"?)([^\s,]+)\1($|\s|,)//io) { 
10392 	my ($pxs,$len) = &convert_length($2);
10393 	$usersize .= " HEIGHT=\"$pxs\"";
10394     }
10395     $imagesize = $usersize if ($usersize ne '');
10396 
10397     my $border = '';	# default border is 0
10398 
10399     my $aalign;		# css style
10400     if (($name =~ /figure|table|displaymath\d+|eqnarraystar/)&&(!$align)) {
10401 	if ($eheight{$name}){
10402 	    $aalign = sprintf ( "height: \%.2fex; ", $eheight{$name} );
10403 	}
10404     } elsif (($name =~ /(equation|eqnarray)($|\d)/)&&(!$align)) {
10405 	if ($HTML_VERSION >= 3.2) {
10406 	    $aalign =  ($EQN_TAGS eq "L") ? "float:RIGHT;" : "float:LEFT;";
10407 	}
10408     } elsif ($eheight{$name}){
10409 	# used with -use_dvipng and with -image_type svg
10410 	$aalign = sprintf ( "height: \%.2fex; vertical-align: \%.2fex; ",
10411 			    $eheight{$name} ,
10412 			    -$edepth{$name} );
10413     } elsif ($depth{$name}) {
10414 	# ALIGN=MIDDLE aligns middle of image to baseline of text
10415 	my ($height_pxs) = ($imagesize =~ /HEIGHT=\"(\d+)\"/i);
10416 	my $depth = $height_pxs*$depth{$name}/($height{$name}+$depth{$name});
10417 	$aalign = "vertical-align:-${depth}px".$border;	
10418     } elsif ($name =~ /inpar/m) {
10419 	$aalign = "vertical-align:TOP;".$border;
10420     } else {  $aalign = "".$border }
10421 
10422     $aalign = "\U$align" if $align;
10423     my $ausemp = $usemap ? "\UUSEMAP=$usemap" : '';
10424 
10425     #append any extra valid options 
10426     $ismap .= &parse_keyvalues ($exstr, ("IMG")) if ($exstr);
10427 
10428     $altst = '' if ($ismap =~ /(^|\s+)ALT\s*=/);
10429     if ($altst) {
10430 	if ($altst =~ /\s*ALT="?([^\"]+)"?\s*/io) { $altst=$1 }
10431 	$altst =~ s/[<>"&]/'&'.$html_special_entities{$&}.';'/eg;
10432 	$altst = "\n ALT=\"$altst\"";
10433     }
10434 
10435     my ($extern_image_mark);
10436     if ($thumbnail) {
10437 	print "\nmaking thumbnail" if ($VERBOSITY > 1);
10438 	if (($image_size{$thumbnail}) = &get_image_size($thumbnail,'')) {
10439 	    $thumbnail = &find_unique($thumbnail);
10440 	    my $th_imagesize = " ".$image_size{$thumbnail};
10441 	    $extern_image_mark = join('',"<IMG"
10442 		, "\n$th_imagesize"
10443 		, (($aalign) ? " STYLE=\"vertical-align:$aalign\"" : '')
10444 		, ("$aalign$imagesize" ? "\n" : '' )
10445 		, " SRC=\"$thumbnail\"$altst>");
10446 	}
10447 	$extern_image_mark =~ s/\s?BORDER="?\d+"?//
10448             unless ($exstr =~ /BORDER/i);
10449     } else { 
10450         # MRO: dubious (&extern_image_mark takes only one arg)
10451         # shige 07/20 2017 for $PS_IMAGES
10452         my ($typename) = ($PS_IMAGES) ? "ps" : $IMAGE_TYPE;
10453         $extern_image_mark = &extern_image_mark($typename, $altst);
10454     }
10455 
10456     my ($anch1,$anch2) = ('','');
10457     my $result;
10458     if ($external || $thumbnail || $EXTERNAL_IMAGES) {
10459 	if ( $extern_image_mark ) {
10460 	    $result = &make_href_noexpand($urlimg, $name , $extern_image_mark);
10461 	    &save_image_map($url, $urlimg, $map, $name, $altst, $ausemp) if $map;
10462 	}
10463     } else {
10464 	if ($map) {
10465 	    $anch1 = "<A HREF=\"$map\">";
10466 	    $anch2 = "</A>";
10467 	}
10468 #	if ($aalign eq "CENTER") {
10469 #	    if ($HTML_VERSION eq "2.0") {
10470 #	        $anch1 .= "\n<P ALIGN=\"CENTER\">";
10471 #	        $anch2 .= "</P>";
10472 #	    } else {
10473 #	        $anch1 .= "\n<DIV ALIGN=\"CENTER\">";
10474 #	        $anch2 .= "</DIV>";
10475 #	    }
10476 #	}
10477 
10478 	if ($HTML_VERSION < 2.2 ) {
10479 	    # put the WIDTH/HEIGHT information into the ALT string
10480 	    # first removing the quotes
10481 	    my ($noquotes) = $imagesize;
10482 	    $noquotes =~ s/\"//g;
10483 	    $altst =~ s/"$/\% $noquotes "/m;
10484 	}
10485 
10486 	# include a stylesheet entry for each included image
10487 	if ($USING_STYLES && $SCALABLE_IMAGES &&(!$imgID)) {
10488 	    if ($url =~ /($dd|^)([^$dd$dd]+)\.$IMAGE_TYPE$/) {
10489 		my $img_name = $2;
10490 		$imgID = $img_name . ($img_name =~ /img/ ? '' : $IMAGE_TYPE);
10491 		$img_style{"$imgID"} = ' ' unless $img_style{"$imgID"};
10492 		$imgID = join('', ' CLASS="', $imgID, '"') if $imgID;
10493 	    }
10494 	}
10495 
10496 	### MEH Add width and height to IMG
10497 	### Patched by <hswan@perc.Arco.com>:  Fixed \htmladdimg
10498 	### SGE: if user size (as $exstr) or dvipng scaling (as $exscale)
10499 	### specified, then add width and height to ensure desired image size
10500 #	if ( $imagesize || $name eq "external image" || $NO_IMAGES || $PS_IMAGES) {
10501 	    $imagesize = '' if ($HTML_VERSION < 2.2 );
10502 	    $imagesize = '' if ($aalign =~ /height/i);
10503 	    if ($border =~ s/^"//) { $border .= '"' };
10504 	    $result = join(''
10505 		   , "<IMG$imgID"
10506 		   , "\n", (($usersize ||
10507 			     ($USE_DVIPNG && $DVIPNG_DPI && $exscale &&
10508 			      $name !~ /inline|display|entity|equation|math|eqn|makeimage|figure|tab/))
10509 			    ? " $imagesize" : '')
10510 		#		   , (($aalign)? " ALIGN=\"$aalign\"" : $border)
10511 		   , " STYLE=\"$aalign\""
10512 		   , $ismap );
10513 	    if ($ausemp) { $result .= " $ausemp" }
10514 	    $result .= "\n" unless (($result =~ /\n *$/m)|| !$imagesize);
10515 	    $result .= " SRC=\"$url\"";
10516 	    if ($altst) { $result .= $altst }
10517 	    $result .= ">";
10518 #	}
10519     }
10520     # join('',$anch1, $result, $anch2);
10521     # 2020-03-03 shige:
10522     (join('',$anch1, $result, $anch2), $imagesize);
10523 }
10524 
10525 # MRO: added PNG support
10526 sub get_image_size { # clean
10527     my ($imagefile, $scale) = @_;
10528 
10529     $scale = '' if ($scale == 1);
10530     my ($imgID,$size) = ('','');
10531     if (open(IMAGE, "<$imagefile")) {
10532         my ($buffer,$magic,$dummy,$width,$height) = ('','','',0,0);
10533 	binmode(IMAGE); # not harmful un UNIX
10534         if ($IMAGE_TYPE =~ /gif/) {
10535 	    read(IMAGE,$buffer,10);
10536 	    ($magic,$width,$height) = unpack('a6vv',$buffer);
10537             # is this image sane?
10538 	    unless($magic =~ /^GIF8[79]a$/ && ($width * $height) > 0) {
10539                 $width = $height = 0;
10540 	    }
10541         }
10542         elsif ($IMAGE_TYPE =~ /png/) {
10543             read(IMAGE,$buffer,24);
10544 	    ($magic,$dummy,$width,$height) = unpack('a4a12NN',$buffer);
10545 	    unless($magic eq "\x89PNG" && ($width * $height) > 0) {
10546                 $width = $height = 0;
10547             }
10548 	}
10549 	close(IMAGE);
10550 
10551 	# adjust for non-trivial $scale factor.
10552         my ($img_w,$img_h) = ($width,$height);
10553 	if ($scale && ($width * $height) > 0) {
10554             $img_w = int($width / $scale + .5);
10555             $img_h = int($height / $scale + .5);
10556 	}
10557 	$size = qq{WIDTH="$img_w" HEIGHT="$img_h"};
10558 
10559 	# allow height/width to be stored in the stylesheet
10560 	my ($img_name,$imgID);
10561 	if ($SCALABLE_IMAGES && $USING_STYLES) {
10562 	    if ($imagefile =~ /(^|[$dd$dd])([^$dd$dd]+)\.(\Q$IMAGE_TYPE\E|old)$/o) {
10563 		$img_name = $2;
10564 		$imgID = $img_name . ($img_name =~ /img/ ? '' : $IMAGE_TYPE);
10565 	    }
10566 	    if ($imgID) {
10567 		$width = $width/$LATEX_FONT_SIZE/$MATH_SCALE_FACTOR;
10568 		$height = 1.8 * $height/$LATEX_FONT_SIZE/$MATH_SCALE_FACTOR;
10569 		# How wide is an em in the most likely browser font ?
10570 		if ($scale) {
10571 		# How high is an ex in the most likely browser font ?
10572 		    $width = $width/$scale; $height = $height/$scale;
10573 		}
10574 		$width = int(100*$width + .5)/100;
10575 		$height = int(100*$height + .5)/100;
10576 		$img_style{$imgID} = qq(width:${width}em ; height:${height}ex );
10577 		#join('','width:',$width,'em ; height:',$height,'ex ');
10578 		$imgID = qq{ CLASS="$imgID"};
10579 	    }
10580 	}
10581     }
10582     ($size, $imgID);
10583 }
10584 
10585 sub find_unique { # clean
10586     my ($image1) = @_;
10587     local($/) = undef; # slurp in complete files
10588 
10589     my $imagedata;
10590     if(open(IMG1,"<$image1")) {
10591 	binmode(IMG1); # needed with .png under DOS
10592         $imagedata = <IMG1>;
10593         close(IMG1);
10594     } else {
10595         print "\nError: Cannot read '$image1': $!\n"
10596 	    unless ($image1 =~ /^\s*$HTTP_start/i);
10597         return $image1;
10598     }
10599 
10600     my ($image2,$result);
10601     foreach $image2 (keys(%image_size)) {
10602 	if ( $image1 ne $image2 &&
10603 	    $image_size{$image1} eq $image_size{$image2} ) {
10604 	    if(open(IMG2,$image2)) {
10605 		binmode(IMG2); # needed with .png under DOS
10606 	        $result = ($imagedata eq <IMG2>);
10607 	        close(IMG2);
10608             } else {
10609                 print "\nWarning: Cannot read '$image2': $!\n"
10610 		    unless ($image2 =~ /^\s*$HTTP_start/i);
10611             }
10612 #
10613 #  If we've found a match, rename the new image to a temporary one.
10614 #  Then try to link the new name to the old image.
10615 #  If the link fails, restore the temporary image.
10616 #
10617 	    if ( $result ) {
10618 		my $tmp = "temporary.$IMAGE_TYPE";
10619 		L2hos->Unlink($tmp);
10620 		L2hos->Rename($image1, $tmp);
10621 		if (L2hos->Link($image2, $image1)) {
10622                     L2hos->Unlink($tmp);
10623                 } else {
10624                     L2hos->Rename($tmp, $image1);
10625                 }
10626 		return $image1;
10627 	    }
10628 	}
10629     }
10630     $image1;
10631 }
10632 
10633 sub save_image_map { # clean
10634     my ($url, $urlimg, $map, $name, $altst, $ausemp) = @_;
10635     unless(open(IMAGE_MAP, ">$urlimg")) {
10636         print "\nError: Cannot write '$urlimg': $!\n";
10637         return;
10638     }
10639     ### HWS  Pass server map unchanged from user
10640     print IMAGE_MAP "<HTML>\n<BODY>\n<A HREF=\"$map\">\n";
10641     print IMAGE_MAP "<IMG\n SRC=\"$url\" ISMAP $ausemp $altst> </A>";
10642     print IMAGE_MAP "</BODY>\n</HTML>\n";
10643     close IMAGE_MAP;
10644 }
10645 
10646 #  Subroutine used mainly to rename an old image file about to recycled.
10647 #  But for active image maps, we must edit the auxiliary HTML file to point
10648 #     to the newly renames image.
10649 sub rename_html {
10650     local ($from, $to) = @_;
10651     local ($from_prefix, $to_prefix, $suffix);
10652     ($from_prefix, $suffix) = split(/\./, $from);
10653     ($to_prefix, $suffix) = split(/\./, $to);
10654     if ($EXTN =~ /$suffix$/) {
10655 	if (open(FROM, "<$from") && open(HTMP, ">HTML_tmp")) {
10656 	    while (<FROM>) {
10657 		s/$from_prefix\.$IMAGE_TYPE/$to_prefix.$IMAGE_TYPE/g;
10658 		print HTMP;
10659 	    }
10660 	    close (FROM);
10661 	    close (HTMP);
10662 	    L2hos->Rename ("HTML_tmp", $to);
10663 	    L2hos->Unlink($from) unless ($from eq $to);
10664 	}
10665 	else {
10666 	    &write_warnings("File $from is missing!\n");
10667 	}
10668     }
10669     L2hos->Rename("$from_prefix.old", "$to_prefix.$IMAGE_TYPE");
10670     $to;
10671 }
10672 
10673 sub save_captions_in_file {
10674     local ($type, $_) = @_;
10675     if ($_) {
10676 	s/^\n//om;
10677 	&replace_markers;
10678 	&add_dir_to_href if ($DESTDIR);
10679 	if(open(CAPTIONS, ">${PREFIX}$type.pl")) {
10680 	    print CAPTIONS $_;
10681 	    close (CAPTIONS);
10682         } else {
10683             print "\nError: Cannot write '${PREFIX}$type.pl': $!\n";
10684         }
10685     }
10686 }
10687 
10688 sub add_dir_to_href {
10689     $_ =~ s/'/\\'/g;
10690     $_ =~ s/(<LI><A )(NAME\=\"tex2html\d+\")?\s*(HREF=\")/$1$3\'.\$dir.\'/og;
10691     $_ = join('', "\'", $_, "\'\n");
10692 }
10693 
10694 sub save_array_in_file {
10695     local ($type, $array_name, $append, %array) = @_;
10696     local ($uutxt,$file,$prefix,$suffix,$done_file,$depth,$title);
10697     $prefix = $suffix = "";
10698     my $filespec = ($append ? '>>' : '>') . "${PREFIX}$type.pl";
10699     $prefix = q("$URL/" . )
10700 	if ($type eq "labels") && !($array_name eq "external\_latex\_labels");
10701     $suffix = " unless (\$$array_name\{\$key\})"
10702 	if (($type =~ /(sections|contents)/)||($array_name eq "printable\_key"));
10703     if ((%array)||($type eq "labels")) {
10704 	print "\nSAVE_ARRAY:$array_name in FILE: ${PREFIX}$type.pl"
10705 	    if ($VERBOSITY > 1);
10706 	unless(open(FILE,$filespec)) {
10707             print "\nError: Cannot write '${PREFIX}$type.pl': $!\n";
10708             return;
10709         }
10710 	if (($array_name eq "sub\_index") || ($array_name eq "printable\_key")) {
10711 	    print FILE "\n# LaTeX2HTML $TEX2HTMLVERSION\n";
10712 	    print FILE "# Printable index-keys from $array_name array.\n\n";
10713 	} elsif ($array_name eq "index\_labels") {
10714 	    print FILE "\n# LaTeX2HTML $TEX2HTMLVERSION\n";
10715 	    print FILE "# labels from $array_name array.\n\n";
10716 	} elsif ($array_name eq "index\_segment") {
10717 	    print FILE "\n# LaTeX2HTML $TEX2HTMLVERSION\n";
10718 	    print FILE "# segment identifier from $array_name array.\n\n";
10719 	} elsif ($array_name eq "external\_latex\_labels") {
10720 	    print FILE "\n# LaTeX2HTML $TEX2HTMLVERSION\n";
10721 	    print FILE "# labels from $array_name array.\n\n";
10722 	} else {
10723 	    print FILE "# LaTeX2HTML $TEX2HTMLVERSION\n";
10724 	    print FILE "# Associate $type original text with physical files.\n\n";
10725         }
10726         for $uutxt (sort keys %array) {
10727             $file = $array{$uutxt};
10728 	    $uutxt =~ s|/|\\/|g;
10729 	    $uutxt =~ s|\\\\/|\\/|g;
10730 
10731 	    if (!($array_name =~/images/)&&($file =~ /</)) {
10732 		do { local $_ = $file;
10733 		     &replace_markers;
10734 		     $file = $_; undef $_;
10735 		     $file =~ s/(\G|[^q])[\\\|]\|/$1\\Vert/sg;
10736 		     $file =~ s/(\G|[^q])\|/$1\\vert/sg;
10737 		};
10738 	    }
10739 
10740 	    local ($nosave); 	
10741 	    if ($MULTIPLE_FILES && $ROOTED && 
10742 	    	    $type =~ /(sections|contents)/) {
10743 		#RRM: save from $THIS_FILE only
10744 	    	if ( $uutxt =~ /^$THIS_FILE /) {
10745 		    #RRM: save from $THIS_FILE only
10746 	    	    $nosave = ''
10747 	    	} else { $nosave = 1 }
10748 	    } else {
10749 		#RRM: suppress info from other segments
10750 	        $nosave = $noresave{$uutxt}; 
10751 	    }
10752 
10753 	    if (!$nosave && ($file ne ''))  {
10754 		print FILE "\n\$key = q/$uutxt/;\n";
10755 
10756 		$file =~ s/\|/\\\|/g; # RRM:  escape any occurrences of |
10757 		$file =~ s/\\\\\|/\\\|/g; # unless already escaped as \|
10758 		$file =~ s|\\\\|\\\\\\\\|g;
10759 		$file =~ s/(SRC=")($HTTP_start)?/$1.($2 ? '' :"|.\"\$dir\".q|").$2/seg;
10760 #
10761 #
10762 # added code for  $dir  with segmented docs;  RRM  15/3/96
10763 #
10764 		if ($type eq "contents") {
10765 		    ($depth, $done_file) = split($delim, $file, 2 );
10766 		    next if ($depth > $MAX_SPLIT_DEPTH + $MAX_LINK_DEPTH);
10767 		    print FILE 
10768     "\$$array_name\{\$key\} = '$depth$delim'.\"\$dir\".q|$done_file|$suffix; \n";
10769 
10770 		} elsif ($type eq "sections") {
10771 		    ($depth, $done_file) = split($delim, $file, 2 );
10772 		    next if ($depth > $MAX_SPLIT_DEPTH + $MAX_LINK_DEPTH);
10773 		    print FILE 
10774     "\$$array_name\{\$key\} = '$depth$delim'.\"\$dir\".q|$done_file|$suffix; \n";
10775 
10776 		} elsif ($type eq "internals") {
10777 		    print FILE 
10778     "\$$array_name\{\$key\} = \"\$dir\".q|$file|$suffix; \n";
10779 
10780 		} elsif ($array_name eq "sub_index") {
10781 		    print FILE
10782     "\$$array_name\{\$key\} .= q|$file|$suffix; \n";
10783 
10784 		} elsif ($array_name eq "index") {
10785 		    local($tmp_file) = '';
10786 		    ($depth, $done_file) = split('HREF=\"', $file, 2 );
10787 		    if ($done_file) {
10788 			while ($done_file) {
10789 			    $depth =~ s/\s*$/ / if ($depth);
10790 			    $tmp_file .= "q|${depth}HREF=\"|.\"\$dir\".";
10791 			    ($depth, $done_file) = split('HREF=\"', $done_file, 2 );
10792 			}
10793 			print FILE
10794     "\$$array_name\{\$key\} .= ${tmp_file}q|$depth|$suffix; \n";
10795 
10796 		    } else {
10797 			print FILE
10798     "\$$array_name\{\$key\} .= q|$file|$suffix; \n";
10799 		    }
10800 		} elsif ($array_name eq "printable_key") {
10801 		    print FILE
10802     "\$$array_name\{\$key\} = q|$file|$suffix; \n";
10803 
10804 		} else {
10805 		    print FILE
10806     "\$$array_name\{\$key\} = ${prefix}q|$file|$suffix; \n";
10807 		}
10808 
10809 		if ($type =~ /(figure|table|images)/) {} else {
10810 		    print FILE "\$noresave\{\$key\} = \"\$nosave\";\n";
10811 		}
10812 
10813 		if ($type eq "sections") {
10814 		    ($depth, $done_file, $title) = split($delim, $file);
10815 		    print FILE "\$done\{\"\$\{dir\}$done_file\"\} = 1;\n";
10816 		}
10817 	    }
10818 	}
10819 	print FILE "\n1;\n\n"  unless  ( $array_name =~ /index/ );
10820 	close (FILE);
10821     } else {
10822 	print "\nSAVE_FILE:$array_name: ${PREFIX}$type.pl  EMPTY " if ($VERBOSITY > 1);
10823     }
10824 }
10825 
10826 # returns true if $AUTO_NAVIGATION is on and there are more words in $_
10827 # than $WORDS_IN_PAGE
10828 sub auto_navigation {
10829     # Uses $_;
10830     local(@tmp) = split(/\W*\s+\W*/, $_);
10831     ($AUTO_NAVIGATION && ( (scalar @tmp) > $WORDS_IN_PAGE));
10832 }
10833 
10834 # Returns true if $f1 is newer than $f2
10835 sub newer {
10836     ($f1,$f2) = @_;
10837     local(@f1s) = stat($f1);
10838     local(@f2s) = stat($f2);
10839     ($f1s[9] > $f2s[9]);
10840 };
10841 
10842 sub iso_map {
10843     local($char, $kind, $quiet) = @_;
10844     my($character_map,$enc);
10845     local ($this);
10846 
10847     if (($CHARSET =~ /utf/)&&!$NO_UTF) {
10848 	# utf8 is default output
10849 	$enc = $iso_10646_character_map{"$char$kind"};
10850 	if (!$enc && $iso_10646_combining_character_map{"$kind"}) {
10851 	    # use combining accents for characters not in main table: \dot{A}
10852 	    $enc = $char.$iso_10646_combining_character_map{"$kind"};
10853 	}
10854     } else {
10855 	# see if it is a character in the charset
10856 	$character_map = $CHARSET;
10857 	$character_map =~ tr/-/_/;
10858 	eval "\$enc = \$${character_map}_character_map\{\"$char$kind\"\}";
10859 	print "\n no support for $CHARSET: $@ " if ($@);
10860 	$enc =~ /^\&\#(\d{3});$/;
10861 	# numeric character references in html refer to unicode
10862 	# we need to convert this char to an 8-bit character
10863 	if ($1 && ($1<=255)) { $enc = chr($1) }
10864     }
10865     if ($USE_ENTITY_NAMES && $enc) { return(";SPM$char$kind;") }
10866     if ($enc) {
10867 	$ISOLATIN_CHARS = 1; $enc;
10868     } elsif (!$image_made{"$char$kind"}) {
10869 	print "\ncouldn't convert character $char$kind into available encodings"
10870 	    if (!quiet &&($VERBOSITY > 1));
10871 	&write_warnings(
10872 	    "couldn't convert character $char$kind into available encodings"
10873 	    . ($ACCENT_IMAGES ? ', using image' : '')) unless ($quiet);
10874 	$image_made{"$char$kind"} = 1;
10875 	'';
10876     } else {''}
10877 }
10878 
10879 sub titles_language {
10880     local($_) = @_;
10881     local($lang) = $_ . "_titles";
10882     if (defined(&$lang)) { &$lang }
10883     else {
10884 	&english_titles;
10885 	&write_warnings(
10886 	    "\nThere is currently no support for the $tmp language." .
10887 	    "\nSee the file $CONFIG_FILE for examples on how to add it\n\n");
10888     }
10889 }
10890 
10891 sub translate_titles {
10892     $toc_title = &translate_commands($toc_title) if ($toc_title =~ /\\/);
10893     $lof_title = &translate_commands($lof_title) if ($lof_title =~ /\\/);
10894     $lot_title = &translate_commands($lot_title) if ($lot_title =~ /\\/);
10895     $idx_title = &translate_commands($idx_title) if ($idx_title =~ /\\/);
10896     $ref_title = &translate_commands($ref_title) if ($ref_title =~ /\\/);
10897     $bib_title = &translate_commands($bib_title) if ($bib_title =~ /\\/);
10898     $nom_title = &translate_commands($nom_title) if ($nom_title =~ /\\/);
10899     $abs_title = &translate_commands($abs_title) if ($abs_title =~ /\\/);
10900     $app_title = &translate_commands($app_title) if ($app_title =~ /\\/);
10901     $pre_title = &translate_commands($pre_title) if ($pre_title =~ /\\/);
10902     $foot_title = &translate_commands($foot_title) if ($foot_title =~ /\\/);
10903     $fig_name = &translate_commands($fig_name) if ($fig_name =~ /\\/);
10904     $tab_name = &translate_commands($tab_name) if ($tab_name =~ /\\/);
10905     $prf_name = &translate_commands($prf_name) if ($prf_name =~ /\\/);
10906     $page_name = &translate_commands($page_name) if ($page_name =~ /\\/);
10907     $child_name = &translate_commands($child_name) if ($child_name =~ /\\/);
10908     $info_title = &translate_commands($info_title) if ($info_title =~ /\\/);
10909     $part_name = &translate_commands($part_name) if ($part_name =~ /\\/);
10910     $chapter_name = &translate_commands($chapter_name)
10911 	if ($chapter_name =~ /\\/);
10912     $section_name = &translate_commands($section_name)
10913 	if ($section_name =~ /\\/);
10914     $subsection_name = &translate_commands($subsection_name)
10915 	if ($subsection_name =~ /\\/);
10916     $subsubsection_name = &translate_commands($subsubsection_name)
10917 	if ($subsubsection_name =~ /\\/);
10918     $paragraph_name = &translate_commands($paragraph_name)
10919 	if ($paragraph_name =~ /\\/);
10920     $see_name = &translate_commands($see_name) if ($see_name =~ /\\/);
10921     $also_name = &translate_commands($also_name) if ($also_name =~ /\\/);
10922     $next_name = &translate_commands($next_name) if ($next_name =~ /\\/);
10923     $prev_name = &translate_commands($prev_name) if ($prev_name =~ /\\/);
10924     $up_name = &translate_commands($up_name) if ($up_name =~ /\\/);
10925     $group_name = &translate_commands($group_name) if ($group_name =~ /\\/);
10926     $encl_name = &translate_commands($encl_name) if ($encl_name =~ /\\/);
10927     $headto_name = &translate_commands($headto_name) if ($headto_name =~ /\\/);
10928     $cc_name = &translate_commands($cc_name) if ($cc_name =~ /\\/);
10929     $default_title = &translate_commands($default_title)
10930 	if ($default_title =~ /\\/);
10931 }
10932 ####################### Code Generation Subroutines ############################
10933 # This takes a string of commands followed by optional or compulsory
10934 # argument markers and generates a subroutine for each command that will
10935 # ignore the command and its arguments.
10936 # The commands are separated by newlines and have the format:
10937 ##      <cmd_name>#{}# []# {}# [] etc.
10938 # {} marks a compulsory argument and [] an  optional one.
10939 sub ignore_commands {
10940     local($_) = @_;
10941     foreach (/.*\n?/g) {
10942 	s/\n//g;
10943 	# For each line
10944 	local($cmd, @args) = split('\s*#\s*',$_);
10945 	next unless $cmd;
10946 	$cmd =~ s/ //;
10947 	++$ignore{$cmd};
10948 	local ($body, $code, $thisone) = ("", "");
10949 	
10950 	# alter the pattern here to debug particular commands
10951 	$thisone = 1 if ($cmd =~ /let/);
10952 
10953 	local($dum1, $dum2) = ($cmd, '');
10954 	$dum1 = $cmd unless ($dum1 = &normalize($dum1, $dum2));
10955 	if (@args) {
10956 	    print "\n$cmd: ".scalar(@args)." arguments" if ($thisone);
10957 	    # Replace the argument markers with appropriate patterns
10958 	    foreach $arg (@args) {
10959 		print "\nARG: $arg" if ($thisone);
10960 		if ($arg =~ /\{\}/) {
10961 		    $body .= 'local($cmd) = '."\"$cmd\"".";\n";
10962 		    $body .= '$args .= &missing_braces'."\n ".'unless (';
10963 		    $body .= '(s/$next_pair_pr_rx/$args .= $2;\'\'/eo)'."\n";
10964 		    $body .= '  ||(s/$next_pair_rx/$args .= $2;\'\'/eo));'."\n";
10965 		    print "\nAFTER:$'" if (($thisone)&&($'));
10966 		    $body .= $' if ($');
10967 		} elsif ($arg =~ /\[\]/) {
10968 		    $body .= '($dummy, $pat) = &get_next_optional_argument;'
10969 			. '$args .= $pat;'."\n";
10970 		    print "\nAFTER:$'" if (($thisone)&&($'));
10971 		    $body .= $' if ($');
10972 		} elsif ($arg =~ /^\s*\\/) {		    
10973 		    $body .= '($dummy, $pat) = &get_next_tex_cmd;'
10974 			. '$args .= $pat;'."\n";
10975 		    print "\nAFTER:$'" if (($thisone)&&($'));
10976 		    $body .= $' if ($');
10977 		} elsif ($arg =~ /<<\s*([^>]*)[\b\s]*>>/) {
10978 		    local($endcmd, $after) = ($1,$');
10979 		    $after =~ s/(^\s*|\s*$)//g;
10980 		    $endcmd = &escape_rx_chars($endcmd);
10981 		    $body .= 'if (/'.$endcmd.'/o) { $args .= $`; $_ = $\' };'."\n";
10982 		    print "\nAFTER:$after" if (($thisone)&&($after));
10983 		    $body .= "$after" if ($after);
10984 		} else {
10985 		    print "\nAFTER:$'" if (($thisone)&&($arg));
10986 		    $body .= $arg ;
10987 		}
10988 	    }
10989 	    # Generate a new subroutine
10990 #	    $code = "sub do_cmd_$cmd {\n".'local($_) = @_;'. join('',@args) .'$_}';
10991 	    $code = "sub do_cmd_$dum1 {\n"
10992 		. 'local($_,$ot) = @_; '
10993 		. 'local($open_tags_R) = defined $ot ? $ot : $open_tags_R; '
10994 		. 'local($args); '
10995 		. "\n" . $body . (($body)? ";\n" : '')
10996 		. (($thisone)? "print \"\\n\", '$cmd', \":\".\$args.\"\\n\";\n" : '')
10997 		. (($arg)? $arg : '$_') . "}";
10998 	    print STDOUT "\n$code\n" if ($thisone); # for error-checking
10999 	    eval ($code); # unless ($thisone);
11000 	    print STDERR "\n\n*** sub do_cmd_$dum1 failed: $@\n" if ($@);
11001 	} else {
11002 	    $code = "sub do_cmd_$dum1 {\n".'$_[0]}';
11003 	    print "\n$code\n" if ($thisone); # for error-checking
11004 	    eval ($code); # unless ($thisone);
11005 	    print STDERR "\n\n*** sub do_cmd_$dum1 failed: $@\n" if ($@);
11006         }
11007     }
11008 }
11009 
11010 
11011 sub ignore_numeric_argument {
11012     # Chop this off
11013     #RRM: 2001/11/8: beware of taking too much, when  <num> <num> 
11014     local($num) = '(^|width|height|plus|minus)\s*[+-]?[\d\.]+(cm|em|ex|in|pc|pt|mm)?\s*';
11015     do { s/^\s*=?\s*//so; s/^($num)*//so } unless (/^(\s*\<\<\d+\>\>|$)/);
11016 }
11017 
11018 sub get_numeric_argument {
11019     my ($num_rx,$num) = ('','');
11020     # Collect the numeric part
11021     #RRM: 2001/11/8: beware of taking too much, when  <num> <num> 
11022     $num_rx = '(^|width|height|plus|minus)\s*[+-]?[\d\.]+(cm|em|ex|in|pc|pt|mm)?\s*';
11023     do { s/^\s*=?\s*//so; s/($num_rx)*/$num=$&;''/soe } unless (/^(\s*\<\<\d+\>\>|$)/);
11024     $num;
11025 }
11026 
11027 sub process_in_latex_helper {
11028     local($ctr,$val,$cmd) = @_;
11029     ($ASCII_MODE ? "[$cmd]" : 
11030 	&process_in_latex("\\setcounter{$ctr}{$val}\\$cmd"))
11031 }
11032 
11033 sub do_cmd_catcode {
11034     local($_) = @_;
11035     s/^\s*[^=]+(=?\s*\d+\s|\\active)\s?//;
11036     $_;
11037 }
11038 
11039 sub do_cmd_string {
11040     local($_) = @_;
11041     local($tok);
11042     s/^\s*(\\([a-zA-Z]+|.)|[&;]\w+;(#\w+;)?|.)/$tok=$1;''/e;
11043     if ($2) {$tok = "\&#92;$2"};
11044     "$tok".$_
11045 }
11046 
11047 sub do_cmd_boldmath {
11048     local($_) = @_;
11049     $BOLD_MATH = 1;
11050     $_;
11051 }
11052 
11053 sub do_cmd_unboldmath {
11054     local($_) = @_;
11055     $BOLD_MATH = 0;
11056     $_;
11057 }
11058 
11059 sub do_cmd_lq {
11060     local($_) = @_ ;
11061     local($lquote);
11062     # check for double quotes
11063     if (s/^\s*\\lq(\b|$|[^A-Za-z])/$1/) {
11064 	$lquote = ((($HTML_VERSION < 4)&&!($charset =~ /utf/)) ? '``'
11065 		: &do_leftquotes($_));
11066     } else {
11067 	$lquote = ((($HTML_VERSION < 4)&&!($charset =~ /utf/)) ? '`'
11068 		: &do_leftquote($_));
11069     }
11070     $lquote . $_;
11071 }
11072 
11073 sub do_leftquote {
11074     # MRO: use $_[0] : local(*_) = @_;
11075     local($quote,$lquo) = ('',($HTML_VERSION<4)? '&#8216;' : ';SPMlsquo;');
11076     # select whole quotation, if \lq matches \rq
11077     if ($_[0] =~ /^(.*)((\\rq\\rq|'')*)(\\rq)/) {
11078 	$quote = $1.$2; $_[0] = $';
11079 	local($rquo) = &do_rightquote();
11080 	&process_quote($lquo,$quote,$rquo);
11081     } else { $lquo; }
11082 }
11083 
11084 sub do_leftquotes {
11085     # MRO: use $_[0] : local(*_) = @_;
11086     local($quote,$lquo) = ('',($HTML_VERSION<4)? '&#8220;' : ';SPMldquo;');
11087     # select whole quotation, if \lq\lq matches \rq\rq or ''
11088     if ($_[0] =~ /^(.*)(\\rq\\rq|'')/) {
11089 	$quote = $1; $_[0] = $';
11090 	local($rquo) = &do_rightquotes();
11091 	&process_quote($lquo,$quote,$rquo);
11092     } else { $lquo; }
11093 }
11094 
11095 # RRM: By default this just concatenates the strings; e.g. ` <quote> '
11096 # This can be overridden in a html-version file
11097 sub process_quote { join ('', @_) }
11098 
11099 sub do_cmd_rq {
11100     local($_) = @_ ;
11101     local($rquote);
11102     if ($_ =~ s/^\s*\\rq\b//) {
11103 	$rquote = ((($HTML_VERSION < 4)&&!($charset =~ /utf/)) ? "''"
11104 		: &do_rightquotes());
11105     } else { 
11106 	$rquote = ((($HTML_VERSION < 4)&&!($charset =~ /utf/)) ? "'"
11107 		: &do_rightquote());
11108     }
11109     $rquote . $_;
11110 }
11111 
11112 sub do_rightquote { (($HTML_VERSION < 4)? '&#8217;' : ';SPMrsquo;') }
11113 sub do_rightquotes { (($HTML_VERSION < 4)? '&#8221;' : ';SPMrdquo;') }
11114 
11115 sub do_cmd_parbox {
11116     local($_) = @_;
11117     local($args, $contents, $dum, $pat);
11118     ($dum,$pat) = &get_next_optional_argument; # discard this
11119     ($dum,$pat) = &get_next_optional_argument; # discard this
11120     ($dum,$pat) = &get_next_optional_argument; # discard this
11121     $args .= $pat if ($pat);
11122     $pat = &missing_braces unless (
11123 	(s/$next_pair_pr_rx/$pat=$2;''/eom)
11124 	||(s/$next_pair_rx/$pat=$2;''/eom));
11125     $args .= "{".$`.$pat."}";
11126     $contents = &missing_braces unless (
11127 	(s/$next_pair_pr_rx/$contents=$2;''/eom)
11128 	||(s/$next_pair_rx/$contents=$2;''/eom));
11129     $args .= "{".$`.$contents."}";
11130     if ($NO_PARBOX_IMAGES) {
11131 	$contents = join ('', &do_cmd_par(), $contents, '</P>' );
11132     } else {
11133 	$contents = &process_math_in_latex('','text',0,"\\parbox$args")
11134 	    if ($contents);
11135     }
11136     $contents . $_;
11137 }
11138 
11139 
11140 sub do_cmd_mbox {
11141     local($_) = @_;
11142     local($text,$after)=('','');
11143     $text = &missing_braces unless (
11144 	(s/$next_pair_pr_rx/$text = $2;''/eo)
11145 	||(s/$next_pair_rx/$text = $2;''/eo));
11146     $after = $_;
11147 
11148     # incomplete macro replacement
11149     if ($text =~ /(^|[^\\<])#\d/) { return($after) }
11150 
11151     if ($text =~ /(tex2html_wrap_inline|\$$OP(\d+)$CP$OP\2$CP\$|\$$O(\d+)$C$O\2$C\$)/) {
11152 	if ($text =~ 
11153 	    /$image_mark#([^#]+)#([\.,;:\)\]])?(\001)?([ \t]*\n?)(\001)?/) {
11154 	    local($mbefore, $mtext, $mafter) = ($`, $&, $');
11155 	    $mbefore = &translate_commands($mbefore) if ($mbefore =~ /\\/);
11156 	    $mafter = &translate_commands($mafter) if ($mafter =~ /\\/);
11157 	    join('', $mbefore, $mtext, $mafter, $after);
11158 	} else {
11159 	    join ('', &process_math_in_latex('','','',"\\hbox{$text}"), $after )
11160 	}
11161     } else {
11162 	$text = &translate_environments($text);
11163 	$text = &translate_commands($text);
11164 	join('', $text, $after);
11165     }
11166 }
11167 
11168 
11169 
11170 # *Generates* subroutines to handle each of the declarations
11171 # like \em, \quote etc., in case they appear with the begin-end
11172 # syntax.
11173 sub generate_declaration_subs {
11174     local($key, $val, $pre, $post, $code );
11175     print "\n *** processing declarations ***\n";
11176     for $key (sort keys %declarations) {
11177         $val = $declarations{$key};
11178 	if ($val) {
11179 	    ($pre,$post) = ('','');
11180 	    $val =~ m|</.*$|;
11181 	    do {$pre = $`; $post = $& } unless ($` =~ /^<>/);
11182 	    $pre =~ s/"/\\"/g; $post =~ s/"/\\"/g;
11183 	    $code = "sub do_env_$key {"
11184 #		. 'local($_) = @_;' . "\n"
11185 #		. 'push(@$open_tags_R, $key);'. "\n"
11186 #		. '$_ = &translate_environments($_);'. "\n"
11187 #		. '$_ = &translate_commands($_);'. "\n"
11188 #		. "join('',\"$pre\",\"\\n\"," .'$_' .",\"$post\");\n};";
11189 		. '&declared_env('.$key.',@_)};';
11190 	    eval $code;
11191 	    if ($@) {print "\n *** $key ".  $@ };
11192 	}
11193     }
11194 }
11195 
11196 # *Generates* subroutines to handle each of the sectioning commands.
11197 sub generate_sectioning_subs {
11198     local($key, $val, $cmd, $body);
11199     for $key (sort keys %standard_section_headings) {
11200         $val = $standard_section_headings{$key};
11201 	$numbered_section{$key} = 0;
11202 	eval "sub do_cmd_$key {"
11203 	    . 'local($after,$ot) = @_;'
11204 	    . 'local($open_tags_R) = defined $ot ? $ot : $open_tags_R;'
11205             . '&reset_dependents('. $key . ');'
11206             . '&do_cmd_section_helper('.$val.','.$key.');}';
11207 	print STDERR "\n*** sub do_cmd_$key failed:\n$@\n" if ($@);
11208 	# Now define the *-form of the same commands. The difference is that the
11209 	# $key is not passed as an argument.
11210 	eval "sub do_cmd_$key" . "star {"
11211 	    . 'local($after,$ot) = @_;'
11212 	    . 'local($open_tags_R) = defined $ot ? $ot : $open_tags_R;'
11213 	    . '&do_cmd_section_helper(' . $val . ');}';
11214 	print STDERR "\n*** sub do_cmd_${key}star failed:\n$@\n" if ($@);
11215 	# Now define the macro  \the$key  
11216 	&process_commands_wrap_deferred("the$key \# {}\n");
11217 ###	local($_) = "<<1>>$key<<1>>";
11218 	$body = "<<1>>$key<<1>>";
11219 	&make_unique($body);
11220 	$cmd = "the$key";
11221 	eval "sub do_cmd_$cmd {"
11222 	    . 'local($after,$ot) = @_;'
11223 	    . 'local($open_tags_R) = defined $ot ? $ot : $open_tags_R;'
11224 	    . '&do_cmd_arabic(' . "\"$body\"" . ").\$after;};";
11225 	print STDERR "\n*** sub do_cmd_$cmd failed:\n$@\n" if ($@);
11226 	$raw_arg_cmds{$cmd} = 1;
11227     }
11228     &addto_dependents('chapter','section');
11229     &addto_dependents('section','subsection');
11230     &addto_dependents('subsection','subsubsection');
11231     &addto_dependents('subsubsection','paragraph');
11232     &addto_dependents('paragraph','subparagraph');
11233 }
11234 
11235 sub addto_dependents {
11236     local($ctr, $dep) = @_;
11237     local($tmp, $depends);
11238     if ($depends = $depends_on{$dep}) {
11239 	&remove_dependency($depends, $dep) }
11240     $depends_on{$dep} = $ctr;
11241 
11242     $tmp = $dependent{$ctr};
11243     if ($tmp) { 
11244 	$dependent{$ctr} = join($delim, $tmp, $dep);
11245     } else { $dependent{$ctr} = $dep }
11246 }
11247 
11248 sub remove_dependency {
11249     local($ctr, $dep) = @_;
11250     local(@tmp, $tmp, $dtmp);
11251     print "\nremoving dependency of counter {$dep} from {$ctr}\n";
11252     foreach $dtmp (split($delim, $dependent{$ctr})) {
11253 	push(@tmp, $dtmp) unless ($dtmp =~ /$dep/);
11254     }
11255     $dependent{$ctr} = join($delim, @tmp);
11256 }
11257 
11258 
11259 # Uses $after which is defined in the caller (the caller is a generated subroutine)
11260 # Also uses @curr_sec_id
11261 #
11262 #JCL(jcl-tcl) (changed almost everything)
11263 #
11264 sub do_cmd_section_helper {
11265     local($H,$key) = @_;
11266     local($section_number, $titletext, $title_key, @tmp, $align, $dummy);
11267     local($anchors,$pre,$run_title,$_) = ('', "\n", '', $after);
11268     local($open_tags_R) = [];
11269 
11270     # if we have a $key the current section is not of the *-form, so we need
11271     # to update the counters.
11272     &do_cmd_stepcounter("${O}0$C$key${O}0$C")
11273 #	if ($key && !$making_name);
11274 #	if ($key && !($unnumbered_section_commands{$key}) && !$making_name);
11275 	if ($key && !($unnumbered_section_commands{$key}));
11276 #   $latex_body .= "\\stepcounter{$key}\n" if $key;
11277 #   &reset_dependents($key) if ($dependent{$key});
11278 
11279     local($br_id);
11280 #    if ($USING_STYLES) {
11281 #	$txt_style{"H$H.$key"} = " " unless $txt_style{"H$H.$key"}; 
11282 #	$H .= " CLASS=\"$key\"; 
11283 #    };
11284 
11285     local ($align, $dummy)=&get_next_optional_argument;
11286     if (($align =~/^(left|right|center)$/i)&&($HTML_VERSION > 2.0)) {
11287         $align = "class=\"".uc($1)."\"";
11288     } elsif ($align) {
11289 	# data was meant to be a running-head !
11290 	$br_id = ++$global{'max_id'};
11291 	$run_title = &translate_environments("$O$br_id$C$align$O$br_id$C");
11292 	$run_title = &translate_commands($run_title) if ($run_title =~ /\\/);
11293 	$run_title =~ s/($O|$OP)\d+($C|$CP)//g;
11294 	$align = '';
11295     } else {
11296     }
11297     $titletext = &missing_braces 
11298 	unless s/$next_pair_rx/$titletext=$2;''/eo;
11299     $br_id = ++$global{'max_id'};
11300     $titletext = &translate_environments("$O$br_id$C$titletext$O$br_id$C");
11301 
11302     $title_key = $run_title || $titletext;
11303     $title_key =~ s/$image_mark\#([^\#]+)\#(\\space)?/&purify_caption($1)/e;
11304     # This should reduce to the same information as contained in the .aux file.
11305     $title_key = &sanitize(&simplify($title_key));
11306 
11307     # RRM: collect all anchors from \label and \index commands
11308     ($anchors,$titletext) = &extract_anchors($titletext);
11309     local($saved_title) = $titletext;
11310     do {
11311         # to ensure a style ID is not saved and re-used in (mini-)TOCs
11312 	local($USING_STYLES) = 0;
11313 	$titletext = &translate_environments($titletext);
11314 	$titletext = &translate_commands($titletext) 
11315 	    if ($titletext =~/\\/);
11316     };
11317     # but the style ID can be used for the title on the HTML page
11318     if (!($titletext eq $saved_title)) {
11319 	$saved_title = &translate_environments($saved_title);
11320 	$saved_title = &translate_commands($saved_title) 
11321 	    if ($saved_title =~/\\/);
11322 	$saved_title = &simplify($saved_title);
11323     }
11324     local($closures) = &close_all_tags();
11325     $saved_title .= $closures;
11326     $title_text .= $closures;
11327 
11328     # This is the LaTeX section number read from the $FILE.aux file
11329     @tmp = split(/$;/,$encoded_section_number{$title_key});
11330     $section_number = shift(@tmp);
11331     $section_number = "" if ($section_number eq "-1");
11332     $encoded_section_number{$title_key} = join($;, @tmp)
11333 #	unless (defined $title);
11334 	unless ($title);
11335 
11336     # need to check also &{wrap_cmd_... also, if \renewcommand has been used; 
11337     # thanks Bruce Miller
11338     local($dum1, $dum2) = ($key, '');
11339     $dum1 = $key unless ($dum1 = &normalize($dum1, $dum2));
11340     local($thehead,$whead) = ("do_cmd_the$key","wrap_cmd_the$dum1");
11341 #    $thehead = ((defined &$thehead)? 
11342 #	&translate_commands("\\the$key") : '');
11343     $thehead = ((defined &$thehead)||(defined &$whead)
11344 	? &translate_commands("\\the$key") : '');
11345     $thehead .= $SECNUM_PUNCT
11346 	if ($SECNUM_PUNCT &&($thehead)&& !($thehead =~ /\./));
11347     $section_number = $thehead if (($thehead)&&($SHOW_SECTION_NUMBERS));
11348 
11349     #JKR: Don't prepend whitespace 
11350     if ($section_number) {
11351 	$titletext = "$section_number " . $titletext;
11352 	$saved_title = "$section_number " . $saved_title;
11353 	$run_title = "$section_number " . $run_title if $run_title;
11354     }
11355 
11356 #    $toc_sec_title = $titletext;
11357 #    $toc_sec_title = &purify($titletext);
11358     $toc_sec_title = &simplify($titletext);
11359     $titletext = &simplify($titletext);
11360 #    $TITLE = &purify($titletext);
11361     local($after) = $_;
11362     do {
11363 	local($_) = $titletext; &remove_anchors; 
11364 	if ($run_title) {
11365 	    $TITLE = $run_title;
11366 	} elsif ($_) {
11367 	    $TITLE = $_
11368 	} else { $TITLE = '.' };
11369     };
11370     $global{$key}-- if ($key && $making_name);
11371     return ($TITLE) if (defined $title);
11372 
11373     #RRM: no preceding \n when this is the first section-head on the page.
11374     if (! $key || $key < $MAX_SPLIT_DEPTH) { $pre = '' };
11375     if ( defined &make_pre_title) {
11376 	$pre = &make_pre_title($saved_title, $H);
11377     }
11378 
11379     undef $open_tags_R;
11380     $open_tags_R = [ @save_open_tags ];
11381     
11382     join('', $pre, &make_section_heading($saved_title, $H, $align.$anchors)
11383 	, $open_all, $_);
11384 }
11385 
11386 sub do_cmd_documentclass {
11387     local($_) = @_;
11388     local ($docclass)=('');
11389     local ($cloptions,$dum)=&get_next_optional_argument;
11390     $docclass = &missing_braces unless (
11391 	(s/$next_pair_pr_rx/$docclass = $2;''/eo)
11392 	||(s/$next_pair_rx/$docclass = $2;''/eo));
11393     local($rest) = $';
11394     &do_require_package($docclass);
11395     if (! $styles_loaded{$docclass}) {
11396 	&no_implementation("document class",$docclass);
11397     } else {
11398 	if($cloptions =~ /\S+/) { # are there any options?
11399 	    &do_package_options($docclass,$cloptions);
11400 	}
11401     }
11402     $rest;
11403 }
11404 sub do_cmd_documentstyle { &do_cmd_documentclass($_[0]); }
11405 
11406 sub do_cmd_usepackage {
11407     local($_) = @_;
11408     # RRM:  allow lists of packages and options
11409     local ($package, $packages)=('','');
11410     local ($options,$dum)=&get_next_optional_argument;
11411     $packages = &missing_braces unless (
11412 	(s/$next_pair_pr_rx/$packages = $2;''/eo)
11413 	||(s/$next_pair_rx/$packages = $2;''/eo));
11414     local($rest) = $_;
11415     # MRO: The files should have already been loaded by
11416     #      TMP_styles, but we better make it sure.
11417     foreach $package (split (',',$packages)) {	# allow multiple packages
11418 	$package =~ s/\s|\%|$comment_mark\d*//g; # remove whitespace 
11419 	$package =~ s/\W/_/g; # replace non-alphanumerics
11420 	&do_require_package($package);
11421 	if (! $styles_loaded{$package}) {
11422 	    &no_implementation("package",$package);
11423 	} else {
11424 	    if($options =~ /\S+/) { # are there any options?
11425 		&do_package_options($package,$options);
11426 	    }
11427 	}
11428     }
11429     $rest;
11430 }
11431 
11432 
11433 sub no_implementation {
11434     local($what,$which)= @_;
11435     print STDERR "\nWarning: No implementation found for $what: $which";
11436 }
11437 
11438 sub do_cmd_RequirePackage {
11439     local($_)= @_;
11440     local($file);
11441     local($options,$dum)=&get_next_optional_argument;
11442     $file = &missing_braces unless (
11443 	(s/$next_pair_pr_rx/$file = $2;''/eo)
11444 	||(s/$next_pair_rx/$file = $2;''/eo));
11445     local($rest) = $_;
11446     $file =~ s/^[\s\t\n]*//o;
11447     $file =~ s/[\s\t\n]*$//o;
11448     # load the package, unless that has already been done
11449     &do_require_package($file) unless ($styles_loaded{$file});
11450     # process any options
11451     if (! $styles_loaded{$file}) {
11452 	    &no_implementation("style",$file);
11453     } else {
11454 	# process any options
11455 	&do_package_options($file,$options) if ($options);
11456     }
11457     $_ = $rest;
11458     # ignore trailing optional argument
11459     local($date,$dum)=&get_next_optional_argument;
11460     $_;
11461 }
11462 
11463 sub do_cmd_PassOptionsToPackage {
11464     local($_) = @_;
11465     local($options,$file);
11466     $options = &missing_braces unless (
11467         (s/$next_pair_pr_rx/$options = $2;''/eo)
11468         ||(s/$next_pair_rx/$options = $2;''/eo));
11469     $file = &missing_braces unless (
11470         (s/$next_pair_pr_rx/$file = $2;''/eo)
11471         ||(s/$next_pair_rx/$file = $2;''/eo));
11472     $passedOptions{$file} = $options;
11473     $_;
11474 }
11475 sub do_cmd_PassOptionsToClass{ &do_cmd_PassOptionsToPackage(@_)}
11476 
11477 sub do_package_options {
11478     local($package,$options)=@_;
11479     local($option);
11480     if ($passedOptions{$package}) { $options = $passedOptions{$package}.'.'.$options };
11481     foreach $option (split (',',$options)) {
11482         $option =~ s/^[\s\t\n]*//o;
11483         $option =~ s/[\s\t\n]*$//o;
11484 	$option =~ s/\W/_/g; # replace non-alphanumerics
11485 	next unless ($option);
11486         if (!($styles_loaded{$package."_$option"})) {
11487             &do_require_packageoption($package."_$option");
11488             if (!($styles_loaded{$package."_$option"})) {
11489 		&no_implementation("option","\`$option\' for \`$package\' package\n");
11490 	    }
11491 	}
11492     }
11493     $rest;
11494 }
11495 
11496 sub do_class_options {
11497     local($class,$options)=@_;
11498     local($option);
11499     if ($passedOptions{$class}) { $options = $passedOptions{$class}.'.'.$options };
11500     foreach $option (split (',',$options)) {
11501         $option =~ s/^[\s\t\n]*//o;
11502         $option =~ s/[\s\t\n]*$//o;
11503 	$option =~ s/\W/_/g; # replace non-alphanumerics
11504 	next unless ($option);
11505         &do_require_package($option);
11506         if (!($styles_loaded{$class."_$option"})) {
11507             &do_require_packageoption($class."_$option");
11508             if (!($styles_loaded{$class."_$option"})) {
11509 		&no_implementation("option","\`$option\' for document-class \`$class\'\n");
11510 	    }
11511 	}
11512     }
11513     $rest;
11514 }
11515 
11516 sub do_require_package {
11517     local($file)= @_;
11518     local($dir);
11519     #RRM: make common ps/eps-packages use  epsfig.perl
11520     $file = 'epsfig' if ($file =~ /^(psfig|epsf)$/);
11521 
11522     if (! $styles_loaded{$file}) {
11523 	# look for a file named ${file}.perl
11524 	# MRO: use $texfilepath instead of `..'
11525 	if ((-f "$texfilepath$dd${file}.perl") && ! $styles_loaded{$file}){
11526 	    print STDOUT "\nPackage: loading $texfilepath$dd${file}.perl";
11527 	    require("$texfilepath$dd${file}.perl");
11528 	    $styles_loaded{$file} = 1;
11529 	} else {
11530 	    foreach $dir (split(/$envkey/,$LATEX2HTMLSTYLES)) {
11531 		if ((-f "$dir$dd${file}.perl") && ! $styles_loaded{$file}){
11532 		    print STDOUT "\nPackage: loading $dir$dd${file}.perl";
11533 		    require("$dir$dd${file}.perl");
11534 	    	    $styles_loaded{$file} = 1;
11535 		    last;
11536 		}
11537 	    }
11538 	}
11539     }
11540 }
11541 
11542 sub do_require_extension {
11543     local($file)= @_;
11544     local($dir);
11545 
11546     if (! $styles_loaded{$file}) {
11547 	# look for a file named ${file}.pl
11548 	# MRO: use $texfilepath instead of `..'
11549 	if (-f "$texfilepath$dd${file}.pl") {
11550 	    print STDOUT "\nExtension: loading $texfilepath$dd${file}.pl";
11551 	    require("$texfilepath$dd${file}.pl");
11552 	    ++$styles_loaded{$file};
11553 	    $NO_UTF = 1 if (($file =~ /latin/)&&($charset =~/utf/));
11554 	} else {
11555 	    foreach $dir (split(/$envkey/,$LATEX2HTMLVERSIONS)) {
11556 		if (-f "$dir$dd${file}.pl"){
11557 		    print STDOUT "\nExtension: loading $dir$dd${file}.pl";
11558 		    require("$dir$dd${file}.pl");
11559 		    ++$styles_loaded{$file};
11560 		    $NO_UTF = 1 if (($file =~ /latin/)&&($charset =~/utf/));
11561 		    last;
11562 		}
11563 	    }
11564 	}
11565     } else {
11566 	if (($file =~ /latin|hebrew/)&&($charset =~/utf|10646/)
11567 			&& $loading_extensions) {
11568 	    $NO_UTF = 1;
11569 	    $USE_UTF = 0;
11570 	    print STDOUT "\n\n ...producing $CHARSET output\n";
11571 	    $charset = $CHARSET;
11572 	} 
11573     }
11574 }
11575 
11576 sub do_require_packageoption {
11577     local($option)= @_;
11578     local($do_option);
11579     # first look for a file named ${option}.perl
11580     &do_require_package($option) unless ($styles_loaded{$option});
11581     # next look for a subroutine named  do_$option
11582     $do_option = "do_$option";
11583     if (!($styles_loaded{$option}) && defined(&$do_option)) {
11584 	&$do_option();
11585 	$styles_loaded{$option} = 1;
11586     }
11587 }
11588 
11589 ############################ Environments ################################
11590 
11591 # This is a dummy environment used to synchronise the expansion
11592 # of order-sensitive macros.
11593 sub do_env_tex2html_deferred {
11594     local($_) = @_;
11595     local($tex2html_deferred) = 1;
11596     $_ = &process_command($single_cmd_rx,$_);
11597 }
11598 
11599 # catch wrapped commands that need not have been
11600 sub do_env_tex2html_nomath_inline {
11601     local($_) = @_;
11602     s/^\s+|\s+$//gs;
11603     my($cmd) = $_;
11604     if ($cmd=~s/^\\([a-zA-Z]+)//s) { $cmd = $1 };
11605     return (&translate_commands($_)) if ($raw_arg_cmds{$cmd}<1);
11606     &process_undefined_environment($env, $id, $_);
11607 }
11608 
11609 # The following list environment subroutines still do not handle
11610 # correctly the case where the list counters are modified (e.g. \alph{enumi})
11611 # and the cases where user defined bullets are mixed with the default ones.
11612 # e.g. \begin{enumerate} \item[(1)] one \item two \end{enumerate} will
11613 # not produce the same bullets as in the dvi output.
11614 sub do_env_itemize {
11615     local($_) = @_;
11616     local($dum1, $dum2);
11617     ($dum,$dum2) = &get_next_optional_argument; # discard optional argument
11618     $itemize_level++;
11619     #RRM - catch nested lists
11620     &protect_useritems($_);
11621     $_ = &translate_environments($_);
11622 
11623     local($bullet,$bulletx)=('&nbsp;','');
11624     SWITCH: {
11625 	if ($itemize_level==1) { $bulletx = "\\bullet"; last SWITCH; }
11626 	if ($itemize_level==2) { $bulletx = "\\mathbf{\\circ}"; last SWITCH; }
11627 	if ($itemize_level==3) { $bulletx = "\\mathbf{\\ast}"; last SWITCH; }
11628     }
11629     $itemize_level--;
11630 
11631     if (/\s*$item_description_rx/) {
11632 	# Contains user defined optional labels
11633 	$bulletx = &do_cmd_mbox("${O}1$C\$$bulletx\$${O}1$C") if $bulletx;
11634 	&do_env_itemize_compact($_, $bullet.$bulletx)
11635     } else { &list_helper($_,'UL'); }
11636 }
11637 
11638 sub do_env_itemize_compact{
11639     local($_, $bullet) = @_;
11640     #RRM - catch nested lists
11641     &protect_useritems($_);
11642     $_ = &translate_environments($_) unless ($bullet);
11643 
11644 	s/\n?$item_description_rx\s*($labels_rx8)?\s*/"<\/td><\/tr>\n<tr><td align=\"right\" valign=\"top\">". 
11645 	    (($9)? "<A ID=\"$9\">$1<\/A>" : $1 ) ."<\/td><td valign=\"top\">&nbsp;"/egm;
11646         s/\<\/td\>\<\/tr\>\n//s;
11647   "<table width=\"90%\">$_</td></tr></table>\n";
11648 }
11649 sub do_env_enumerate {
11650     local($_) = @_;
11651     local($dum1, $dum2);
11652     ($dum,$dum2) = &get_next_optional_argument; # discard optional argument
11653 # Reiner Miericke provided the main code; integrated by RRM: 14/1/97
11654 # works currently only with 'enumerate' and derived environments
11655 # explicit styled labels are computed for each \item
11656 # ultimately the environment is done as:  &do_env_description($_, " COMPACT")
11657     ++$enum_level;
11658     local(%enum) = %enum;		# to allow local changes
11659 # Reiner: \begin{enumerate}[<standard_label>]
11660     local($standard_label) = "";
11661     local(@label_fields);
11662     local($label_func, $preitems, $enum_type);
11663     local($rlevel) = &froman($enum_level); # e.g. 3 => iii
11664 
11665     # \begin{enumerate}[$standard_label]
11666     if (s/^$standard_label_rx//s) {		# multiline on/off ?
11667 	# standard label should be used later to modify
11668 	# entries in %enum
11669 	$standard_label = $1;		# save the standard label
11670 #	s/^$standard_label_rx//;	# and cut it off
11671 	$standard_label =~ s/([\\\[\]\(\)])/\\$1/g; # protect special chars
11672 
11673 	# Search for [aAiI1] which is not between a pair of { }
11674 	# Other cases like "\theenumi" are not handled
11675 	# @label_fields = $standard_label =~ /$enum_label_rx/;
11676 	# 07/13 2018 shige
11677 	my $std_label = $standard_label;
11678 	$std_label =~ s/$any_next_pair_rx/\{$2\}/g;
11679 	@label_fields = $std_label =~ /$enum_label_rx/;
11680 	$label_fields[0] =~ s/[\{\}]//g;
11681 	$label_fields[$#label_fields] =~ s/[\{\}]//g;
11682 	$std_label =~ s/[\{\}]//g;
11683 	if (($standard_label =~ /^[aAiI1]$/)&&(not(/item\s*\[/))) {
11684 	    $enum_type = ' TYPE="'.$standard_label.'"';
11685 	    $standard_label = '';
11686 	} else {
11687 	    $label_func = $enum_label_funcs{$label_fields[$#label_fields-1]} . 
11688 		"(\'enum" . $rlevel . "\')";
11689 	    $enum{'theenum' . $rlevel} = "\&$label_func";
11690 #	local($thislabel) = "\&$label_func";
11691 #	do { local($_) = $thislabel; &make_unique($_);
11692 #	     $enum{'theenum' . $rlevel} = $_; };
11693 	    # $standard_label = 
11694 	    # 07/13 2018 shige
11695 	    $standard_label = ($#label_fields > 0) ?
11696 		"\"$label_fields[0]\" . eval(\$enum{\"theenum$rlevel\"})"
11697 		. ".\"$label_fields[$#label_fields]\"" :
11698 		$std_label;    
11699 	    $enum{'labelenum' . $rlevel} = $standard_label;
11700 	}
11701     }  elsif (s/^((.|\n)+?)\\item/$preitems=$1;"\\item"/es) {
11702 	my $pre_preitems; local($cmd); $label_part;
11703 	my $num_styles = join('|', values %enum_label_funcs );
11704 	while ($preitems =~
11705 	    /\s*\\renew(ed)?command\s*(($O|$OP)\d+($C|$CP))\\?((label|the)enum(\w+))\s*\2/) {
11706 	    # this catches one  \renewcommand{\labelenum}{....} 
11707 	    $pre_preitems .= $`; $preitems = $'; $cmd = $5;
11708 	    &missing_braces unless (
11709 	        ($preitems=~s/$next_pair_pr_rx\s*/$label_part=$2;''/oe)
11710 	        ||($preitems=~s/$next_pair_rx\s*/$label_part=$2;''/oe));
11711 	    $cmd =~ s/^label/the/;
11712 	    $label_part=~s/\\($num_styles)\s*(($O|$OP)\d+($C|$CP))(\w+)\2/".\&$1\(\'$5\'\)."/g;
11713 	    $label_part = '"'.$label_part.'"';
11714 	    $enum{$cmd} = $label_part;
11715         }
11716 	# $standard_label = 
11717 	#    "\"$label_fields[0]\" . eval(\$enum{\"theenum$rlevel\"})"
11718 	#    . ".\"$label_fields[$#label_fields]\"" if ($cmd);
11719 	# 07/13 2018 shige
11720 	if ($cmd) {
11721 	    $standard_label = ($#label_fields > 0) ? 
11722 		"\"$label_fields[0]\" . eval(\$enum{\"theenum$rlevel\"})"
11723 		. ".\"$label_fields[$#label_fields]\"" :
11724 		$std_label;
11725 	}
11726 	$_ = $pre_preitems . $preitems . $_ if ($pre_preitems||$preitems);
11727     } else {
11728 	@enum_default_type = ('A', '1', 'a', 'i', 'A') unless (@enum_default_type);
11729 	$enum_type = $enum_level%4;
11730 	$enum_type = ' Type="'.@enum_default_type[$enum_type].'"';
11731     }
11732 
11733     # enclose contents of user-defined labels within a group,
11734     # in case of style-change commands, which could bleed outside the label.
11735     &protect_useritems($_);
11736     $_ = &translate_environments($_);	#catch nested lists
11737 
11738     local($enum_result);
11739     if (($standard_label)||(/\\item\[/)) {
11740 	# split it into items
11741 	@items = split(/\\item\b/,$_);
11742 	# save anything (non-blank) before the items actually start
11743 	$preitems = shift(@items);
11744 	$preitems =~ s/^\s*$//;
11745 	local($enum_label);
11746 	# prepend each item with an item label: \item => \item[<label>]
11747 	foreach $item (@items) {
11748 #	  unless ( $item =~ /^\s*$/ ) { # first line may be empty
11749 	    $enum{"enum" . $rlevel}++;	# increase enumi
11750 	    $enum_label = eval("$enum{'labelenum' . $rlevel}");
11751 	    # insert a label, removing preceding space, BUT...
11752 	    # do NOT handle items with existing labels
11753 	    $item =~ s/^\s*//;
11754 	    if ($item =~ s/^\s*\[([^]]*)\]//) {
11755 		$enum{"enum" . $rlevel}--;
11756 		$enum_label = "$1";
11757 		local($processed) = ($enum_label =~/$OP/);
11758 		$enum_label = join('',($processed ? "<#0#>" : "<<0>>")
11759 		    ,$enum_label ,($processed ? "<#0#>" : "<<0>>"))
11760 			if ($enum_label =~ /\\/);
11761 		if ($processed) { &make_unique_p($enum_label) }
11762 		elsif ($enum_label =~ /$O/) { &make_unique($enum_label) };
11763 		$item = "[${enum_label}]".$item;
11764 	    } else { 
11765 		local($processed) = ($enum_label =~/$OP/);
11766 		$enum_label = join('',($processed ? "<#0#>" : "<<0>>")
11767 		    ,$enum_label ,($processed ? "<#0#>" : "<<0>>"))
11768 			if ($enum_label =~ /\\/);
11769 		if ($processed) { &make_unique_p($enum_label) }
11770 		elsif ($enum_label =~ /$O/) { &make_unique($enum_label) };
11771 		$item = "[$enum_label\]$item";
11772 		$enum_label =~ s/\.$//;
11773 	    }
11774 	    # if ($standard_label) {
11775 	    # 07/13 2018 shige
11776 	    if ($standard_label && $standard_label !~ /eval\(/) {
11777 	        $item =~ s/(\\labelitem$rlevel|$standard_label)/$enum_label/g
11778 	    } else {
11779 	        $item =~ s/(\\labelitem$rlevel)/$enum_label/g
11780 	    }
11781 	};
11782 	$_ = join("\\item ", $preitems, @items);
11783 
11784 	# Original, but $enum_result
11785 	$enum_result = &do_env_description($_, " class=\"COMPACT\"");
11786     } else {
11787 	$enum_result = &list_helper($_, "OL$enum_type", '', '');
11788     }
11789 
11790     #clean-up and revert the $enum_level
11791     $enum{"enum" . $rlevel} = 0;
11792     $enum{"enum" . &froman($enum_level)} = 0;
11793     --$enum_level;
11794     $enum_result;
11795 }
11796 
11797 sub do_env_list {
11798     local ($_) = @_;
11799     local ($list_type,$labels,$lengths) = ('UL','','');
11800 
11801     $labels = &missing_braces unless	 ( # get the label specifier
11802 	(s/$next_pair_pr_rx/$labels=$2;''/e)
11803 	||(s/$next_pair_rx/$labels=$2;''/e));
11804 
11805     $lengths = &missing_braces unless ( # get the length declarations
11806 	(s/$next_pair_pr_rx/$lengths=$2;''/e)
11807 	||(s/$next_pair_rx/$lengths=$2;''/e));
11808     # switch to enumerated style if they include a \usecounter.
11809     $list_type = 'OL' if $lengths =~ /\\usecounter/;
11810 
11811     /\\item\b/; local($preitems) = $`;
11812 	$_ =~ s/^\Q$preamble//s if ($preitems);
11813     $preitems =~s/^\s*|\s*$//g;
11814     if ($preitems) {
11815 	$preitems = &translate_environments($preitems);
11816 	$preitems = &translate_commands($preitems) if ($preitems =~ /\\/);
11817 #	&write_warnings("\nDiscarding: $preitems before 1st item in list")
11818 #	    if ($preitems);
11819     }
11820 
11821     #RRM - catch nested lists
11822     #RRM unfortunately any uses of the \\usecounter  within \item s
11823     #    may be broken --- sigh.
11824     &protect_useritems($_);
11825     $_ = &translate_environments($_);
11826 
11827     if (($list_type =~ /OL/)&&($labels)) {
11828 	local($br_ida,$br_idb,$label,$aft);
11829 	$br_ida = ++$global{'max_id'};
11830 	$lengths =~ s/\\usecounter((($O|$OP)\d+($C|$CP))[^<]+\2)/
11831 		&make_nowrapper(1)."\\stepcounter$1".&make_nowrapper(0)/e;
11832 	$labels = "$O$br_ida$C$lengths$O$br_ida$C".$labels;
11833 
11834 #	s/\\item\b\s*([^\[])/do {
11835 #		$label = $labels; $aft = $1;
11836 #		$br_id = ++$global{'max_id'};
11837 #		$label = &translate_environments(
11838 #			"$O$br_id$C$label$O$br_id$C");
11839 #		join('',"\\item\[" , $label, "\]$aft" );
11840 #	    }/eg;
11841 #	$labels ='';
11842     }
11843 
11844     if (($labels)||(/\\item\[/)) {
11845 	$_ = &list_helper($_, 'DL', $labels, $lengths)
11846     } else {
11847 	$_ = &list_helper($_, $list_type, '', $lengths)
11848     }
11849     $_;
11850 }
11851 
11852 sub do_env_trivlist {
11853     local($_) = @_;
11854     local($compact,$item_sep,$pre_items) = ' class="COMPACT"';
11855     &protect_useritems($_);
11856 
11857     # assume no styles initially for this list
11858     local($close_tags,$reopens) = &close_all_tags();
11859     local($open_tags_R) = [];
11860     local(@save_open_tags) = ();
11861 
11862     # include \label anchors from [...] items
11863     s/$item_description_rx\s*($labels_rx8)?\s*/
11864 	(($9)? "<A ID=\"$9\">$1<\/A>" : $1 ) ."\n"/eg;
11865     # remove unwanted space before \item s
11866     s/[ \t]*\\item\b/\\item/g;
11867     
11868     local($this_item,$br_id) = ('','');
11869     local($this_sitem,$this_eitem) = ("\n<P>","</P>\n",'');
11870 
11871     # assume no sub-lists, else...  why use {trivlist} ?
11872     # extract up to the 1st \item
11873     local(@items) = split(/\\item\b/, $_);
11874     $pre_items = shift @items;
11875     $_ = '';
11876     while (@items) {
11877 	$br_id = ++$global{'max_id'};
11878 	$this_item = shift @items;
11879 	$this_item = &translate_environments(
11880 	     "$O$br_id$C".$pre_items.$this_item."$O$br_id$C" );
11881 	if ($this_item =~ /\\/) {
11882 	    $this_item = &translate_commands($this_item);
11883 	    $_ .= join('' , $this_sitem 
11884 		       , $this_item
11885 		       # , $this_eitem
11886 		       )
11887 	} else { $_ .= $this_sitem . $this_item }
11888     }
11889 	
11890     $_ = &translate_environments($_);
11891     $_ = &translate_commands($_);
11892 
11893     join('' , $close_tags , $_ , $reopens);
11894 
11895 }
11896 
11897 # enclose the contents of any user-defined labels within a group,
11898 # else any style-change commands may bleed outside the label.
11899 sub protect_useritems {
11900     # MRO: use $_[0] instead: local(*_) = @_;
11901     local($preitems, $thisitem);
11902     $_[0] =~ s/^$par_rx\s*//s; # discard any \par before 1st item
11903 
11904     # locate \item with optional argument 
11905     local($saveRS) = $/; undef $/;
11906     local(@preitems);
11907     # allow one level of nested []
11908     # MRO: Caution! We have a double-wildcarded RX here, this may cause
11909     # trouble. Should be re-coded.
11910     $_[0] =~ s/\\item[\s\r]*(\b(\[(([^\[\]]|\[[^]]*\])*)\])?|[^a-zA-Z\s])/
11911 	$thisitem = " $1";
11912 	if ($2) {
11913 	    $br_id = ++$global{'max_id'};
11914 	    $thisitem = '['.$O.$br_id.$C.$3.$O.$br_id.$C.']';
11915 	};
11916 	"\\item".$thisitem
11917     /egm;
11918 
11919     $/ = $saveRS;
11920     $_[0] = join(@preitems, $_[0]);
11921 }
11922 
11923 sub do_env_description {
11924     local($_, $compact, $bullet) = @_;
11925     local($dum1, $dum2);
11926     ($dum,$dum2) = &get_next_optional_argument; # discard optional argument
11927     #RRM - catch nested lists
11928     &protect_useritems($_);
11929     $_ = &translate_environments($_) unless ($bullet);
11930 
11931     # MRO: replaced $* with /m
11932     $compact = "" unless $compact;
11933     if ($compact) {		# itemize/enumerate with optional labels
11934 	s/\n?$item_description_rx\s*($labels_rx8)?\s*/"\n<\/DD>\n<DT>". 
11935 	    (($9)? "<A ID=\"$9\">$1<\/A>" : $1 ) ."<\/DT>\n<DD>"/egm;
11936     } else {
11937 	s/\n?$item_description_rx\s*($labels_rx8)?\s*/"\n<\/DD>\n<DT>". 
11938 	    (($9)? "<A ID=\"$9\"><STRONG>$1<\/STRONG><\/A>"
11939 	     : "<STRONG>$1<\/STRONG>") ."<\/DT>\n<DD>"/egm;
11940     }
11941     # and just in case the description is empty ...
11942 #JCL(jcl-del) - $delimiter_rx -> ^$letters
11943     s/\n?\\item\b\s*([^$letters\\]|)\s*/\n<\/DD>\n<DT>$bullet<\/DT>\n<DD>$1/gm;
11944     s/^\s+//m;
11945 
11946     $_ = '<DD>'.$_ unless ($_ =~ s/^\s*<\/D(T|D)>\n?//s);
11947     $_ =~ s/\n$//s;
11948     "<DL$compact>\n$_\n</DD>\n</DL>";
11949 }
11950 
11951 # add html tags for list and for individual list items
11952 # $tag is UL OL or DL
11953 # replaces \item in $_ with <LI> or <DT>..<DD>
11954 sub list_helper {
11955     local($_, $tag, $labels, $lengths) = @_;
11956     local($item_sep,$pre_items,$compact,$etag,$ctag);
11957     $ctag = $tag; $ctag =~ s/^(.*)\s.*$/$1/;
11958 
11959     # assume no styles initially for this list
11960     local($close_tags,$reopens) = &close_all_tags();
11961     local($open_tags_R) = [];
11962     local(@save_open_tags) = ();
11963 
11964 #    #RRM: cannot have anything before the first <LI>
11965 #    local($savedRS) = $/; $/='';
11966 #    $_ =~ /\\item[\b\r]/s;
11967 #    if ($`) { 
11968 #	$pre_items = $`; $_ = $&.$';
11969 #	$pre_items =~ s/<P( [^>]*)?>//g;
11970 #	$close_tags .= "\n".$pre_items if $pre_items;
11971 #    }
11972 #    $/ = $savedRS; 
11973 #
11974 
11975     if (($tag =~ /DL/)&&$labels) {
11976 	local($label,$aft,$br_id);
11977 	s/\\item\b[\s\r]*([^\[])/do {
11978 		$label = $labels; $aft = $1;
11979 		$br_id = ++$global{'max_id'};
11980 		$label = &translate_environments(
11981 			"$O$br_id$C$label$O$br_id$C");
11982 		join('',"\\item\[" , $label, "\]$aft" );
11983 	    }/egm;
11984     }
11985 
11986     # This deals with \item[xxx] ...
11987     if ($tag =~ /DL/) {
11988 	$compact = ' class="COMPACT"';
11989 	# include \label anchors in the <DT> part
11990 	# and  $pre_item  tags in the <DD> part:
11991 	if ($labels && $lengths) { 
11992 	    $item_sep = "\n</DD>\n<DT>";
11993 	} else {
11994 	    $item_sep = ($labels ? "<DT>$labels\n" : '') ."</DT>\n<DD>";
11995 	}
11996 	$etag = "\n</DD>";
11997 	s/$item_description_rx[\r\s]*($labels_rx8)?[\r\s]*/"<DT>" .
11998 	    (($9)? "<A ID=\"$9\">$1<\/A>" : $1 ) ."\n<DD>"/egm;
11999     } else {
12000 	$item_sep = "\n</LI>\n<LI>";
12001 	$etag = "\n</LI>";
12002     }
12003 
12004     # remove unwanted space before \item s
12005     s/[ \t]*\\item\b/\\item/gm;
12006 
12007     #JCL(jcl-del) - $delimiter_rx -> ^$letters
12008     s/\n?\\item\b[\r\s]*/$item_sep/egm;
12009 
12010     #RRM: cannot have anything before the first <LI>
12011     local($savedRS) = $/; $/='';
12012     $_ =~ /\Q$item_sep\E|<DT>|<LI>|$/s;
12013     #RRM: ...try putting it before the list-open tag
12014     if ($`) { 
12015 	$pre_items = $`; $_ = $&.$';
12016 	$pre_items =~ s/<P( [^>]*)?>//gm;
12017 	$close_tags = '' unless $pre_items;
12018     }
12019     # remove \n from end of the last item
12020     $_ =~ s/\n$//s;
12021     $_ .= $etag."\n";
12022     # remove extra </li> before first item
12023     $_ =~ s/^\s*<\/[^>]+>\s*//s;
12024 
12025     $/ = $savedRS;
12026 
12027     join('' , "\n<$tag$compact>\n" 
12028 	 , $pre_items , $_ , $close_tags , "</$ctag>");
12029 }
12030 
12031 
12032 # RRM:  A figure environment generates a picture UNLESS it contains a 
12033 # {makeimage} sub-environment; in which case it creates a <DIV>
12034 # inside which the contents are interpreted as much as is possible.
12035 # When there are captions, this modifies $before .
12036 sub do_env_figure {
12037     local($_) = @_;
12038     local($halign, $anchors) = ('CENTER','');
12039     local ($border, $attribs );
12040     local($cap_width) = $cap_width;
12041     my ($opt, $dummy) = &get_next_optional_argument;
12042 
12043     my $abovedisplay_space = $ABOVE_DISPLAY_SPACE||"<P></P>\n";
12044     my $belowdisplay_space = $BELOW_DISPLAY_SPACE||"<P></P>\n";
12045 
12046     ($_,$anchors) = &extract_labels($_); # extract labels
12047     # Try to establish the alignment
12048     if (/^(\[[^\]]*])?\s*\\begin\s*<<\d*>>(\w*)<<\d*>>|\\(\w*)line/) {
12049 	$halign = $2.$3;
12050 	if ($halign =~ /right/i)  { $halign = 'RIGHT' }
12051 	elsif ($halign =~ /left/i) { $halign = 'LEFT' }
12052 	elsif ($halign =~ /center/i) { $halign = 'CENTER' }
12053 	else { $halign = 'CENTER' }
12054     }
12055 
12056     # allow caption-alignment to be variable
12057     local($cap_align);
12058     if ($FIGURE_CAPTION_ALIGN =~ /^(TOP|BOTTOM|LEFT|RIGHT)/i) {
12059 	$cap_align = join('', ' class="', $&, $','"')};  
12060 
12061     local($cap_env, $captions,$has_minipage) = ('figure','');
12062     if ((/\\begin\s*($O\d+$C)\s*(makeimage|minipage)\s*\1|\\docode/)||
12063 	(/\\includegraphics/&&(!/$htmlborder_rx|$htmlborder_pr_rx|\\htmlimage/))){
12064 	$has_minipage = ($2 =~ /minipage/sg );
12065 	$_ = &translate_environments($_);
12066 	if (s/$htmlborder_rx//o) { $attribs = $2; $border = (($4)? "$4" : 1) }
12067 	elsif (s/$htmlborder_pr_rx//o) { $attribs = $2; $border = (($4)? "$4" : 1) }
12068 	do { local($contents) = $_;
12069 	    &extract_captions($cap_env); $_ = $contents;
12070 	} if (/\\caption/);
12071 	$_ = &translate_commands($_);
12072 	while ($_ =~ s/(^\s*<BR>\s*|\s*<BR>\s*$)//sg){}; # remove unneeded breaks
12073     } else {
12074 	do { local($contents) = $_;
12075 	    # MRO: no effect: &extract_captions($cap_env, *cap_width); $_ = $contents;
12076 	    &extract_captions($cap_env); $_ = $contents;
12077 	} if (/\\caption/);
12078 	# Generate picture of the whole environment
12079 	if (s/$htmlborder_rx//o) { $attribs = $2; $border = (($4)? "$4" : 1) }
12080 	elsif (s/$htmlborder_pr_rx//o) { $attribs = $2; $border = (($4)? "$4" : 1) }
12081 	$_ = &process_undefined_environment($env, $id, $_);
12082 	$_ = &post_latex_do_env_figure($_);
12083 	$_ =~ s/\s*<BR>\s*$//g;
12084     }
12085 
12086     if ($captions) {
12087         # MRO: replaced $* with /m
12088         $captions =~ s/^\n//m;
12089         $captions =~ s/\n$//m;
12090     }
12091     s/$caption_mark//g;
12092 
12093     local($close_tags) = &close_all_tags;
12094     $_ .= $close_tags;
12095 
12096     # place all the pieces inside a TABLE, if available
12097     if ($HTML_VERSION > 2.1) {
12098 	if ($captions) {
12099 	    local($pxs,$len) = &convert_length($cap_width,$MATH_SCALE_FACTOR)
12100 		if $cap_width;
12101 	    local($table) = "<TABLE$env_id"; # WIDTH="65%"';
12102 	    $table .= " WIDTH=\"$pxs\"" if ($pxs);
12103 	    if ($border) { $table .= " BORDER=\"$border\"" } # no checking !!
12104 	    $table .= ">";
12105 	    s/^\s*|\s*$//g;
12106 	    join (''
12107 		    , $above_display_space
12108 		    , "\n<DIV", ($halign ? " class=\"$halign\"" :'')
12109 		    , '>', $anchors , $cap_anchors
12110 		    , "\n$table\n<CAPTION", $cap_align, '>'
12111 		    , $captions , "</CAPTION>\n<TR><TD>"
12112 		    , ($cap_width ? '</TD><TD>' : '')
12113 		    , $_ , '</TD>'
12114 		    , ($cap_width ? '<TD></TD>' : '')
12115 		    , "</TR>\n</TABLE>\n</DIV>\n"
12116 		    , $below_display_space
12117 	    )
12118 	} elsif ($halign) {
12119 	    if ($border||($attributes)||$env_id) {
12120 		&make_table( $border, $attribs, $anchors, '', $halign, $_ );
12121 	    } else {
12122 		join (''
12123 			, $above_display_space
12124 			, "\n<DIV class=\"$halign\">\n"
12125 			, ($anchors ? "\n<P>$anchors</P>" : '')
12126 			, $_
12127 			, "\n</DIV>"
12128 			, $below_display_space
12129 		)
12130 	    }
12131 	} else {
12132 	    if ($border||($attributes)||$env_id) {
12133 		join (''
12134 			, $above_display_space
12135 			, "\n<DIV", ($halign ? " class=\"$halign\"":'')
12136 			, '>'
12137 			, &make_table( $border, $attribs, $anchors, '', $halign, $_ )
12138 			, "\n</DIV><BR"
12139 			, (($HTML_VERSION > 3.1)? " CLEAR=\"ALL\"" :'')
12140 			, '>'
12141 			, $below_display_space
12142 		);
12143 	    } else {  
12144 		join (''
12145 			, $above_display_space
12146 			, "\n<DIV", ($halign ? " class=\"$halign\"":'')
12147 			, ">$anchors\n" , $_ , "\n</DIV><BR"
12148 			, (($HTML_VERSION > 3.1)? " CLEAR=\"ALL\"" :'')
12149 			, '>'
12150 			, $below_display_sp