# -*- Perl -*- # Classes for dbtotexi # # $Id: dbtotexi.cls 2.0 1995/04/01 21:09:46 norm Exp $ # # ############################################################################## if ($VERBOSE) { my($VERSION) = '$Id: dbtotexi.cls 2.0 1995/04/01 21:09:46 norm Exp $'; # ' my($REQNAME) = (split(/\s+/, $VERSION))[1]; my($vers) = (split(/\s+/, $VERSION))[2]; print STDERR "$REQNAME version $vers.\n"; } ############################################################################## { package MARKUP_OBJECT; sub new { my($ref) = bless { }; $ref->{'MARKUP_COL'} = 0; $ref->{'OBEY_SPACES'} = 0; $ref->{'OUTPUT'} = ""; $ref->{'OUTPUT_FILEHANDLE'} = ""; return $ref; } sub text { my($self, $text) = @_; my($place, @lines, $save_); local($_) = $text; return if $_ eq ""; # Can't just match a regexp in here because \n's # cause all sorts of prob. # break incoming text into lines while (($place = index($_, "\n")) >= 0) { push (@lines, substr($_, 0, $place+1)); $_ = substr($_, $place+1); } push (@lines, $_) if $_ ne ""; while (@lines) { # skip blank lines... shift @lines while ($self->{'MARKUP_COL'} == 0 && $self->{'OBEY_SPACES'} == 0 && @lines && $lines[0] =~ /^\s*$/); last if !@lines; $_ = shift @lines; # discard leading whitespace if (/^(\s+)/ && ($self->{'MARKUP_COL'} == 0) && ($self->{'OBEY_SPACES'} == 0)) { $_ = substr($_, length($1)); } $self->{'OUTPUT'} .= $_; $self->{'MARKUP_COL'} += length($_); $self->{'MARKUP_COL'} = 0 if substr($_, length($_)-1, 1) eq "\n"; } $self->flush(); } sub markup { my($self, $text) = @_; my($place, @lines, $save_, $nl); local($_) = $text; return if $_ eq ""; $nl = !(/^\@emph\{/ || /^\@TeX/ || /^\@t\{/ || /^\@samp\{/ || /^\@cite\{/ || /^\@file\{/ || /^\@copyright\{/ || /^\@xref\{/ || /^\@var\{/ || !/^\@/); # Can't just match a regexp in here because \n's # cause all sorts of prob. # break incoming text into lines while (($place = index($_, "\n")) >= 0) { push (@lines, substr($_, 0, $place+1)); $_ = substr($_, $place+1); } push (@lines, $_) if $_ ne ""; # Output several newlines if this is one of those tags that # wants it if ($nl) { $self->{'OUTPUT'} .= "\n"; $self->{'OUTPUT'} .= "\n" if $self->{'MARKUP_COL'} > 0; $self->{'MARKUP_COL'} = 0; } while (@lines) { $_ = shift @lines; $self->{'OUTPUT'} .= "$_"; $self->{'MARKUP_COL'} += length($_); $self->{'MARKUP_COL'} = 0 if substr($_, length($_)-1, 1) eq "\n"; } if ($nl && $self->{'MARKUP_COL'} > 0) { $self->{'OUTPUT'} .= "\n"; $self->{'MARKUP_COL'} = 0; } $self->flush(); } sub raw_markup { my($self, $text) = @_; local($_) = $text; $self->{'OUTPUT'} .= $_; $self->{'MARKUP_COL'} += length($_); $self->{'MARKUP_COL'} = 0 if substr($_, length($_)-1, 1) eq "\n"; $self->flush(); } sub flush { my($self) = @_; my($pr); if ($self->{'OUTPUT_FILEHANDLE'}) { $pr = $self->{'OUTPUT_FILEHANDLE'}; eval "print $pr \$self->{'OUTPUT'}"; $self->{'OUTPUT'} = ""; } } sub output_filehandle { my($self, $file) = @_; $self->{'OUTPUT_FILEHANDLE'} = $file; } sub output { my($self) = @_; return $self->{'OUTPUT'}; } } sub gen_empty_subclass { my($superclass, $tag) = @_; local($_) = '{ package __PACKAGE__; @ISA = (\'__SUPERCLASS__\'); sub new { return bless { }; } }'; s/__PACKAGE__/$tag/g; s/__SUPERCLASS__/$superclass/g; eval $_; } sub gen_titled { my($tag) = @_; &gen_empty_subclass('GENERIC_TITLED', $tag); } sub gen_chapter { my($tag) = @_; &gen_empty_subclass('GENERIC_CHAPTER', $tag); } sub gen_inline { my($tag) = @_; &gen_empty_subclass('GENERIC_INLINE', $tag); } sub gen_index_term { my($tag) = @_; &gen_empty_subclass('GENERIC_INDEX_TERM', $tag); } sub gen_block { my($tag) = @_; &gen_empty_subclass('GENERIC_WRAPPER', $tag); } sub gen_dottag { &gen_block(@_); } sub gen_obeyspaces { my($tag) = @_; &gen_empty_subclass('GENERIC_OBEYSPACES', $tag); } sub gen_asarg { my($tag) = @_; &gen_empty_subclass('GENERIC_ASARG', $tag); } { package GENERIC_TAG; $TAG_NULL = "::TAG::NULL::"; $LAST_ELEM = ""; # TAG = "tag" name of this tag # CONTENT->tag pointer to first subelement # CONTENT_LAST->tag pointer to last subelement # NEXT->tag pointer to next element at this level # PREV->tag pointer to prev element at this level # PARENT->tag pointer to parent element # ATTR->{} attributes of this tag # NEXT_ELEMENT->tag pointer to next element of this type # PREV_ELEMENT->tag pointer to prev element of this type sub init { my($self) = @_; $self->{'NEXT'} = $TAG_NULL; $self->{'PREV'} = $TAG_NULL; $self->{'CONTENT'} = $TAG_NULL; } sub markup_start { my($self) = @_; my($tag) = $self; my($ref) = $main::WHENTREE{$tag->{'TAG'}}; while (ref $ref) { $tag = $tag->{'PARENT'}; if (defined($ref->{$tag->{'TAG'}})) { $ref = $ref->{$tag->{'TAG'}} } else { $ref = $ref->{"*tag"}; } } if (!defined($ref)) { &main::WARNING("Can\'t form markup_start for $self->{TAG}\n"); } return $ref; } sub markup_end { my($self) = @_; my($tag) = $self; my($ref) = $main::WHENTREE{"/" . $tag->{'TAG'}}; while (ref $ref) { $tag = $tag->{'PARENT'}; if (defined($ref->{"/" . $tag->{'TAG'}})) { $ref = $ref->{"/" . $tag->{'TAG'}} } else { $ref = $ref->{"*tag"}; } } if (!defined($ref)) { $ref = $self->markup_start(); if ($ref =~ /\{\s*$/) { $ref = "}"; } else { $ref = ""; } } return $ref; } sub save_id { my($self) = @_; my($chap, $sect, $refsect, $count, $title); my($s, $child, $id, $tag); my(%TAGLEVEL); $id = $self->{'ATTR'}->{'ID'}; $tag = $self->{'TAG'}; %TAGLEVEL = %{$self->{'TAGLEVEL'}}; $chap = $main::PI_CHAPTER_NUMBER || "1"; $sect = $TAGLEVEL{'SECT1'}; foreach $s ('SECT2', 'SECT3', 'SECT4', 'SECT5') { $sect .= "." . $TAGLEVEL{$s} if defined($TAGLEVEL{$s}); } $refsect = $TAGLEVEL{'REFSECT1'}; foreach $s ('REFSECT2', 'REFSECT3', 'REFSECT4', 'REFSECT5') { $refsect .= "." . $TAGLEVEL{$s} if defined($TAGLEVEL{$s}); } $count = $TAGLEVEL{$tag}; $title = ""; $child = $self->content(); if ($child && $child->{'TAG'} eq "TITLE") { $title = $child->markup(); } $self->{'CHP-NUM'} = $chap; $self->{'SECT-NUM'} = $sect; $self->{'RSECT-NUM'} = $refsect; $self->{'ITEM-NUM'} = $count; $self->{'TITLE'} = $title; # if ($self->{'TAG'} =~ /^CHAP/ || $self->{'TAG'} =~ /^SECT/) { # print STDERR "TAG: $self->{TAG}, ($chap,$sect,$refsect,$count)"; # print STDERR " $title\n"; # } return if $id eq ""; $main::TAGID->{$id} = { } if !defined($main::TAGID->{$id}); if ($tag ne 'INDEXTERM') { $main::TAGID_CHANGE = ($main::TAGID_CHANGE || $main::TAGID->{$id}->{'TAG'} ne $tag || $main::TAGID->{$id}->{'CHP-NUM'} ne $chap || $main::TAGID->{$id}->{'SECT-NUM'} ne $sect || $main::TAGID->{$id}->{'RSECT-NUM'} ne $refsect || $main::TAGID->{$id}->{'ITEM-NUM'} ne $count || $main::TAGID->{$id}->{'TITLE'} ne $title || $main::TAGID->{$id}->{'SOURCE-FILE'} ne $main::PI_SOURCE_FILE); } $main::TAGID->{$id}->{'TAG'} = $tag; $main::TAGID->{$id}->{'CHP-NUM'} = $chap; $main::TAGID->{$id}->{'SECT-NUM'} = $sect; $main::TAGID->{$id}->{'RSECT-NUM'} = $refsect; $main::TAGID->{$id}->{'ITEM-NUM'} = $count; $main::TAGID->{$id}->{'TITLE'} = $title; $main::TAGID->{$id}->{'SOURCE-FILE'} = $main::PI_SOURCE_FILE; } sub next { my($self) = @_; while (($self->{'NEXT'} eq $TAG_NULL) && $main::parser->next_element()) { #nop; } $self->{'NEXT'} eq $TAG_NULL ? undef : $self->{'NEXT'}; } sub prev { my($self) = @_; $self->{'PREV'}; } sub content { my($self) = @_; while (($self->{'CONTENT'} eq $TAG_NULL) && $main::parser->next_element()) { #nop; } $self->{'CONTENT'} eq $TAG_NULL ? undef : $self->{'CONTENT'}; } sub next_element { my($self) = @_; while (($self->{'NEXT_ELEMENT'} eq $TAG_NULL) && $main::parser->next_element()) { #nop; } $self->{'NEXT_ELEMENT'} eq $TAG_NULL ? undef : $self->{'NEXT_ELEMENT'}; } sub prev_element { my($self) = @_; $self->{'PREV_ELEMENT'}; } sub add_child { my($self, $ref) = @_; my($prevelem); $ref->{'PARENT'} = $self; $ref->{'NEXT'} = 0; if ($self->{'CONTENT'} ne $TAG_NULL) { $ref->{'PREV'} = $self->{'CONTENT_LAST'}; $self->{'CONTENT_LAST'}->{'NEXT'} = $ref; $self->{'CONTENT_LAST'} = $ref; } else { $self->{'CONTENT'} = $ref; $self->{'CONTENT_LAST'} = $ref; $ref->{'PREV'} = 0; } $LAST_ELEM->{'NEXT_ELEMENT'} = $ref if $LAST_ELEM; $ref->{'PREV_ELEMENT'} = $LAST_ELEM; $LAST_ELEM = $ref; } sub unlink_child { my($self, $child) = @_; if ($child->{'PREV'}) { $child->{'PREV'}->{'NEXT'} = $child->{'NEXT'}; } else { $child->{'PARENT'}->{'CONTENT'} = $child->{'NEXT'}; } if ($child->{'NEXT'}) { $child->{'NEXT'}->{'PREV'} = $child->{'PREV'}; } else { $child->{'PARENT'}->{'CONTENT_LAST'} = $child->{'PREV'}; } $child->{'NEXT'} = ""; $child->{'PREV'} = ""; $child; } sub block_markup { # Extract "block markup" from the markup of a tag. In other # words if presented with the contents of # # Foo<indexterm><primary>foo</></> and <emphasis>Bar</> # # It changes the markup for to be # # <title>Foo and <emphasis>Bar</> # # and returns # # foo # my($self) = @_; my($child, $nextchild); my($block, $last) = (0, 0); $nextchild = $self->content(); while ($nextchild) { $child = $nextchild; $nextchild = $nextchild->{'NEXT'}; if (!&main::isa($child, 'GENERIC_INLINE')) { $child = $self->unlink_child($child); if ($last) { $last->{'NEXT'} = $child; $child->{'PREV'} = $last; $last = $child; } else { $block = $child; $last = $child; } } } $block; } sub default_markup { my($self, $markup) = @_; $self->save_id(); } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup(markup); &main::WARNING("No markup method for $self->{TAG}.\n"); $self->markup_children($markup, $self->content()); $inmarkup ? $markup : $markup->output(); } sub markup_children { my($self, $markup, $child) = @_; while ($child && $child ne $TAG_NULL) { $child->markup($markup); $child = $child->next(); } $markup; } sub prev_node { my($self, @tags) = @_; my($prev) = $self->prev_element(); my($title) = "Top"; while ($prev && !&main::in($prev->{'TAG'}, @tags)) { $prev = $prev->prev_element(); } if ($prev) { $prev = $prev->content(); if ($prev && $prev->{'TAG'} eq 'TITLE') { $title = $prev->markup(); $title =~ s/<\001lb>/ /g; } } wantarray ? ($prev, $title) : $title; } sub next_node { my($self, @tags) = @_; my($next) = $self->next_element(); my($title) = ""; while ($next && !&main::in($next->{'TAG'}, @tags)) { $next = $next->next_element(); } if ($next) { $next = $next->content(); if ($next && $next->{'TAG'} eq 'TITLE') { $title = $next->markup(); $title =~ s/<\001lb>/ /g; } } wantarray ? ($next, $title) : $title; } } { package GENERIC_INLINE; @ISA = ('GENERIC_TAG'); sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); $markup->markup($self->markup_start()); $self->markup_children($markup, $self->content()); $markup->markup($self->markup_end()); $inmarkup ? $markup : $markup->output(); } } { package GENERIC_NOP; @ISA = ('GENERIC_INLINE'); sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); $inmarkup ? $markup : undef; } } { package GENERIC_WRAPPER; @ISA = ('GENERIC_TAG'); sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); $markup->markup($self->markup_start()); $self->markup_children($markup, $self->content()); $markup->markup($self->markup_end()); $inmarkup ? $markup : $markup->output(); } } { package PARA; @ISA = ('GENERIC_WRAPPER'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($prev) = $self->prev(); my($parent) = $self->{'PARENT'}; my($gparent) = ""; $gparent = $parent->{'PARENT'} if defined ($parent); $prev = $prev->{'TAG'} if $prev; $parent = $parent->{'TAG'} if $parent; $gparent = $gparent->{'TAG'} if $gparent; $prev = "" if !$prev; $parent = "" if !$parent; $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); # Don't output \n after
  • $markup->markup("\n") if ($gparent eq 'VARLISTENTRY' || ($prev ne "" || $parent ne 'LISTITEM')); $markup->markup($self->markup_start()); $self->markup_children($markup, $self->content()); $markup->markup($self->markup_end()); $markup->markup("\n"); $inmarkup ? $markup : $markup->output(); } } { package GENERIC_OBEYSPACES; @ISA = ('GENERIC_WRAPPER'); sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); $markup->{'OBEY_SPACES'}++; $markup->markup($self->markup_start()); $self->markup_children($markup, $self->content()); $markup->markup($self->markup_end()); $markup->{'OBEY_SPACES'}--; $inmarkup ? $markup : $markup->output(); } } { package SCREEN; @ISA = ('GENERIC_OBEYSPACES'); sub new { return bless {}; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($indent) = "\"\""; # there's no hook for this yet... my($ptsize) = ""; my($child); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); if ($self->{'ATTR'}->{'ROLE'} =~ /^([0-9]+)/) { $ptsize = $1; } $markup->{'OBEY_SPACES'}++; $markup->markup($self->markup_start()); $self->markup_children($markup, $self->content()); $markup->markup($self->markup_end()); $markup->{'OBEY_SPACES'}--; $inmarkup ? $markup : $markup->output(); } } { package GENERIC_ASARG; @ISA = ('GENERIC_WRAPPER'); sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($text, $textmarkup); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); $textmarkup = new MARKUP_OBJECT; $self->markup_children($textmarkup, $self->content()); $text = $textmarkup->output(); $text =~ s/\n/ /g; $markup->markup($self->markup_start() . " \"$text\""); $inmarkup ? $markup : $markup->output(); } } { package GENERIC_TITLED; @ISA = ('GENERIC_TAG'); sub markup_title { my($self, $markup) = @_; my($child) = $self->content(); if ($child && ($child->{'TAG'} eq 'TITLE')) { my($block) = $child->block_markup($child); my($title) = $child->markup(); # Handle in title $title =~ s/<\001lb>/ /g; if ($main::PI_NUMBERED_SECTIONS) { if ($self->{'TAG'} =~ /^SECT\d/) { $title = $self->{'CHP-NUM'} . "." . $self->{'SECT-NUM'} . ". $title"; } elsif ($self->{'TAG'} =~ /^REFSECT\d/) { $title = $self->{'CHP-NUM'} . "." . $self->{'RSECT-NUM'} . ". $title"; } else { #nop; } } $markup->markup($self->markup_start() . " $title" . $self->markup_end()); $block->markup($markup) if $block; } else { $markup->markup($self->markup_start()); } $markup; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($child) = $self->content(); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); $self->markup_title($markup); $child = $child->next() if $child->{'TAG'} eq 'TITLE'; $self->markup_children($markup, $child); $inmarkup ? $markup : $markup->output(); } } { package SECT1; @ISA = ('GENERIC_TITLED'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($child) = $self->content(); my($nexttitle, $prevtitle, $uptitle, $title); my($nexte, $preve, $upe); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); $upe = $self->{'PARENT'}; $upe->menu($markup); $uptitle = "Top"; $upe = $upe->content(); if ($upe && $upe->{'TAG'} eq 'TITLE') { $uptitle = $upe->markup(); $uptitle =~ s/<\001lb>//g; } $prevtitle = $self->prev_node(('PREFACE', 'CHAPTER', 'APPENDIX', 'SECT1')); $nexttitle = $self->next_node(('PREFACE', 'CHAPTER', 'APPENDIX', 'SECT1')); $title = "?none?"; if ($child->{'TAG'} eq 'TITLE') { $title = $child->markup(); $title =~ s/<\001lb>//g; } $markup->markup("\@node $title, $nexttitle, $prevtitle, $uptitle"); $self->markup_title($markup); $child = $child->next() if $child->{'TAG'} eq 'TITLE'; $self->markup_children($markup, $child); $inmarkup ? $markup : $markup->output(); } } { package BOOK; @ISA = ('GENERIC_WRAPPER'); sub new { return bless {}; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($bktitle) = &main::cfg($main::bookfiles, $main::FILTERCFG, "book_title") || "No title supplied in $main::BOOKFILES"; $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); $markup->markup("\n\n$bktitle"); $markup->markup("\n\n"); $self->markup_children($markup, $self->content()); $markup->markup("\n\n"); $inmarkup ? $markup : $markup->output(); } } { package GENERIC_CHAPTER; @ISA = ('GENERIC_TITLED'); sub new { return bless {}; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($child) = $self->content(); my($chapnum) = $main::PI_CHAPTER_NUMBER || "1"; my($nexttitle, $prevtitle, $uptitle); my($nexte, $preve, $upe); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); $uptitle = "Top"; $prevtitle = $self->prev_node(('PREFACE', 'CHAPTER', 'APPENDIX', 'SECT1')); $nexttitle = $self->next_node(('PREFACE', 'CHAPTER', 'APPENDIX', 'SECT1')); if ($child && ($child->{'TAG'} eq 'TITLE')) { my($title) = $child->markup(); # Handle in title $title =~ s/<\001lb>//g; $markup->markup("\@node $title, $nexttitle, $prevtitle, $uptitle"); if ($main::PI_NUMBERED_SECTIONS) { $markup->markup("\@chapter " . $self->{'CHP-NUM'} . ". $title"); } else { $markup->markup("\@chapter $title"); } $child = $child->next(); } else { $markup->markup("\@node ?none?, $nexttitle, $prevtitle, $uptitle"); $markup->markup("% Chapter $chapnum: no title"); } $self->markup_children($markup, $child); $markup->markup($self->markup_end()); $inmarkup ? $markup : $markup->output(); } sub menu { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($elem) = $self->content(); my($telem, $title); $markup = new MARKUP_OBJECT if !$inmarkup; if (!$self->{'BUILT_MENU'}) { $markup->markup("\@menu"); while ($elem && $elem ne $GENERAL_TAG::TAG_NULL) { if ($elem->{'TAG'} eq 'SECT1') { $telem = $elem->content(); $title = $telem->markup(); $title =~ s/<\001lb>//g; $markup->markup("* ${title}::\n"); } $elem = $elem->next(); } $markup->markup("\@end menu"); $self->{'BUILT_MENU'} = 1; } $inmarkup ? $markup : $markup->output(); } } { package PCDATA; @ISA = ('GENERIC_INLINE'); sub new { return bless { }; } sub markup_start { my($self) = @_; return ""; } sub markup_end { my($self) = @_; return ""; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); local($_) = $self->{'DATA'}; $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); s/@/@@/g; s/\{/@\{/g; s/\}/@\}/g; $markup->text($_); $inmarkup ? $markup : $markup->output(); } } { package SDATA; @ISA = ('GENERIC_INLINE'); sub new { return bless { }; } sub markup_start { my($self) = @_; return ""; } sub markup_end { my($self) = @_; return ""; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($t); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); $t = $self->{'SDATA'}; if ($t =~ /^\[\s*(\S+)\s*\]$/) { $t = $1; if (defined($main::ENTITIES{"&$t"})) { $t = $main::ENTITIES{"&$t"}; } else { &main::WARNING("$0: Unrecognized entity: $t\n"); $t = "??ENTITY-$t"; } } else { # Just an ordinary textual replacement } $markup->markup($t); $inmarkup ? $markup : $markup->output(); } } { package PI; @ISA = ('GENERIC_INLINE'); sub new { return bless { }; } sub parse_pi { my($self) = @_; my($pi, $rest); local($_) = $self->{'PI'}; # Avoid regular expressions in case there are RE characters # in the PI while ($_ ne "" && (substr($_, 0, 1) eq " " || substr($_, 0, 1) eq "\t")) { $_ = substr($_, 1); } $pi = ""; while ($_ ne "" && (substr($_, 0, 1) ne " " && substr($_, 0, 1) ne "\t")) { $pi .= substr($_, 0, 1); $_ = substr($_, 1); } while ($_ ne "" && (substr($_, 0, 1) eq " " || substr($_, 0, 1) eq "\t")) { $_ = substr($_, 1); } $rest = $_; $pi =~ s/-/_/g; ($pi, $rest); } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($pi, $rest, $sub); local($_); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); ($pi, $rest) = $self->parse_pi(); if (!$BAD_PI{$pi}) { eval "\*stab = \*{\"main::\"}"; if ($stab{"PI_$pi"} ne "*main::PI_$pi") { &main::WARNING("Unsupported processing instruction \"$pi\" ignored.\n"); $BAD_PI{$pi} = 1; } else { $sub = "\&main::PI_${pi}(\$self, \$markup, \$rest)"; $_ = eval $sub; if ($@) { $_ = $@; s/called at.*$//; warn "Attempt to process failed:\n\t$_\n"; } } } $inmarkup ? $markup : $markup->output(); } } { package SYSTEMITEM; @ISA = ('GENERIC_INLINE'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($tag_start, $tag_end); my($type); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); $tag_start = $self->markup_start(); $tag_end = $self->markup_end(); $type = $self->{'ATTR'}->{'ROLE'} || $self->{'ATTR'}->{'CLASS'}; if (($type ne "") && ($tag_start =~ /\\\*\[.*\]/)) { $type = uc($type); chop($tag_start); chop($tag_end); $tag_start .= "-$type]"; $tag_end .= "-$type]"; } $markup->markup($tag_start); $self->markup_children($markup, $self->content()); $markup->markup($tag_end); $inmarkup ? $markup : $markup->output(); } } { package EMPHASIS; @ISA = ('SYSTEMITEM'); sub new { return bless { }; } # inline markup is identical to SYSTEMITEM... } { package KEYCAP; @ISA = ('GENERIC_INLINE'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($parent) = $self->{'PARENT'}; my($child) = $self->content(); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); $markup->markup("\\c\n") if $markup->{'OBEY_SPACES'}; $markup->markup($self->markup_start() . " \"" . $child->markup() . "\" " . "\\&\\c"); $inmarkup ? $markup : $markup->output(); } } { package SIMPLELIST; @ISA = ('GENERIC_TAG'); sub new { my($ref) = bless { }; $ref->{'COLSEP'} = "\t"; return $ref; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($child) = $self->content(); my($child_markup) = ""; my(@STACK) = (); my($type, $elements, $cols, $rows, $thiscol, $count, $table); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); while ($child) { if ($child->{'TAG'} eq 'MEMBER') { $child_markup = $child->markup(); push(@STACK, $child_markup); } $child = $child->next(); } $type = $self->{'ATTR'}->{'TYPE'}; if ($type eq "HORIZ" || $type eq "VERT") { $elements = $#STACK + 1; $cols = $self->{'ATTR'}->{'COLUMNS'} || 1; $rows = int(($elements+($cols - 1)) / $cols); $markup->markup(".TS"); $table .= "l " x $cols; $table .= ".\n"; $markup->markup($table); $table = ""; } if ($type eq "HORIZ") { $thiscol = 0; for ($count = 0; $count < $rows*$cols; $count++) { $table .= $self->{'COLSEP'} if $thiscol > 0; $table .= $STACK[$count]; $thiscol++; if ($thiscol >= $cols) { $table .= "\n"; $thiscol = 0; } } } elsif ($type eq "VERT") { for ($count = 0; $count < $rows; $count++) { $_ = $count; for ($thiscol = 0; $thiscol < $cols; $thiscol++) { $table .= $self->{'COLSEP'} if $thiscol > 0; $table .= $STACK[$_]; $_ += $rows; } $table .= "\n"; } } else { $table = ""; while (@STACK) { $_ = shift(@STACK); if (@STACK) { $table .= ", " if $table; $table .= "$_"; } else { $table .= ", and $_"; } } } $markup->markup($table); if ($type eq "HORIZ" || $type eq "VERT") { $markup->markup(".TE"); } $inmarkup ? $markup : $markup->output(); } } { package XREF; @ISA = ('GENERIC_INLINE'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($linkend) = $self->{'ATTR'}->{'LINKEND'}; my($endterm) = $self->{'ATTR'}->{'ENDTERM'}; my($pattern, $linkto); my($xreftag, $xrefchap, $xrefsect, $xrefrsct, $xrefitem, $xreftxt); my($xrefnum, $xrefwarning); my($sep, $sep_config); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); $linkto = $linkend; $linkto = $endterm if $endterm ne ""; if (defined($main::TAGID->{$linkto})) { $main::TAGCOUNT{$linkto}++; $xreftag = $main::TAGID->{$linkto}->{'TAG'}; $xrefchap = $main::TAGID->{$linkto}->{'CHP-NUM'}; $xrefsect = $main::TAGID->{$linkto}->{'SECT-NUM'}; $xrefrsct = $main::TAGID->{$linkto}->{'RSECT-NUM'}; $xrefitem = $main::TAGID->{$linkto}->{'ITEM-NUM'}; $xreftxt = $main::TAGID->{$linkto}->{'TITLE'}; if ($xreftag =~ /PREFACE/i || $xreftag =~ /CHAPTER/i || $xreftag =~ /APPENDIX/i || $xreftag =~ /SECT1/i) { $markup->markup("\@xref\{$xreftxt\}"); } else { $markup->text($xreftxt); } } else { &main::WARNING("Warning: xref ID \"$linkto\" is unknown.\n"); $markup->text("**UNKNOWN XREF**"); } $inmarkup ? $markup : $markup->output(); } } { package VARLISTENTRY; @ISA = ('GENERIC_WRAPPER'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($child) = $self->content(); my($terms) = ""; my($blocklist, $last, $block) = (0, 0, 0); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); while ($child->{'TAG'} eq 'TERM') { $block = $child->block_markup(); if ($last) { $last->{'NEXT'} = $block; $block->{'PREV'} = $last; } else { $blocklist = $block; $last = $blocklist; } $last = $last->{'NEXT'} while $last->{'NEXT'}; $terms .= $child->markup() . " "; $child = $child->next(); } chop($terms); # get rid of the trailing blank $markup->markup($self->markup_start() . " $terms"); $markup->markup($self->markup_end()); for ($block = $blocklist; $block; $block = $blocklist->next()) { $block->markup($markup); } $self->markup_children($markup,$child); $inmarkup ? $markup : $markup->output(); } } { package LISTITEM; @ISA = ('GENERIC_INLINE'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); if ($self->{'PARENT'}->{'TAG'} ne 'VARLISTENTRY') { $markup->markup($self->markup_start()); $self->markup_children($markup, $self->content()); $markup->markup($self->markup_end()); } else { $self->markup_children($markup, $self->content()); } $inmarkup ? $markup : $markup->output(); } } { package GLOSSENTRY; @ISA = ('VARLISTENTRY'); sub new { return bless { }; } # markup is just like VARLISTENTRY } { package GRAPHIC; @ISA = ('GENERIC_WRAPPER'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($format, $fileref) = ($self->{'ATTR'}->{'FORMAT'}, $self->{'ATTR'}->{'FILEREF'}); my($imageok); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); &main::WARNING("$0: Cannot handle tag!\n"); $markup->markup("[ A GRAPHIC GOES HERE ]"); $inmarkup ? $markup : $markup->output(); } } { package GENERIC_INDEX_TERM; @ISA = ('GENERIC_INLINE'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); $self->markup_children($markup, $self->content()); $inmarkup ? $markup : $markup->output(); } } { package INDEXTERM; @ISA = ('GENERIC_WRAPPER'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($key) = $self->{'ATTR'}->{'ID'}; my($significance) = $self->{'ATTR'}->{'SIGNIFICANCE'}; my($child) = $self->content(); my(%terms) = (); my(%sorts) = (); my(@markup) = ('XE1', 'XE2', 'XE3', 'XSE', 'XSA'); my($count); local($_); return undef if $self->{'already_marked_up'}; $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); # Get the markup and sortas terms for each of the children while ($child) { $_ = $child->{'TAG'}; $terms{$_} = $child->markup(); $sorts{$_} = $child->{'ATTR'}->{'SORTAS'}; $child = $child->next(); } if ($key ne "") { $main::TAGID->{$key} = { }; $main::TAGID->{$key}->{'TAG'} = $self->{'TAG'}; foreach $_ (keys %terms) { $main::TAGID->{$key}->{$_} = $terms{$_}; $main::TAGID->{$key}->{"$_-SORTAS"} = $sorts{$_}; } } if ($significance =~ /PREFERRED/i) { $significance = 'B'; } else { $significance = 'N'; } if (($key = $self->{'ATTR'}->{'SPANEND'}) ne "") { my(@fields); if (!defined($main::TAGID->{$key})) { &main::WARNING("No spanbeg for index $key; skipping...\n"); return; } if ($main::TAGID->{$key}->{'TAG'} ne 'INDEXTERM') { my($warn) = "Spanend $key doesn't point to an indexterm"; my($tag) = $main::TAGID->{$key}->{'TAG'}; &main::WARNING("$warn ($tag); skipping...\n"); return; } @terms = ($main::TAGID->{$key}->{'PRIMARY'}, $main::TAGID->{$key}->{'SECONDARY'}, $main::TAGID->{$key}->{'TERTIARY'}, $main::TAGID->{$key}->{'SEE'}, $main::TAGID->{$key}->{'SEEALSO'}); @sorts = ($main::TAGID->{$key}->{'PRIMARY-SORTAS'}, $main::TAGID->{$key}->{'SECONDARY-SORTAS'}, $main::TAGID->{$key}->{'TERTIARY-SORTAS'}, $main::TAGID->{$key}->{'SEE-SORTAS'}, $main::TAGID->{$key}->{'SEEALSO-SORTAS'}); } if ($self->{'ATTR'}->{'SPANBEG'} =~ /^y/i) { $markup->markup($self->markup_start() . " $significance S"); } elsif ($self->{'ATTR'}->{'SPANEND'} ne "") { $markup->markup($self->markup_start() . " $significance E"); } else { $markup->markup($self->markup_start() . " $significance"); } for ($count = 0; $count < 5; $count++) { if ($terms[$count] ne "") { $_ = ".$markup[$count] \"$terms[$count]\""; $_ .= " \"$sorts[$count]\"" if $sorts[$count]; $markup->markup($_); } } $markup->markup($self->markup_end()); $inmarkup ? $markup : $markup->output(); } } { package ULINK; @ISA = ('GENERIC_TAG'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($type) = $self->{'ATTR'}->{'TYPE'}; my($url) = $self->{'ATTR'}->{'URL'}; $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); &main::WARNING("Warning: unknown ULINK type: $type\n") if ($type !~ /^cprog$/i); open (F, $url) || &main::WARNING("Warning: cannot open URL in ULINK: $url\n"); while () { $markup->markup($_); } close (F); $inmarkup ? $markup : $markup->output(); } } ###################################################################### # TABLES ###################################################################### $main::TABLE_ABOVE_RULE_SPACE = "2p"; $main::TABLE_BELOW_RULE_SPACE = "2p"; $main::TABLE_BETWEEN_PARA_SPACE = ".25v"; $main::TABLE_SINGLE_HORIZ_RULE = "_"; $main::TABLE_DOUBLE_HORIZ_RULE = "="; $main::TABLE_SINGLE_VERT_RULE = "|"; $main::TABLE_DOUBLE_VERT_RULE = "||"; $main::TABLE_FRAME_RULE = $main::TABLE_SINGLE_HORIZ_RULE; $main::TABLE_DEFAULT_COL_SEP = $main::TABLE_SINGLE_VERT_RULE; $main::TABLE_DEFAULT_ROW_SEP = $main::TABLE_SINGLE_HORIZ_RULE; %main::COLROLE_START = (); %main::COLROLE_END = (); $main::COLROLE_START{"none"} = ""; $main::COLROLE_END{"none"} = ""; $main::COLROLE_START{"small"} = "\\s-1"; $main::COLROLE_END{"small"} = "\\s+1"; { # Just a placeholder, this is where table column info goes package ColSpec; sub init { $curcolspec = ""; $DEFAULT_ALIGN = ""; $COLUMN = 0; $DEFAULT_COLSEP = ""; $DEFAULT_ROWSEP = ""; %ROWSEP = (); %COLSEP = (); %ALIGN = (); %NAME = (); %COL = (); %CHAR = (); %CHAROFF = (); %COLWIDTH = (); $DEFAULT_ROLE = ""; %ROLE = (); } } { # Just a placeholder, this is where table span info goes package SpanSpec; sub init { $DEFAULT_ALIGN = ""; $DEFAULT_COLSEP = ""; $DEFAULT_ROWSEP = ""; %ALIGN = (); %CHAR = (); %CHAROFF = (); %COLSEP = (); %ROWSEP = (); %NAMEST = (); %NAMEEND = (); $DEFAULT_ROLE = ""; %ROLE = (); } } { # Just a placeholder, this is where table footnote info goes package FootnoteSpec; sub init { @FN = (); } sub output_footnotes { my($fn); if (@FN) { foreach $fn (@FN) { $fn =~ s/\n/\001/g; # \n -> \001 $fn =~ s/^\.P\001//g; # remove .P $fn =~ s/\001\.P/\001/g; # remove .P $fn =~ s/\001\.\/P/\001/g; # remove ./P $fn =~ s/\001\001/\001/g; # remove dup \001 $fn = $1 if $fn =~ /^(.*)\001+$/; # trim trailing \001 $fn =~ s/\001/\n/g; # \001 -> \n &main::MARKUP(".TFS"); &main::MARKUP($fn); &main::MARKUP(".TFE"); } } } } { package INFORMALTABLE; @ISA = ('GENERIC_WRAPPER'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($child) = $self->content(); my($inmarkup) = defined($markup); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); $self->{"FIRST_GROUP"} = 1; $self->{"TABLE_STARTED"} = 0; $self->{'SAVE_ABOVE_SPACE'} = $main::TABLE_ABOVE_RULE_SPACE; $self->{'SAVE_BELOW_SPACE'} = $main::TABLE_BELOW_RULE_SPACE; $self->{'SAVE_FRAME_RULE'} = $main::TABLE_FRAME_RULE; &ColSpec::init(); &SpanSpec::init(); &FootnoteSpec::init(); $main::ERR_TABLE_COUNT++; $main::ERR_TABLE_TYPE = "TABLE"; $markup->markup($self->markup_start()); # --- $self->markup_children($markup, $child); # --- $main::TABLE_ABOVE_RULE_SPACE = $self->{'SAVE_ABOVE_SPACE'}; $main::TABLE_BELOW_RULE_SPACE = $self->{'SAVE_BELOW_SPACE'}; $main::TABLE_FRAME_RULE = $self->{'SAVE_FRAME_RULE'}; $markup->markup('.TE') if $self->{'TABLE_STARTED'}; &FootnoteSpec::output_footnotes($self); $markup->markup($self->markup_end()); $inmarkup ? $markup : $markup->output(); } } { package TABLE; @ISA = ('GENERIC_TITLED'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($child) = $self->content(); my($inmarkup) = defined($markup); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); $self->{"FIRST_GROUP"} = 1; $self->{"TABLE_STARTED"} = 0; $self->{'SAVE_ABOVE_SPACE'} = $main::TABLE_ABOVE_RULE_SPACE; $self->{'SAVE_BELOW_SPACE'} = $main::TABLE_BELOW_RULE_SPACE; $self->{'SAVE_FRAME_RULE'} = $main::TABLE_FRAME_RULE; &ColSpec::init(); &SpanSpec::init(); &FootnoteSpec::init(); $main::ERR_TABLE_COUNT++; $main::ERR_TABLE_TYPE = "TABLE"; $self->markup_title($markup); $child = $child->next() if $child->{'TAG'} eq 'TITLE'; # --- $self->markup_children($markup, $child); # --- $main::TABLE_ABOVE_RULE_SPACE = $self->{'SAVE_ABOVE_SPACE'}; $main::TABLE_BELOW_RULE_SPACE = $self->{'SAVE_BELOW_SPACE'}; $main::TABLE_FRAME_RULE = $self->{'SAVE_FRAME_RULE'}; $markup->markup('.TE') if $self->{'TABLE_STARTED'}; &FootnoteSpec::output_footnotes($self); $markup->markup($self->markup_end()); $inmarkup ? $markup : $markup->output(); } } { package TGROUP; @ISA = ('GENERIC_WRAPPER'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($parent) = $self->{'PARENT'}; $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); $pgwide = $parent->{'ATTR'}->{'PGWIDE'}; $frame = $parent->{'ATTR'}->{'FRAME'}; $colsep = $self->{'ATTR'}->{'COLSEP'}; $rowsep = $self->{'ATTR'}->{'ROWSEP'}; $colsep = $parent->{'ATTR'}->{'COLSEP'} if $colsep eq ""; $rowsep = $parent->{'ATTR'}->{'ROWSEP'} if $rowsep eq "";; $ColSpec::DEFAULT_ALIGN = $self->{'ATTR'}->{'ALIGN'}; $ColSpec::COLUMN = 1; $ColSpec::DEFAULT_COLSEP = $colsep; $ColSpec::DEFAULT_ROWSEP = $rowsep; $ColSpec::DEFAULT_ROLE = $self->{'ATTR'}->{'ROLE'}; $SpanSpec::DEFAULT_ALIGN = $self->{'ATTR'}->{'ALIGN'}; $SpanSpec::DEFAULT_COLSEP = $colsep; $SpanSpec::DEFAULT_ROWSEP = $rowsep; $SpanSpec::DEFAULT_ROLE = $self->{'ATTR'}->{'ROLE'}; $tgroup_count++; $row_count = 0; if ($parent->{"FIRST_GROUP"} == 1) { if ($frame eq "ALL") { if ($main::TABLE_FRAME_RULE eq $main::TABLE_DOUBLE_HORIZ_RULE){ $options = &add_option($options, "doublebox"); } else { $options = &add_option($options, "box"); } } $options = &add_option($options, "expand") if $pgwide == 1; $self->{"TABLE_OPTIONS"} = $options; $parent->{"FIRST_GROUP"} = 0; } $needs_a_topframe = 0; $needs_a_topframe = 1 if ($frame eq "TOP") || ($frame eq "TOPBOT"); $self->markup_children($markup, $self->content()); &ROW::hrule($markup, 'BF', $self) if ($frame eq "BOTTOM") || ($frame eq "TOPBOT"); $inmarkup ? $markup : $markup->output(); } sub add_option { my($options, $opt) = @_; $options .= ", " if $options ne ""; $options .= $opt; return $options; } } { package COLSPEC; @ISA = ('GENERIC_WRAPPER'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($column); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); $column = $self->{'ATTR'}->{'COLNUM'} || $ColSpec::COLUMN; $ColSpec::COLUMN = $column+1; $ColSpec::ALIGN{$column} = ($self->{'ATTR'}->{'ALIGN'} || $ColSpec::DEFAULT_ALIGN); if ($self->{'ATTR'}->{'COLNAME'}) { $ColSpec::NAME{$column} = $self->{'ATTR'}->{'COLNAME'}; $ColSpec::COL{$self->{'ATTR'}->{'COLNAME'}} = $column; } $ColSpec::COLSEP{$column} = $self->{'ATTR'}->{'COLSEP'}; $ColSpec::ROWSEP{$column} = $self->{'ATTR'}->{'ROWSEP'}; $ColSpec::CHAR{$column} = ($self->{'ATTR'}->{'CHAR'}) if $self->{'ATTR'}->{'CHAR'}; $ColSpec::CHAROFF{$column} = ($self->{'ATTR'}->{'CHAROFF'}) if $self->{'ATTR'}->{'CHAROFF'}; $ColSpec::COLWIDTH{$column} = ($self->{'ATTR'}->{'COLWIDTH'}) if $self->{'ATTR'}->{'COLWIDTH'}; $ColSpec::ROLE{$column} = ($self->{'ATTR'}->{'ROLE'}) if $self->{'ATTR'}->{'ROLE'}; $inmarkup ? $markup : undef; } } { package SPANSPEC; @ISA = ('GENERIC_WRAPPER'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($name); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); $name = $self->{'ATTR'}->{'SPANNAME'}; $SpanSpec::ALIGN{$name} = ($self->{'ATTR'}->{'ALIGN'} || $SpanSpec::DEFAULT_ALIGN); $SpanSpec::CHAR{$name} = ($self->{'ATTR'}->{'CHAR'}) if $self->{'ATTR'}->{'CHAR'}; $SpanSpec::CHAROFF{$name} = ($self->{'ATTR'}->{'CHAROFF'}) if $self->{'ATTR'}->{'CHAROFF'}; $SpanSpec::COLSEP{$name} = $self->{'ATTR'}->{'COLSEP'}; $SpanSpec::ROWSEP{$name} = $self->{'ATTR'}->{'ROWSEP'}; $SpanSpec::NAMEST{$name} = $self->{'ATTR'}->{'NAMEST'}; $SpanSpec::NAMEEND{$name} = $self->{'ATTR'}->{'NAMEEND'}; $SpanSpec::ROLE{$name} = $self->{'ATTR'}->{'ROLE'}; $inmarkup ? $markup : undef; } } { package THEAD; @ISA = ('GENERIC_WRAPPER'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($tgroup) = $self->{'PARENT'}; my($table) = $tgroup->{'PARENT'}; $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); if (!$table->{'TABLE_STARTED'}) { $markup->markup($self->markup_start()); $markup->markup("$tgroup->{'TABLE_OPTIONS'} ;\n") if $tgroup->{'TABLE_OPTIONS'} ne ""; } $table->{'TABLE_STARTED'} = 1; $self->markup_children($markup, $self->content()); $markup->markup($self->markup_end()); $ColSpec::curcolspec = "invalid spec, force a restart"; $inmarkup ? $markup : $markup->output(); } } { package TBODY; @ISA = ('GENERIC_TAG'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($tgroup) = $self->{'PARENT'}; my($table) = $tgroup->{'PARENT'}; $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); if (!$table->{'TABLE_STARTED'}) { $markup->markup($self->markup_start()); $markup->markup("$tgroup->{'TABLE_OPTIONS'} ;\n") if $tgroup->{'TABLE_OPTIONS'} ne ""; } $table->{'TABLE_STARTED'} = 1; $self->markup_children($markup, $self->content()); $inmarkup ? $markup : $markup->output(); } } { package ROW; @ISA = ('GENERIC_TAG'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($parent) = $self->{'PARENT'}; my($tgroup) = $parent->{'PARENT'}; my($child) = $self->content(); my($colspec) = ""; my($colst, $colend); my($count, $row, $rowsepspec); my($entry, $entrycount, $column); my($align, $char, $charoff, $colname, $colsep, $morerows, $namest, $nameend, $rotate, $rowsep, $spanname, $valign, $role); local($_); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); $TGROUP::row_count++; if (!defined($parent)) { &main::WARNING("Unexpected ROW tag, not a child!??\n"); return; } $rowsepspec = ""; # Loop through all of the entries: calculate the attributes for # each particular entry. The calculated attributes may include # several levels of defaulting. These calculated attributes are # stored back into each entry so that they are available immediately # when the actual data for the row is being output. $child = $self->content(); $column = 1; while ($child) { foreach $_ ('align', 'char', 'charoff', 'colname', 'colsep', 'morerows', 'namest', 'nameend', 'rotate', 'rowsep', 'spanname', 'valign', 'role') { my($attr) = uc($_); eval "\$$_ = \$child->{'ATTR'}->{$attr}"; } $self->output_index_terms($child, $markup); if ($spanname) { $namest = $SpanSpec::NAMEST{$spanname}; $nameend = $SpanSpec::NAMEEND{$spanname}; $colsep = $SpanSpec::COLSEP{$spanname} if $colsep eq ""; $colsep = $SpanSpec::DEFAULT_COLSEP if $colsep eq ""; $rowsep = $SpanSpec::ROWSEP{$spanname} if $rowsep eq ""; $rowsep = $self->{'ATTR'}->{'ROWSEP'} if $rowsep eq ""; $rowsep = $SpanSpec::DEFAULT_ROWSEP if $rowsep eq ""; $align = $SpanSpec::ALIGN{$spanname} if $align eq ""; $char = $SpanSpec::CHAR{$spanname} if $char eq ""; $role = $SpanSpec::ROLE{$spanname} if $role eq ""; $role = $SpanSpec::DEFAULT_ROLE if $role eq ""; } if ($namest || $nameend) { $colst = $ColSpec::COL{$namest}; $colend = $ColSpec::COL{$nameend}; } else { $colst = $column; $colend = $column; } if (!$spanname) { $colsep = $ColSpec::COLSEP{$colst} if $colsep eq ""; $colsep = $ColSpec::DEFAULT_COLSEP if $colsep eq ""; $rowsep = $ColSpec::ROWSEP{$colst} if $rowsep eq ""; $rowsep = $self->{'ATTR'}->{'ROWSEP'} if $rowsep eq ""; $rowsep = $ColSpec::DEFAULT_ROWSEP if $rowsep eq ""; $align = $ColSpec::ALIGN{$colst} if $align eq ""; $char = $ColSpec::CHAR{$colst} if $char eq ""; $role = $ColSpec::ROLE{$colst} if $role eq ""; $role = $ColSpec::DEFAULT_ROLE if $role eq ""; } if ($rowsep >= 2) { $rowsepspec .= "="; } elsif ($rowsep == 1) { $rowsepspec .= "_"; } else { # Implement ORA standards, table headers are seperated from # the table by a rule and the table has a rule below it. # This implementation will break if the table has multiple # tgroups. (But you can override it with a rowsep attr.) # # if there is no explicit rowsep, and there are no more rows # and the parent is a thead and the next thing after the # parent is a tbody, we know that were in the last row of # the header. if ($rowsep eq "" && !$self->{'NEXT'} ) { # && $self->{'PARENT'}->{'TAG'} eq 'THEAD' # && $self->{'PARENT'}->{'NEXT'}->{'TAG'} eq 'TBODY') { $rowsepspec .= $main::TABLE_DEFAULT_ROW_SEP; } else { $rowsepspec .= " "; } # if (($lookahead ne "ROW") # && ($rowsep eq "") # && $main::TABLE_DEFAULT_ROW_SEP) { # $rowsepspec .= $main::TABLE_DEFAULT_ROW_SEP; # } else { # $rowsepspec .= " "; # } } &main::WARNING("Warning: span out of place in table.\n") if ($colst != $column); $colspec .= &align($align, $ColSpec::COLWIDTH{$column}); for ($count = $colst+1; $count <= $colend; $count++) { $colspec .= "s "; } if ($colend < $tgroup->{'ATTR'}->{'COLS'}) { $colspec .= "$main::TABLE_SINGLE_VERT_RULE " if $colsep == 1; $colspec .= "$main::TABLE_DOUBLE_VERT_RULE " if $colsep == 2; # Implement ORA standards, table columns are seperated by # rules. (You you can override this with a rowsep attr.) $colspec .= "$main::TABLE_DEFAULT_COL_SEP " if ($colsep eq "") && $main::TABLE_DEFAULT_COL_SEP; } foreach $_ ('align', 'char', 'charoff', 'colname', 'colsep', 'morerows', 'namest', 'nameend', 'rotate', 'rowsep', 'spanname', 'valign', 'role') { my($attr) = uc($_); eval "\$child->{'ATTR'}->{$attr} = \$$_"; } $column = $colend+1; $child = $child->next(); } if ($column-1 != $tgroup->{'ATTR'}->{'COLS'}) { my($msg) = sprintf("Expected %d but got %d.", $tgroup->{'ATTR'}->{'COLS'}, $column-1); $self->table_warning("wrong number of columns", $msg); } if ($colspec ne $ColSpec::curcolspec) { $markup->markup(".T&") if $ColSpec::curcolspec ne ""; $markup->markup("$colspec.\n"); $ColSpec::curcolspec = $colspec; } $child = $self->content(); $column = 1; $row = ""; while ($child) { my($entry) = undef; my($estart, $eend) = ("", ""); foreach $_ ('align', 'char', 'charoff', 'colname', 'colsep', 'morerows', 'namest', 'nameend', 'rotate', 'rowsep', 'spanname', 'valign', 'role') { my($attr) = uc($_); eval "\$$_ = \$child->{'ATTR'}->{$attr}"; } if ($align eq "CHAR") { my($pre, $post); if ($self->block_elements($child)) { $self->table_warning("cannot align=char block elements"); } else { $entry = $child->markup(); $pre = $entry; $post = ""; if ($char ne "") { my($thechar) = "\\$char"; if ($entry =~ /^([^$thechar]+)($thechar)(.*)$/) { $pre = "$1"; $post = "$2$3"; } } $entry = "$pre\\&$post"; } } # If the entry is a paragraph and the alignment isnt fully # justified, insert a .na to make the paragraph not be filled # flush right... if ($self->block_elements($child)) { $estart = "T{\n"; $eend = "\nT}"; if ($align ne 'JUSTIFY') { $estart = "T{\n.na\n"; } } # Handle special markup for table headers if ($self->{'PARENT'}->{'TAG'} eq "THEAD") { $role = ""; # roles dont change headers $estart .= "\\*[EM-TBLHD]"; $eend = "\\*[/EM-TBLHD]$eend"; } if ($role ne "") { $role =~ tr/A-Z/a-z/; if (defined($main::COLROLE_START{$role})) { $estart .= $main::COLROLE_START{$role}; $eend .= $main::COLROLE_END{$role}; } else { &main::WARNING("Undefined column role ignored: $role\n"); } } $markup->markup("\t") if $column != 1; $markup->markup("$estart"); $markup->markup($child->markup() || "\\&"); $markup->markup("$eend"); # $row .= "\t" if $column != 1; # # $row = "\\&" if ($row eq "") # && (($_ eq "-") || ($_ eq "=") || /^\./); # # if ($self->{'PARENT'}->{'TAG'} eq "THEAD") { # $role = ""; # roles dont change headers # $_ = "\\*[EM-TBLHD]$_\\*[/EM-TBLHD]"; # } # # if ($role ne "") { # $role =~ tr/A-Z/a-z/; # if (defined($main::COLROLE_START{$role})) { # $_ = $main::COLROLE_START{$role} . $_ . $main::COLROLE_END{$role}; # } else { # &main::WARNING("Undefined column role ignored: $role\n"); # } # } # # $row .= $_; $column++; $child = $child->next(); } $markup->markup("\n"); &hrule($markup, 'TF', $self) if ($TGROUP::row_count == 1 && $TGROUP::needs_a_topframe); { my($index) = ''; while ($row =~ /(\.XET.*?\.\/XET)/) { $index .= $1; $row = "$`$'"; } $index =~ s/\.X/\n\.X/g; $index =~ s/\.\/X/\n\.\/X/g; $index = substr($index,1); # Avoid the initial newline $markup->markup($index) if $index ne ""; } if ($rowsepspec =~ /^\=+$/) { # double rule across table &hrule($markup, 2, $self); } elsif ($rowsepspec =~ /^\_+$/) { # single rule across table &hrule($markup, 1, $self); } elsif ($rowsepspec !~ /^\ +$/) { # rule across at least one column while ($rowsepspec =~ /^(.)(.*)$/) { if ($1 eq "=") { $markup->markup($main::TABLE_DOUBLE_HORIZ_RULE); } elsif ($1 eq "_") { $markup->markup($main::TABLE_SINGLE_HORIZ_RULE); } $markup->markup("\t") if $2 ne ""; $rowsepspec = $2; } $markup->markup("\n"); } $inmarkup ? $markup : $markup->output(); } sub align { local($atype, $width) = @_; my($char); if ($atype eq "LEFT") { $char = "l"; } elsif ($atype eq "RIGHT") { $char = "r"; } elsif ($atype eq "CENTER") { $char = "c"; } elsif ($atype eq "CHAR") { $char = "n"; } else { $char = "l"; } $char .= "w($width)" if $width ne ""; return "$char "; } sub hrule { my($markup, $rule, $self) = @_; my($lookahead); $lookahead = $self->next() || $self->{'PARENT'}->{'NEXT'}; $markup->markup(".sp $main::TABLE_ABOVE_RULE_SPACE") if (($rule ne 'TF') && ($main::TABLE_ABOVE_RULE_SPACE ne "") && ($main::TABLE_ABOVE_RULE_SPACE ne "0p")); if (($rule eq 'TF') || ($rule eq 'BF')) { $markup->markup("$main::TABLE_FRAME_RULE\n"); } elsif ($rule == 1) { $markup->markup("$main::TABLE_SINGLE_HORIZ_RULE\n"); } elsif ($rule >= 2) { $markup->markup("$main::TABLE_DOUBLE_HORIZ_RULE\n"); } if ($lookahead->{'TAG'} eq "TBODY" || $lookahead->{'TAG'} eq "ROW") { $markup->markup(".sp $main::TABLE_BELOW_RULE_SPACE") if (($rule ne 'BF') &&($main::TABLE_BELOW_RULE_SPACE ne "") && ($main::TABLE_BELOW_RULE_SPACE ne "0p")); } } sub output_index_terms { my($self, $child, $markup) = @_; while ($child) { if ($child->{'TAG'} eq 'INDEXTERM') { $child->markup($markup); $child->{'already_marked_up'} = 1; } $self->output_index_terms($child->content(), $markup); $child = $child->next(); } } sub table_warning { my($self, $warning, $addnl) = @_; my($msg, $tblnum); $tblnum = $main::ERR_INFORMALTABLE_COUNT; $tblnum = $main::ERR_TABLE_COUNT if $main::ERR_TABLE_TYPE eq "TABLE"; $msg = sprintf("Warning: %s in %s number %d in %s (group %d, row %d). $addnl\n", $warning, $main::ERR_TABLE_TYPE, $tblnum, $main::PI_SOURCE_FILE, $TGROUP::tgroup_count, $TGROUP::row_count); &main::WARNING($msg); } sub block_elements { my($self, $child) = @_; my($block) = 0; $child = $child->content(); while (!$block && $child) { $block = 1 if ($child->{'TAG'} ne 'INDEXTERM') && ($child->markup_start() =~ /^\./); $child = $child->next(); } $block; } } { package ENTRY; @ISA = ('GENERIC_WRAPPER'); sub new { return bless { }; } } ###################################################################### # Footnotes ###################################################################### { package FOOTNOTEREF; @ISA = ("GENERIC_INLINE"); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($parent) = $self->{'PARENT'}; $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); if ($parent->{'TAG'} ne "ENTRY") { $markup->markup($self->markup_start()); $self->markup_children($markup, $self->content()); $markup->markup($self->markup_end()); } else { $markup->markup("\\*="); $markup->markup($self->markup_end()); } $inmarkup ? $markup : $markup->output(); } } { package FOOTNOTE; @ISA = ("GENERIC_TAG"); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($parent) = $self->{'PARENT'}; my($data); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); if ($parent->{'TAG'} ne "ENTRY") { $markup->markup("\\**"); $markup->markup($self->markup_start()); } $self->markup_children($markup, $self->content()); if ($parent->{'TAG'} ne "ENTRY") { $markup->markup($self->markup_end()); } else { $data = "NORM:THIS FOOTNOTE DOESNT WORK"; push(@FootnoteSpec::FN, $data); } $inmarkup ? $markup : $markup->output(); } } ###################################################################### # Table of Contents ###################################################################### { package TOCENTRY; @ISA = ('GENERIC_TAG'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($parent) = $self->{'PARENT'}; my($role) = ""; $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); if ($parent->{'TAG'} eq 'TOCCHAP') { $role = " C "; $role = " A " if $parent->{'ATTR'}->{'ROLE'} =~ /^Appendix/i; $role = " P " if $parent->{'ATTR'}->{'ROLE'} =~ /^Preface/i; $role = " G " if $parent->{'ATTR'}->{'ROLE'} =~ /^Glossary/i; $role = " C " if $parent->{'ATTR'}->{'ROLE'} =~ /^Chapter/i; } # Wait, now shouldn't somebody use the $role? $markup->markup($self->markup_start()); $self->markup_children($markup, $self->content()); $markup->markup($self->markup_end()); $inmarkup ? $markup : $markup->output(); } } { package LOTENTRY; @ISA = ('GENERIC_TAG'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($parent) = $self->{'PARENT'}; my($role) = ""; $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); $markup->markup($self->markup_start()); $self->markup_children($markup, $self->content()); $markup->markuip($self->markup_end()); $inmarkup ? $markup : $markup->output(); } } ###################################################################### # REFENTRY PAGES ###################################################################### { package REFENTRY; @ISA = ('GENERIC_TAG'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($child, $innerchild); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); $TITLE = ""; $MISC = ""; $VOL = ""; $child = $self->content(); while ($child->{'TAG'} ne "REFNAMEDIV") { if ($child->{'TAG'} eq "REFMETA") { $innerchild = $child->content(); while ($innerchild) { $TITLE = $innerchild->markup() if $innerchild->{'TAG'} eq "REFENTRYTITLE"; $VOL = $innerchild->markup() if $innerchild->{'TAG'} eq "MANVOLNUM"; $MISC = $innerchild->markup() if $innerchild->{'TAG'} eq "REFMISCINFO"; $innerchild = $innerchild->next(); } } $child = $child->next(); } $markup->markup($self->markup_start() . " \"$TITLE\" \"$MISC\" \"$VOL\""); $self->markup_children($markup, $self->content()); $markup->markup($self->markup_end()); $inmarkup ? $markup : $markup->output(); } } { package REFMETA; @ISA = ('GENERIC_NOP'); sub new { return bless { }; } } { package REFMISCINFO; @ISA = ('GENERIC_INLINE'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($child) = $self->content(); $newmarkup = new MARKUP_OBJECT; $child->markup($newmarkup); $inmarkup ? $markup : $newmarkup->output(); } } { package REFENTRYTITLE; @ISA = ('GENERIC_INLINE'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); my($child) = $self->content(); $newmarkup = new MARKUP_OBJECT; $child->markup($newmarkup); $inmarkup ? $markup : $newmarkup->output(); } } { package REFNAMEDIV; @ISA = ('GENERIC_TAG'); sub new { return bless { }; } sub markup { my($self, $markup) = @_; my($inmarkup) = defined($markup); $markup = new MARKUP_OBJECT if !$inmarkup; $self->default_markup($markup); $markup->markup($self->markup_start()); $self->markup_children($markup, $self->content()); $markup->markup($self->markup_end()); $inmarkup ? $markup : $markup->output(); } } 1;