#!/usr/bin/perl -w use strict; use XML::Parser; if ($#ARGV > 1 || $#ARGV < 0) { die "Syntax: $0 []\n"; } my $targetdir = '../resources/helpsets'; my $dictdir = '../resources/dictionaries'; my $mainclass = '../java/MakeGlossariesInvoker.java'; my $base = 'makeglossariesgui'; my $fontenc = 'T1'; # mapping between locales and babel options my %babel = ( 'en' => 'english', 'en-GB' => 'british', 'en-US' => 'american', 'fr' => 'frenchb' ); my $lang = $ARGV[0]; my $locale = $lang; if ($#ARGV == 1) { $locale .= "-".$ARGV[1]; } my $wwwpath; if (defined($ENV{'MAKEJMLRBOOKGUI_MANUAL_HTML'})) { $wwwpath = $ENV{'MAKEJMLRBOOKGUI_MANUAL_HTML'}; if ($lang ne 'en') { $wwwpath .= "-$lang"; } } my $encoding_file = 'utf8'; my $encoding_xml = 'UTF-8'; my $fd; open $fd, "<:encoding($encoding_xml)", $mainclass or die "Can't open '$mainclass' $!\n"; my %dict = (); while (<$fd>) { if (/\bstatic +final +String +APP_NAME *= *"(.+)";/) { $dict{appname} = $1; } elsif (/\bstatic +final +String +APP_VERSION *= *"(.+)";/) { $dict{appversion} = $1; } elsif (/\bstatic +final +String +APP_DATE *= *"([^"]+)"/) { $dict{appdate} = $1; } } close $fd; my $propfile = "$dictdir/$base-$locale.prop"; if (not (-e $propfile) and ($lang ne $locale)) { $propfile = "$dictdir/$base-$lang.prop"; unless (-e $propfile) { die "Can't find either '$dictdir/$base-$locale.prop' or '$propfile'\n"; } } unless (-e $propfile) { die "Can't find '$propfile'\n"; } open $fd, "<:encoding($encoding_xml)", "$propfile" or die "Can't open '$propfile' $!\n"; $_ = <$fd>; if (/# Encoding: ([^s]+)/) { if ($1 ne $encoding_xml) { binmode($fd, ":encoding($1)"); } } else { die "Encoding comment line missing from line 1 of '$propfile'\n"; } my $linenum = 1; my $openquote = chr(hex(2018)); my $closequote = chr(hex(2019)); while (<$fd>) { $linenum++; next if (/^ *#/ or /^ *$/); if (/^([^=]+)=(.*)$/) { my $dictkey = $1; my $value = $2; $value=~s/\\{1}[nt]/ /g; $value=~s/(\w)''(\w)/$1$closequote$2/g; $value=~s/'{2}([^']+)'{2}/$openquote$1$closequote/g; $value=~s/'{2}/$closequote/g; $value=~s/\|([a-zA-Z]+)\|/\\cs{$1}/g; # strip any trailing ellipsis $value=~s/\.{3}$//g; # Don't need the complexity of the Java application here. # (Many of the messages aren't used in the manual, just the # menu items, button labels and dialog titles are required.) $value=~s/\{\d,choice,[^\}]+\|<([^\}]*)\}/$1/g; $value=~s/\{(\d+)(,[^\}]+)?\}/&arg_placeholder($1)/eg; $dict{$dictkey} = $value; } else { warn "$propfile: Can't parse line $linenum\n"; } } close $fd; my %docinfo = (); my @nodes = (); my @current = (); my @paragraph = (); my %tags = (); my $languagedefinitions = "\\def\\idxpackagename{".&get_label('manual.idxpackage')."}\n" ."\\def\\idxenvname{".&get_label('manual.idxenv')."}\n" ."\\def\\examplename{".&get_label('manual.example')."}\n"; my $xmlfile = "$base-$locale.xml"; if (not (-e $xmlfile) and ($lang ne $locale)) { $xmlfile = "$base-$lang.xml"; unless (-e $xmlfile) { die "Can't find either '$base-$locale.xml' or '$xmlfile'\n"; } } unless (-e $xmlfile) { die "Can't find '$xmlfile'\n"; } my $texfile = "$base-$locale.tex"; my $helpsetdir = "$targetdir/$base-$locale"; unless (-e $helpsetdir) { mkdir $helpsetdir or die "Can't mkdir '$helpsetdir' $!\n"; } unless (-d $helpsetdir) { die "'$helpsetdir' is not a directory\n"; } # Is there any way of querying the input encoding picked up by # XML::Parser? Let's just stick to utf8 my $inputenc = 'utf8'; my %section_levels = ( 'chapter' => '1', 'section' => '2', 'subsection' => '3', 'subsubsection' => '4', 'paragraph' => '5' ); my %acros = (); my %terms = (); my @float_elements = (); my @tabular_specs = (); my %counters = (); # open the TeX file my $texfd; open $texfd, ">:encoding($encoding_xml)", $texfile or die "Can't open '$texfile' $!\n"; # initialize the parser my $parser = XML::Parser->new( Handlers => { Start=>\&handle_start, End=>\&handle_end, Char=>\&handle_char }); $parser->parsefile( $xmlfile ); close $texfd; # Write helpset files my $hsfd; open $hsfd, ">:encoding($encoding_xml)", "$helpsetdir/$base.hs" or die "Can't open '$helpsetdir/$base.hs' $!\n"; my $toctitle = &get_label('manual.toc'); my $manualtitle = &get_label('manual.title'); my $indextitle = &get_label('manual.index'); my $searchtitle = &get_label('manual.search'); print $hsfd <<_END_HS_HEAD; $manualtitle top TOC javax.help.TOCView ${base}TOC.xml Index javax.help.IndexView ${base}Index.xml Search javax.help.SearchView JavaHelpSearch main window $manualtitle javax.help.HomeAction javax.help.BackAction javax.help.ForwardAction appIcon secondary window appIcon _END_HS_HEAD close $hsfd; my $htmlfd; open $htmlfd, ">:encoding($encoding_xml)", "$helpsetdir/$base.html" or die "Can't open '$helpsetdir/$base.html' $!\n"; print $htmlfd &html_head($docinfo{Title}, '', $nodes[0]->{Tag}); print $htmlfd "\n"; print $htmlfd "

", $docinfo{Title}, "

\n"; print $htmlfd "

$docinfo{Author}

\n" if ($docinfo{Author}); print $htmlfd "
"; print $htmlfd "

$docinfo{Date}

\n" if ($docinfo{Date}); print $htmlfd "
"; print $htmlfd &html_nav('', $nodes[0]); print $htmlfd "\n\n"; close $htmlfd; my $wwwfd; my $wwwsidebarfd; if (defined($wwwpath)) { open $wwwfd, ">:encoding($encoding_xml)", "$wwwpath/index.shtml" or die "Can't open '$wwwpath/index.shtml' $!\n"; print "Writing '$wwwpath/index.shtml'\n"; print $wwwfd &html_www_head($docinfo{Title}, '', $nodes[0]->{Tag}); print $wwwfd '

', $docinfo{Title}, "

\n"; if ($docinfo{Author}) { my $docauthor = $docinfo{Author}; $docauthor=~s~(.*?)
~$1~sg; $docauthor=~s~(.*?)~
$1
~sg; $docauthor=~s~(.*?)~$1~sg; print $wwwfd "$docauthor\n"; } print $wwwfd "
"; print $wwwfd "$docinfo{Date}
\n" if ($docinfo{Date}); open $wwwsidebarfd, ">:encoding($encoding_xml)", "$wwwpath/sidebar.shtml" or die "Can't open '$wwwpath/sidebar.shtml' $!\n"; print $wwwsidebarfd "$dict{appname}"; print $wwwsidebarfd <<_END_SIDEBAR_LI; \n"; print $wwwsidebarfd "\n\n"; } } print $tocfd "{Title}\" target=\"$node->{Tag}\">\n"; if (defined($wwwfd)) { if ($section_levels{$node->{Type}} > $prevlevel) { print $wwwfd "\n\n" if defined($wwwsidebarfd); } } print $tocfd "\n\n"; close $tocfd; if (defined($wwwfd)) { print $wwwfd &html_www_foot('', 'glossary'); close $wwwfd; close $wwwsidebarfd; # write glossary file &write_www_glossary($nodes[0]); } # write map file my $mapfd; open $mapfd, ">:encoding($encoding_xml)", "$helpsetdir/Map.jhm" or die "Can't open '$helpsetdir/Map.jhm' $!\n"; print $mapfd <<_END_MAP_HEAD; _END_MAP_HEAD print $mapfd "\n"; print $mapfd "\n"; print $mapfd "\n"; print $mapfd "\n"; print $mapfd "\n"; &hs_map_id(\%tags); &hs_map_id(\%terms); print $mapfd "\n"; close $mapfd; # Write the helpset index file my $idxfd; open $idxfd, ">:encoding($encoding_xml)", "$helpsetdir/${base}Index.xml" or die "Can't open '$helpsetdir/${base}Index.xml' $!\n"; print $idxfd <<_END_IDX_HEAD; _END_IDX_HEAD &print_idx_entries(\%terms); print $idxfd "\n"; close $idxfd; sub print_idx_entries{ my ($hash) = @_; foreach my $key (keys %$hash) { if ($hash->{$key}->{Text}) { my $text = $hash->{$key}->{Text}; $text=~s/<\/?[^>]*>//g; print $idxfd "\n"; if ($hash->{$key}->{Children}) { &print_idx_entries($hash->{$key}->{Children}); } print $idxfd "\n"; } else { warn "Text not set for '$key'\n"; } } } sub handle_char{ my( $expat, $string ) = @_; &handle_html($string); print $texfd $string; } sub hs_map_id{ my ($hash) = @_; foreach my $tag (keys %$hash) { if ($hash->{$tag}->{Ref}) { print $mapfd "{$tag}->{Ref}\" />\n"; } else { warn "No Ref found for '$tag'\n"; } if ($hash->{$tag}->{Children}) { &hs_map_id($hash->{$tag}->{Children}); } } } sub hs_index_term{ my ($tag, $text, $term, $hash) = @_; if ($hash->{$tag}) { &handle_html($text); } else { $hash->{$tag}->{Text} = $term; $hash->{$tag}->{Ref} = $nodes[$#nodes]->{Tag}.".html#$tag"; &handle_html("$text"); } } sub hs_popup{ my ($href, $text) = @_; my $tag = $href; if ($href=~/(.*)\.html/) { $tag = $1; } my $html = <<_END_POPUP; _END_POPUP # no EOL after text return "$html$text"; } sub handle_html{ my ($string) = @_; if ($#current > -1) { my $element = $current[$#current]; $docinfo{$element} .= $string; } elsif ($#nodes > -1) { $nodes[$#nodes]->{Contents} .= $string; } } sub handle_start { my( $expat, $element, %attrs ) = @_; my $sub = "start_$element"; if (defined(&$sub)) { { no strict 'refs'; &$sub($expat, %attrs); } } else { die "Don't know what to do with '<$element>'\n"; } } sub handle_end { my( $expat, $element ) = @_; my $sub = "end_$element"; if (defined(&$sub)) { { no strict 'refs'; &$sub($expat); } } else { die "Don't know what to do with ''\n"; } } sub get_ref{ my ($tag) = @_; unless ($tags{$tag}) { die "Unknown tag '$tag'\n"; } my $ref = $tags{$tag}->{Ref}; my $text = $tags{$tag}->{Text}; "$text"; } sub get_label{ my ($tag, $attrs, $expat) = @_; unless ($dict{$tag}) { if ($expat) { die "No dictionary entry for tag '$tag' on line ", $expat->current_line, "\n"; } else { die "No dictionary entry for tag '$tag'\n"; } } my $text = $dict{$tag}; if ($attrs) { $text=~s/\$(\d)/$attrs->{"arg$1"}/eg; } # strip any trailing ellipsis $text=~s/\.{3}$//; $text } sub start_manual{ my ($expat, %attrs) = @_; if ($attrs{fontenc}) { $fontenc = $attrs{'fontenc'}; } print $texfd "% arara: pdflatex\n"; print $texfd "% arara: makeglossaries\n"; print $texfd "% arara: pdflatex\n"; print $texfd "% arara: makeindex\n"; print $texfd "% arara: pdflatex\n"; print $texfd "\\documentclass[index=totoc,$babel{$locale}]{makeglossariesgui}\n"; } sub end_manual{ my ($expat) = @_; } sub start_preamble{ my ($expat, %attrs) = @_; print $texfd "\\usepackage[$inputenc]{inputenc}\n", "\\usepackage[$fontenc]{fontenc}\n", "\\usepackage{lmodern}\n", "\\usepackage{graphicx}\n", "\\usepackage{verbatim}\n", "\\usepackage{alltt}\n", "\\usepackage{moreverb}\n", "\\usepackage{makeidx}\n", "\\usepackage{babel}\n", "\\usepackage[colorlinks]{hyperref}\n", "\\usepackage[toc]{glossaries}\n", "\\makeglossaries\n\\makeindex\n", $languagedefinitions; } sub end_preamble{ my ($expat) = @_; } sub start_title{ my ($expat, %attrs) = @_; push @current, 'Title'; print $texfd "\\title{"; } sub end_title{ my ($expat) = @_; pop @current; print $texfd "}\n"; } sub start_date{ my ($expat, %attrs) = @_; push @current, 'Date'; print $texfd "\\date{"; } sub end_date{ my ($expat) = @_; pop @current; print $texfd "}\n"; } sub start_author{ my ($expat, %attrs) = @_; push @current, 'Author'; unless ($docinfo{Author}) { $docinfo{Author} = " "; } $docinfo{Author} .= "
"; print $texfd "\\Author{"; } sub end_author{ my ($expat) = @_; $docinfo{Author} .= "
"; pop @current; print $texfd "}\n"; } sub start_document{ my ($expat, %attrs) = @_; print $texfd "\\begin{document}\n\\maketitle\n\\tableofcontents\n"; } sub end_document{ my ($expat) = @_; print $texfd "\\end{document}\n"; } sub start_node{ my ($expat, %attrs) = @_; unless ($attrs{type}) { die "Missing 'type' attribute for element 'node' on line ", $expat->current_line, "\n"; } unless ($attrs{tag}) { die "Missing 'tag' attribute for element 'node' on line ", $expat->current_line, "\n"; } unless ($attrs{title}) { die "Missing 'title' attribute for element 'node' on line ", $expat->current_line, "\n"; } my $currentlevel = $section_levels{$attrs{type}}; unless ($currentlevel) { die "Unknown section level '$attrs{type}' on line ", $expat->current_line, "\n"; } my $lastlevel; if ($#nodes == -1) { $lastlevel = 0; } else { $lastlevel = $section_levels{$nodes[$#nodes]->{Type}}; } unless ($currentlevel <= $lastlevel+1) { die "Node '$attrs{tag}' type can't be deeper than '", $section_levels{$lastlevel+1},"' on line ", $expat->current_line, "\n"; } my %node = ( Type => $attrs{type}, Title => $attrs{title}, Tag => $attrs{tag}, Contents => '', Footnotes => '' ); push @nodes, \%node; $tags{$attrs{tag}}->{Ref} = $attrs{tag}.'.html'; $tags{$attrs{tag}}->{Text} = $attrs{title}; print $texfd "\\", $attrs{type}, "{", $attrs{title}, "}\\label{", $attrs{tag}, "}\n"; } sub end_node{ my ($expat) = @_; } sub start_newacro{ my ($expat, %attrs) = @_; unless ($attrs{tag}) { die "Missing 'tag' attribute for element 'newacro' on line ", $expat->current_line, "\n"; } unless ($attrs{short}) { die "Missing 'short' attribute for element 'newacro' on line ", $expat->current_line, "\n"; } unless ($attrs{long}) { die "Missing 'long' attribute for element 'newacro' on line ", $expat->current_line, "\n"; } my $tag = $attrs{tag}; if ($acros{$tag}) { die "Acronym '$tag' already defined\n"; } $acros{$tag}->{Short} = $attrs{short}; $acros{$tag}->{Long} = $attrs{long}; # write html file used by popup window open $fd, ">:encoding($encoding_file)", "$helpsetdir/acr_$tag.html" or die "Can't open '$helpsetdir/acr_$tag.html' $!\n"; print $fd &html_head($attrs{short}); print $fd "\n

$attrs{short}

\n", ucfirst($attrs{long}), ".\n"; print $fd "\n\n"; close $fd; print $texfd "\\newacronym{$tag}{$attrs{short}}{$attrs{long}}\n"; } sub end_newacro{ my ($expat) = @_; } sub start_newterm{ my ($expat, %attrs) = @_; unless ($attrs{tag}) { die "Missing 'tag' attribute for element 'newterm' on line ", $expat->current_line, "\n"; } unless ($attrs{text}) { die "Missing 'text' attribute for element 'newterm' on line ", $expat->current_line, "\n"; } my $tag = 'gls_'.$attrs{tag}; if ($terms{$tag}) { die "Term '", $attrs{tag}, "' already defined\n"; } $terms{$tag}->{Text} = $attrs{text}; if ($attrs{description}) { $terms{$tag}->{Description} = $attrs{description}; $terms{$tag}->{Fmt} = $attrs{fmt}; # write html file used by popup window if a description has been # supplied open $fd, ">:encoding($encoding_file)", "$helpsetdir/$tag.html" or die "Can't open '$helpsetdir/$tag.html' $!\n"; print $fd &html_head($attrs{text}); print $fd "\n

"; if ($attrs{fmt}) { print $fd "<$attrs{fmt}>$attrs{text}"; } else { print $fd $attrs{text}; } print $fd "

\n", ucfirst($attrs{description}), ".\n"; print $fd "\n\n"; close $fd; if ($attrs{fmt}) { print $texfd "\\newglossaryentry{$attrs{tag}}{name={", "\\html$attrs{fmt}\{", $attrs{text}, "}},sort={", $attrs{text}, "},description={", $attrs{description}, "\\index{$attrs{text}\@\\html$attrs{fmt}\{", $attrs{text}, "}}}}\n"; } else { print $texfd "\\newglossaryentry{$attrs{tag}}{name={", $attrs{text}, "},description={", $attrs{description}, "\\index{$attrs{text}}}}\n"; } } } sub end_newterm{ my ($expat) = @_; } sub start_p{ my ($expat, %attrs) = @_; my $endtag="\n\n"; if ($attrs{noindent}) { my $value = lc($attrs{noindent}); if ($value eq 'true' or $value eq 1) { $attrs{noindent} = 1; } elsif ($value eq 'false' or $value eq 0) { $attrs{noindent} = 0; } else { die "Invalid value '$value' of attribute 'noindent' on line ", $expat->current_line, "\n"; } } if ($attrs{align}) { &handle_html('

'); if ($attrs{align} eq 'left') { print $texfd "\\begin{flushleft}"; $endtag="\\end{flushleft}"; } elsif ($attrs{align} eq 'right') { print $texfd "\\begin{flushright}"; $endtag="\\end{flushright}"; } elsif ($attrs{align} eq 'center') { print $texfd "\\begin{center}"; $endtag="\\end{center}"; } else { die "Unknown alignment option", $attrs{align}, " for 'p' element on line ", $expat->current_line, "\n"; } } else { &handle_html("

"); print $texfd "\n\n"; print $texfd "\\noindent " if $attrs{noindent}; } push @paragraph, $endtag; } sub end_p{ my ($expat) = @_; &handle_html("

"); print $texfd pop @paragraph; } sub start_dl{ my ($expat, %attrs) = @_; &handle_html("
"); print $texfd "\\begin{description}"; } sub end_dl{ my ($expat) = @_; &handle_html("
"); print $texfd "\\end{description}"; } sub start_ul{ my ($expat, %attrs) = @_; &handle_html(""); print $texfd "\\end{itemize}"; } sub start_tt{ my ($expat, %attrs) = @_; &handle_html(""); print $texfd "\\texttt{"; } sub end_tt{ my ($expat) = @_; &handle_html(''); print $texfd "}"; } sub start_file{ my ($expat, %attrs) = @_; &handle_html(""); print $texfd "\\texttt{"; } sub end_file{ my ($expat) = @_; &handle_html(''); print $texfd "}"; } sub start_code{ my ($expat, %attrs) = @_; &handle_html(""); print $texfd "\\texttt{"; } sub end_code{ my ($expat) = @_; &handle_html(''); print $texfd "}"; } sub start_strong{ my ($expat, %attrs) = @_; &handle_html(""); print $texfd "\\textbf{"; } sub end_strong{ my ($expat) = @_; &handle_html(''); print $texfd "}"; } sub start_em{ my ($expat, %attrs) = @_; &handle_html(""); print $texfd "\\emph{"; } sub end_em{ my ($expat) = @_; &handle_html(''); print $texfd "}"; } sub start_li{ my ($expat, %attrs) = @_; &handle_html("
  • "); print $texfd "\\item "; } sub end_li{ my ($expat) = @_; &handle_html("
  • "); } sub start_dt{ my ($expat, %attrs) = @_; &handle_html("
    "); print $texfd "\\item[{"; } sub end_dt{ my ($expat) = @_; &handle_html("
    "); print $texfd "}]"; } sub start_dd{ my ($expat, %attrs) = @_; &handle_html("
    "); } sub end_dd{ my ($expat) = @_; &handle_html("
    "); } sub start_meta{ my ($expat, %attrs) = @_; &handle_html("⟨"); print $texfd "\\meta{"; } sub end_meta{ my ($expat) = @_; &handle_html('⟩'); print $texfd "}"; } sub start_marg{ my ($expat, %attrs) = @_; &handle_html('{'); print $texfd "\\marg{"; } sub end_marg{ my ($expat) = @_; &handle_html('}'); print $texfd "}"; } sub start_dq{ my ($expat, %attrs) = @_; &handle_html('"'); print $texfd "\\dq{"; } sub end_dq{ my ($expat) = @_; &handle_html('"'); print $texfd "}"; } sub start_sq{ my ($expat, %attrs) = @_; &handle_html("'"); print $texfd "\\sq{"; } sub end_sq{ my ($expat) = @_; &handle_html("'"); print $texfd "}"; } sub start_url{ my ($expat, %attrs) = @_; unless ($attrs{www}) { die "element 'url' missing 'www' attribute\n"; } my $string; my $uri = $attrs{www}; $uri = "http://$uri" unless ($uri=~/^[a-z]+:\/\//); if ($attrs{text}) { print $texfd "\\href{", $attrs{www}, "}{", $attrs{text}, "}"; $string = "$attrs{text}"; } else { print $texfd "\\url{", $attrs{www}, "}"; $string = "$attrs{www}"; } &handle_html($string); } sub end_url{ my ($expat) = @_; } sub start_sty{ my ($expat, %attrs) = @_; push @current, 'sty'; print $texfd "\\sty{"; } sub end_sty{ my ($expat) = @_; pop @current; my $sty = $docinfo{sty}; $docinfo{sty} = ''; &hs_index_term("sty_$sty", "$sty", "$sty.sty", \%terms); print $texfd "}"; } sub start_footnote{ my ($expat, %attrs) = @_; if ($counters{footnote}) { $counters{footnote} = 1; } else { $counters{footnote}++; } $nodes[$#nodes]->{Contents} .= "$counters{footnote}"; push @current, 'Footnote'; print $texfd "\\footnote{"; } sub end_footnote{ my ($expat) = @_; pop @current; $nodes[$#nodes]->{Footnotes} .= "

    $counters{footnote}" . $docinfo{Footnote} . '

    '; $docinfo{Footnote} = ''; print $texfd "}"; } sub start_blockquote{ my ($expat, %attrs) = @_; print $texfd "\\begin{blockquote}"; &handle_html('
    '); } sub end_blockquote{ my ($expat) = @_; print $texfd "\\end{blockquote}"; &handle_html('
    '); } sub start_example{ my ($expat, %attrs) = @_; if ($counters{example}) { $counters{example}++; } else { $counters{example} = 1; } &handle_html('

    ' . &get_label('manual.example') . ' ' . $counters{example} . ($attrs{title}? "($attrs{title})." : '.') . '

    '); print $texfd "\\begin{example}"; if ($attrs{title}) { print $texfd '[', $attrs{title}, ']'; } } sub end_example{ my ($expat) = @_; &handle_html('
    '); print $texfd "\\end{example}"; } sub start_seealso{ my ($expat, %attrs) = @_; unless ($attrs{tags}) { die "Element 'seealso' missing 'tags' attribute on line ", $expat->current_line, "\n"; } my @tags = split /,/, $attrs{tags}; my $seealso = &get_label('manual.seealso'); &handle_html("

    $seealso

    '); } sub end_seealso{ my ($expat) = @_; } sub start_pre{ my ($expat, %attrs) = @_; &handle_html('
    ');
    
       print $texfd "\\begin{verbatim}";
    }
    
    sub end_pre{
       my ($expat) = @_;
    
       &handle_html('
    '); print $texfd "\\end{verbatim}"; } sub start_alltt{ my ($expat, %attrs) = @_; &handle_html('
    ');
    
       print $texfd "\\begin{alltt}";
    }
    
    sub end_alltt{
       my ($expat) = @_;
    
       &handle_html('
    '); print $texfd "\\end{alltt}"; } sub start_verbinput{ my ($expat, %attrs) = @_; unless ($attrs{src}) { die "Missing 'verbinput' element's 'src' attribute on line ", $expat->current_line, "\n"; } &handle_html('
    ');
    
       open $fd, "<:encoding($encoding_file)", $attrs{src} or die "Can't open '$attrs{src}' $!\n";
    
       while (<$fd>)
       {
          s/\&/\&/g;
          s//\>/g;
    
          &handle_html($_);
       }
    
       close $fd;
    
       &handle_html('
    '); print $texfd "\\verbatiminput{$attrs{src}}"; } sub end_verbinput{ my ($expat) = @_; } sub start_verbtabinput{ my ($expat, %attrs) = @_; unless ($attrs{src}) { die "Missing 'verbtabinput' element's 'src' attribute on line ", $expat->current_line, "\n"; } &handle_html('
    ');
    
       open $fd, $attrs{src} or die "Can't open '$attrs{src}' $!\n";
    
       while (<$fd>)
       {
          s/\&/\&/g;
          s//\>/g;
    
          &handle_html($_);
       }
    
       close $fd;
    
       &handle_html('
    '); print $texfd "\\verbatimtabinput{$attrs{src}}"; } sub end_verbtabinput{ my ($expat) = @_; } sub start_float{ my ($expat, %attrs) = @_; unless ($attrs{type}) { die "Element 'float' missing 'type' attribute on line ", $expat->current_line, "\n"; } unless ($attrs{tag}) { die "Element 'float' missing 'tag' attribute on line ", $expat->current_line, "\n"; } unless ($attrs{caption}) { die "Element 'float' missing 'caption' attribute on line ", $expat->current_line, "\n"; } my $pos = ($attrs{pos}? "[$attrs{pos}]" : ''); if ($counters{$attrs{type}}) { $counters{$attrs{type}}++; } else { $counters{$attrs{type}} = 1; } $attrs{counter} = $counters{$attrs{type}}; push @float_elements, \%attrs; &handle_html("
    "); $tags{$attrs{tag}}->{Ref} = $nodes[$#nodes]->{Tag} .'.html#'.$attrs{tag}; $tags{$attrs{tag}}->{Text} = ucfirst(&get_label('manual.'.$attrs{type})) . ' ' . $attrs{counter}; unless ($attrs{type} eq 'figure') { &handle_html('

    ' . $tags{$attrs{tag}}->{Text} . ': ' . $attrs{caption} . '
    '); } print $texfd "\\begin{", $attrs{type}, "}$pos\n"; print $texfd "\\floatconts{", $attrs{tag}, "}{\\caption"; if ($attrs{listcaption}) { print $texfd "[", $attrs{listcaption}, "]"; } print $texfd "{", $attrs{caption}, "}}{"; } sub end_float{ my ($expat) = @_; my $attrs = pop @float_elements; if ($attrs->{type} eq 'figure') { &handle_html('
    '. $tags{$attrs->{tag}}->{Text} . ': ' . $attrs->{caption} . '

    '); } &handle_html('
    '); print $texfd "}%\n\\end{", $attrs->{type}, "}\n"; } sub start_nbsp{ my ($expat, %attrs) = @_; &handle_html(' '); print $texfd "~"; } sub end_nbsp{ my ($expat) = @_; } sub start_emdash{ my ($expat, %attrs) = @_; &handle_html('—'); print $texfd "---"; } sub end_emdash{ my ($expat) = @_; } sub start_hash{ my ($expat, %attrs) = @_; &handle_html('#'); print $texfd "\\texttt{\\#}"; } sub end_hash{ my ($expat) = @_; } sub start_tilde{ my ($expat, %attrs) = @_; &handle_html('~'); print $texfd "\\textasciitilde "; } sub end_tilde{ my ($expat) = @_; } sub start_lt{ my ($expat, %attrs) = @_; &handle_html('<'); print $texfd "\\textless "; } sub end_lt{ my ($expat) = @_; } sub start_gt{ my ($expat, %attrs) = @_; &handle_html('>'); print $texfd "\\textgreater "; } sub end_gt{ my ($expat) = @_; } sub start_element{ my ($expat, %attrs) = @_; &handle_html('<'); print $texfd "\\element{"; } sub end_element{ my ($expat) = @_; &handle_html('>'); print $texfd "}"; } sub start_image{ my ($expat, %attrs) = @_; unless ($attrs{src}) { die "Missing 'image' element's 'src' attribute on line ", $expat->current_line, "\n"; } my $imgfile = $attrs{src}; unless (-e $imgfile) { die "Can't find image file '$imgfile' referenced on line ", $expat->current_line, "\n"; } my @opts=(); my $html = ""; foreach my $key (keys %attrs) { if ($key eq 'scale') { push @opts, "scale=$attrs{scale}"; } elsif ($key eq 'width') { push @opts, "width=$attrs{width}"; $html .= "$key=\"$attrs{$key}\" "; } elsif ($key eq 'height') { push @opts, "height=$attrs{height}"; $html .= "$key=\"$attrs{$key}\" "; } else { $html .= "$key=\"$attrs{$key}\" "; } } if (not $attrs{width} or not $attrs{height}) { # get image dimensions $_ = `file $imgfile`; if (/(\d+) x (\d+)/) { $html .= "width=\"$1\" " unless $attrs{width}; $html .= "height=\"$2\" " unless $attrs{height}; } else { warn "Can't determine dimensions of image '$imgfile'\n"; } } $html = ""; &handle_html($html); print $texfd "\\includegraphics[", join(',', @opts), "]{$imgfile}"; } sub end_image{ my ($expat) = @_; } sub start_LaTeX{ my ($expat, %attrs) = @_; &handle_html('LaTeX'); print $texfd "\\LaTeX{}"; } sub end_LaTeX{ my ($expat) = @_; } sub start_TeX{ my ($expat, %attrs) = @_; &handle_html('TeX'); print $texfd "\\TeX{}"; } sub end_TeX{ my ($expat) = @_; } sub start_relax{ my ($expat, %attrs) = @_; print $texfd "\\relax "; } sub end_relax{ my ($expat) = @_; } sub start_app{ my ($expat, %attrs) = @_; my $tag="appname"; my $text = &get_label($tag, \%attrs, $expat); &handle_html("$text"); print $texfd "\\appfmt{$text}"; } sub end_app{ my ($expat) = @_; } sub start_dict{ my ($expat, %attrs) = @_; unless ($attrs{tag}) { die "Missing 'dict' element's 'tag' attribute on line ", $expat->current_line, "\n"; } my $text = &get_label($attrs{tag}, \%attrs, $expat); &handle_html($text); print $texfd $text; } sub end_dict{ my ($expat) = @_; } sub start_button{ my ($expat, %attrs) = @_; unless ($attrs{tag}) { die "Missing 'button' element's 'tag' attribute on line ", $expat->current_line, "\n"; } my $text = &get_label($attrs{tag}, \%attrs, $expat); $text=~s/:\s*$//; &handle_html("$text"); print $texfd "\\button{$text}"; } sub end_button{ my ($expat) = @_; } sub start_menu{ my ($expat, %attrs) = @_; unless ($attrs{tag}) { die "Missing 'menu' element's 'tag' attribute on line ", $expat->current_line, "\n"; } my $hash = \%terms; my $currentlabel; my $index = ''; my $html = ''; foreach my $item (split /\./, $attrs{tag}) { if ($currentlabel) { $currentlabel .= ".$item"; print $texfd "\\mto "; $index .= '!'; $html .= '➜'; } else { $currentlabel = $item; } my $text = &get_label($currentlabel, \%attrs, $expat); $html .= $text; print $texfd "\\menu{$text}"; my $termtag = 'menu_'.$currentlabel; &hs_index_term($termtag, "", $text, $hash); unless ($hash->{$termtag}->{Children}) { my %h = (); $hash->{$termtag}->{Children} = \%h; } $hash = $hash->{$termtag}->{Children}; $text=~s/([@"!|])/"$1/g; $index .= "$text@\\menu{$text}"; } &handle_html("$html"); print $texfd "\\index{$index}"; } sub end_menu{ my ($expat) = @_; } sub start_acr{ my ($expat, %attrs) = @_; unless ($attrs{tag}) { die "Missing 'acr' element's 'tag' attribute on line ", $expat->current_line, "\n"; } unless ($acros{$attrs{tag}}) { die "Unknown acronym tag '$attrs{tag}' on line ", $expat->current_line, "\n"; } my $html; if ($acros{$attrs{tag}}->{Used}) { $html = $acros{$attrs{tag}}->{Short}; &handle_html(&hs_popup("acr_".$attrs{tag}.".html", $html)); } else { $acros{$attrs{tag}}->{Used} = 1; $html = $acros{$attrs{tag}}->{Long} . ' (' . $acros{$attrs{tag}}->{Short} . ')'; &hs_index_term('acr_'.$attrs{tag}, $html, ucfirst($html), \%terms); } print $texfd "\\gls{", $attrs{tag}, "}"; } sub end_acr{ my ($expat) = @_; } sub start_term{ my ($expat, %attrs) = @_; unless ($attrs{tag}) { die "Missing 'term' element's 'tag' attribute on line ", $expat->current_line, "\n"; } my $hstag = "gls_".$attrs{tag}; unless ($terms{$hstag}) { die "Unknown term tag '$hstag' on line ", $expat->current_line, "\n"; } my $html = $terms{$hstag}->{Text}; my $fmt = $terms{$hstag}->{Fmt}; if ($fmt) { $html = "<$fmt>$html"; } unless ($terms{$hstag}->{Ref}) { $terms{$hstag}->{Ref} = $nodes[$#nodes]->{Tag} . ".html#$hstag"; } if ($terms{$hstag}->{Description}) { if ($attrs{hyper} and $attrs{hyper} eq 'false') { print $texfd "\\gls*{", $attrs{tag}, "}"; } else { $html = &hs_popup("gls_".$attrs{tag}.".html", $html); print $texfd "\\gls{", $attrs{tag}, "}"; } } else { my $text = $terms{$hstag}->{Text}; my $idx = $text; $idx=~s/([!@"|])/"$1/g; if ($fmt) { $idx = "$idx\@\\html$fmt\{$idx\}"; } print $texfd "$text\\index{$idx}"; } &hs_index_term($hstag, $html, $terms{$hstag}->{Text}, \%terms); } sub end_term{ my ($expat) = @_; } sub start_ref{ my ($expat, %attrs) = @_; unless ($attrs{tag}) { die "Missing 'ref' element's 'tag' attribute on line ", $expat->current_line, "\n"; } &handle_html("$attrs{tag}"); if ($attrs{text}) { print $texfd "\\hyperref[$attrs{tag}]{$attrs{text}}"; } else { print $texfd "\\autoref{", $attrs{tag}, "}"; } } sub end_ref{ my ($expat) = @_; } sub start_opt{ my ($expat, %attrs) = @_; unless ($attrs{tag}) { die "Missing 'opt' element's 'tag' attribute on line ", $expat->current_line, "\n"; } my $text = '--'.$attrs{tag}; unless ($terms{options}) { &hs_index_term('options', '', &get_label('manual.options'), \%terms); my %hash = (); $terms{options}->{Children} = \%hash; } &hs_index_term('opt_'.$attrs{tag}, "$text", $text, $terms{options}->{Children}); print $texfd "\\opt{", $attrs{tag}, "}"; } sub end_opt{ my ($expat) = @_; } sub start_backslash{ my ($expat, %attrs) = @_; &handle_html("\\"); print $texfd "\\texttt{\\char`\\\\}"; } sub end_backslash{ my ($expat) = @_; } sub start_doublebackslash{ my ($expat, %attrs) = @_; &handle_html("\\\\"); print $texfd "\\cs{\\char`\\\\}"; } sub end_doublebackslash{ my ($expat) = @_; } sub start_cs{ my ($expat, %attrs) = @_; unless ($attrs{tag}) { die "Missing 'cs' element's 'tag' attribute on line ", $expat->current_line, "\n"; } my $text = "\\".$attrs{tag}; print $texfd '\\cs{', $attrs{tag}, '}'; &hs_index_term('cs_'.$attrs{tag}, "$text", $text, \%terms); } sub end_cs{ my ($expat) = @_; } sub start_env{ my ($expat, %attrs) = @_; unless ($attrs{tag}) { die "Missing 'env' element's 'tag' attribute on line ", $expat->current_line, "\n"; } my $text = $attrs{tag}; print $texfd '\\env{', $attrs{tag}, '}'; &hs_index_term('env_'.$attrs{tag}, "$text", $text, \%terms); } sub end_env{ my ($expat) = @_; } sub start_tabular{ my ($expat, %attrs) = @_; unless ($attrs{spec}) { die "Element 'tabular' missing 'spec' attribute on line ", $expat->current_line; } &handle_html(''); print $texfd "\\begin{tabular}{", $attrs{spec}, '}'; my %hash = ( spec => $attrs{spec}, column => 1 ); push @tabular_specs, \%hash; } sub end_tabular{ my ($expat) = @_; &handle_html('
    '); pop @tabular_specs; print $texfd "\\end{tabular}"; } sub start_tr{ my ($expat, %attrs) = @_; $tabular_specs[$#tabular_specs]->{column} = 1; &handle_html(''); } sub end_tr{ my ($expat) = @_; &handle_html(''); print $texfd "\\tabularnewline "; } sub start_td{ my ($expat, %attrs) = @_; my $colspan = 1; if ($attrs{span}) { $colspan = $attrs{span}; unless ($colspan=~/^\d+$/) { die "Attribute 'span' must be an integer on line ", $expat->current_line, "\n"; } } my $orgcolspec = substr $tabular_specs[$#tabular_specs]->{spec}, $tabular_specs[$#tabular_specs]->{column}-1, 1; my $colspec = $orgcolspec; if ($attrs{spec}) { $colspec = $attrs{spec}; } my $htmlcolspan = ($colspan == 1 ? '' : "colspan=\"$colspan\""); if ($colspec eq 'l') { &handle_html(""); } elsif ($colspec eq 'r') { &handle_html(""); } elsif ($colspec eq 'c') { &handle_html(""); } unless ($tabular_specs[$#tabular_specs]->{column} == 1) { print $texfd "&"; } if (($orgcolspec eq $colspec) and $colspan == 1) { $tabular_specs[$#tabular_specs]->{egroup} = ''; } else { print $texfd "\\multicolumn{$colspan}{$colspec}{"; $tabular_specs[$#tabular_specs]->{egroup} = '}'; } $tabular_specs[$#tabular_specs]->{column} += $colspan; } sub end_td{ my ($expat) = @_; &handle_html(''); print $texfd $tabular_specs[$#tabular_specs]->{egroup}; } sub start_printglossary{ my ($expat, %attrs) = @_; print $texfd "\\printglossary"; } sub end_printglossary{ my ($expat) = @_; } sub start_printacronyms{ my ($expat, %attrs) = @_; print $texfd "\\printglossary[type=acronym]"; } sub end_printacronyms{ my ($expat) = @_; } sub start_printindex{ my ($expat, %attrs) = @_; print $texfd "\\printindex "; } sub end_printindex{ my ($expat) = @_; } sub start_br{ my ($expat, %attrs) = @_; &handle_html("
    "); print $texfd "\\\\"; } sub end_br{ my ($expat) = @_; } sub start_hr{ my ($expat, %attrs) = @_; &handle_html("
    "); print $texfd "\\hrulefill "; } sub end_hr{ my ($expat) = @_; } sub start_cont{ my ($expat, %attrs) = @_; print $texfd "\\continueline "; } sub end_cont{ my ($expat) = @_; } sub start_contexplan{ my ($expat, %attrs) = @_; print $texfd &get_label('manual.cont_explanation'); } sub end_contexplan{ my ($expat) = @_; } sub start_percent{ my ($expat, %attrs) = @_; &handle_html("%"); print $texfd "\\%"; } sub end_percent{ my ($expat) = @_; } # Java JEditorPane (used by the helpset) only has very limited HTML # support. sub html_head{ my ($title, $prev, $next) = @_; my $head = <<_END_HTML_HEAD; $title _END_HTML_HEAD if ($next) { $head .= ""; } if ($prev) { $head .= ""; } "$head"; } sub html_nav{ my ($prevNode, $nextNode) = @_; my $nav = '
    '; if ($prevNode) { my $prev; my $title; if ($prevNode eq $base) { $prev = $base; $title = &get_label('manual.home'); } else { $prev = $prevNode->{Tag}; $title = $prevNode->{Title}; } $nav .= "⇦ " . $title . ""; } $nav .= ''; if ($nextNode) { $nav .= "{Tag}.html\">" . $nextNode->{Title} . " ⇨"; } "$nav
    " } # This is for actual HTML files for the Dickimaw site so not # restricted by the JEditorPane limitations sub html_www_head{ my ($title, $prev, $next) = @_; my $nextlink = ''; my $prevlink = ''; if ($next) { $nextlink = ""; } if ($prev) { $prevlink = ""; } $title=~s/ / /g; return <<_END_HTML_HEAD; $title $nextlink $prevlink
    _END_HTML_HEAD } sub html_www_nav{ my ($prevNode, $nextNode) = @_; my $nav = '
    " } sub html_www_foot{ my $nav = &html_www_nav(@_); my $year = ''; if ($dict{appdate}=~m/^(\d{4})/) { $year = $1; } return <<_END_HTML_FOOT; $nav
    _END_HTML_FOOT } sub write_www_glossary{ my ($nextnode) = @_; my $title = &get_label('manual.glossary'); my $fd; open $fd, ">:encoding($encoding_xml)", "$wwwpath/glossary.shtml" or die "Can't open '$wwwpath/glossary.shtml' $!\n"; print "Writing '$wwwpath/glossary.shtml'\n"; print $fd &html_www_head($title, 'index', $nextnode->{Tag}); print $fd "

    $title

    \n"; &write_www_terms($fd, \%terms, \%acros); print $fd &html_www_foot('index', $nextnode); close $fd; } sub write_www_terms{ my ($fd, $terms, $acros) = @_; my %hash = (); foreach my $tag ( keys %$terms ) { if ($tag=~/^gls_/) { $hash{$tag} = (); $hash{$tag}{Text} = $terms->{$tag}->{Text}; $hash{$tag}{Description} = $terms->{$tag}->{Description}; } } foreach my $tag ( keys %$acros ) { $hash{$tag} = (); $hash{$tag}{Text} = $acros->{$tag}->{Short}; $hash{$tag}{Description} = $acros->{$tag}->{Long}; } my @tags = keys %hash; if ($#tags == -1) { return; } my @sorted_tags = sort {lc($hash{$a}{Text}) cmp lc($hash{$b}{Text})} @tags; print $fd "
    "; foreach my $tag ( @sorted_tags ) { print $fd "
    $hash{$tag}{Text}
    \n", "
    "; print $fd $hash{$tag}{Description}; print $fd "
    \n"; } print $fd "
    "; } sub arg_placeholder{ ""; } 1;