#! /usr/bin/perl

# hytest.pl,
#
# Version 1.0, 15 May 1994
#
# W. Eliot Kimber
# kimber@passage.com
# Passage Systems, Inc.
#
# Change history:
#
#  16 May 1994 - First release.	 Treeloc resolution not implemented.
#		    Some validation still needs to be implemented.
#		    Cross-document links resolved but not traversed.

# Perl script demonstrating the processing of HyTime indirect
# locations.  This script will resolve indirect named locations using
# name list-form elements as well as tree locations (treeloc).	It
# works against the output of SGMLS.  Cross-document references can
# be resolved if either the target document itself or the SGMLS output
# for the document is available.  

# The following conventions are used for finding files:
#
# 1. The SGMLS mechanism for resolving entity references is used
#    to resolve references to other entities.
#
# 2. The SGMLS output for a given document must be in the same
#    directory as the document entity, must have the same filename
#    and the extension $so (for Sgmls Output).	This script will
#    check for that before parsing the SGML document itself, if the
#    the SGMLS output file is not older than the SGML document entity
#    (the script does not check the dates of the included entities as
#    SGMLS provides no information on external entity references).

# HyTime locations are managed by building a set of lookup tables indexed by ID value
# of all elements.  For elements that don't have an ID, one is assigned
# automatically.  These tables contains the elements GI, its HyTime architectural
# form name, and its starting location in the SGMLS output file (the line
# that contains the STAG record). 

# A second table indexed by tree location is also generated, associating
# tree locations with element IDs.  This second table allows resolution
# of structural locations into element IDs.

# A third table is built for name lists, indexing each nmlist-form element's
# list of names by its ID.  There are actually two tables, one for ID lists
# and another for entity lists.
 
# Generated IDs are prefixed with the reserved name indicator (#), and are
# numeric values, starting with zero.  

# This program also recognizes the reserved IDs "#NULL" and "#SELF".  #NULL
# represents the "null element", while "#SELF" refers to the element on 
# whose attributes that value is specified (e.g., when used as a linkends
# value, refers to the ilink-form element itself).  The reserved ID "#DOMROOT"
# is used for empty namelist-form elements, which by definition refer to the
# root of the document specified on the docorsub value (which by default is the
# document in which the nmlist element occurs.

# Tree locations are calculated by simply counting the children of a given
# element and appending their child number to their parent's tree location.
# The document element's tree location is always "1".

# This application supports the following set of modules and options:
#
# <?HyTime VERSION "ISO/IEC 10744:1992" HYQCNT=32 >
#
#  Largest quantum count supported is 2**32
#
# <?HyTime MODULE base exidrefs dcnatts>
#
# External ID references (cross-document locations) and HyTime data attributes
# are supported.
#
# <?HyTime MODULE measure >
#
# Only the base options of the measurement module are supported.  Needed to
# allow use of Dataloc location address elements.
#
# <?HyTime MODULE locs multloc anysgml anydtd mixspace coordloc>
#
# Supports multiple locations, links among documents of differing SGML declarations
# and DTDs, elements in multiple locations can be in different documents or
# name spaces, and coordinate locations are supported.
#
# <?HyTime MODULE links >
#
# Links are allowed.  By not specifying a "manyanch" value, links of unlimited
# numbers of anchors are allowed.

# Declarations are propertly validated, but functions that are not declared are still
# provided, although the required HyTime errors are reported.

# XXX This is for troff: in data, turn \ into \e (which prints as \).
# Backslashes in SDATA entities are left as backslashes.

$backslash_in_data = "\\";

$prog = $0;

$prog =~ s|.*/||;

$level = 0;

$firstelement = 1;

$lastchar = "\n";  #/* Used to track new lines in output */

&Setup_For_HyTime;

&Print_HyTime_Banner; # Required by ISO/IEC 10744

# Most of this is the standard SGMLS.PL code from James Clark.

while (<STDIN>) {
    chop;
    s/(.)//;
    $_ = $';
    $command = $1;
    if ($command eq '(') {
       &start_element($_);
       $level++;
    }
    elsif ($command eq ')') {
      $level--;
      &end_element($_);
      foreach $key (keys %attribute_value) {
	 @splitkey = split($;, $key);
	 if ($splitkey[0] == $level) {
	    delete $attribute_value{$key};
	    delete $attribute_type{$key};
	 }
      }
    }
    elsif ($command eq '-') {
       &unescape_data($_);
       &data($_);
    }
    elsif ($command eq 'A') {
       @field = split(/ /, $_, 3);
       push(@attlist, $field[0]);
       $attribute_type{$level,$field[0]} = $field[1];
       &unescape_data($field[2]);
       $attribute_value{$level,$field[0]} = $field[2];
    }
    elsif ($command eq '&') {
       &entity($_);
    }
    elsif ($command eq 'D') {
      @field = split(/ /, $_, 4);
      $data_attribute_type{$field[0], $field[1]} = $field[2];
      &unescape_data($field[3]);
      $data_attribute_value{$field[0], $field[1]} = $field[3];
    }
    elsif ($command eq 'N') {
      $notation{$_} = 1;
      if (defined($sysid)) {
	 $notation_sysid{$_} = $sysid;
	 undef($sysid);
      }
      if (defined($pubid)) {
	 $notation_pubid{$_} = $pubid;
	 undef($pubid);
      }
    }
    elsif ($command eq 'I') {
      @field = split(/ /, $_, 3);
      $entity_type{$field[0]} = $field[1];
      &unescape($field[2]);
      # You may want to substitute \e for \ if the type is CDATA.
      $entity_text{$field[0]} = $field[2];
      $entity_code{$field[0]} = 'I';
    }
    elsif ($command eq 'E') {
      @field = split(/ /, $_);
      $entity_code{$field[0]} = 'E';
      $entity_type{$field[0]} = $field[1];
      $entity_notation{$field[0]} = $field[2];
      if (defined(@files)) {
	 foreach $i (0..$#files) {
	   $entity_filename{$field[0], $i} = $files[i];
	 }
	 undef(@files);
      }
      if (defined($sysid)) {
	$entity_sysid{$field[0]} = $sysid;
	undef($sysid);
      }
      if (defined($pubid)) {
	 $entity_pubid{$field[0]} = $pubid;
	 undef($pubid);
      }
    }
    elsif ($command eq 'S') {
      $entity_code{$_} = 'S';
      if (defined(@files)) {
	 foreach $i (0..$#files) {
	   $entity_filename{$_, $i} = $files[i];
	 }
	 undef(@files);
      }
      if (defined($sysid)) {
	 $entity_sysid{$_} = $sysid;
	 undef($sysid);
      }
      if (defined($pubid)) {
	 $entity_pubid{$_} = $pubid;
	 undef($pubid);
      }
    }
    elsif ($command eq '?') {
      &unescape($_);
      &pi($_);
    }
    elsif ($command eq 'L') {
      @field = split(/ /, $_);
      $lineno = $field[0];
      if ($#field >= 1) {
	 &unescape($field[1]);
	 $filename = $field[1];
      }
    }
    elsif ($command eq 'V') {
      @field = split(/ /, $_, 2);
      &unescape($field[1]);
      $environment{$field[0]} = $field[1];
    }
    elsif ($command eq '{') {
      &start_subdoc($_);
    }
    elsif ($command eq '}') {
      &end_subdoc($_);
    }
    elsif ($command eq 'f') {
      &unescape($_);
      push(@files, $_);
    }
    elsif ($command eq 'p') {
      &unescape($_);
      $pubid = $_;
    }
    elsif ($command eq 's') {
      &unescape($_);
      $sysid = $_;
    }
    elsif ($command eq 'C') {
      $conforming = 1;
    }
    else {
      warn "$prog:$ARGV:$.: unrecognized command \`$command'\n";
    }
}

sub unescape {
    $_[0] =~ s/\\([0-7][0-7]?[0-7]?|.)/&esc($1)/eg;
}

sub esc {
    local($_) = $_[0];
    if ($_ eq '012' || $_ eq '12') {
 "";			 # ignore RS
    }
    elsif (/^[0-7]/) {
 sprintf("%c", oct);
    }
    elsif ($_ eq 'n') {
 "\n";
    }
    elsif ($_ eq '|') {
 "";
    }
    elsif ($_ eq "\\") {
 "\\";
    }
    else {
 $_;
    }
}

sub unescape_data {
    local($sdata) = 0;
    $_[0] =~ s/\\([0-7][0-7]?[0-7]?|.)/&esc_data($1)/eg;
}

sub esc_data {
    local($_) = $_[0];
    if ($_ eq '012' || $_ eq '12') {
 "";			 # ignore RS
    }
    elsif (/^[0-7]/) {
 sprintf("%c", oct);
    }
    elsif ($_ eq 'n') {
 "\n";
    }
    elsif ($_ eq '|') {
 $sdata = !$sdata;
 "";
    }
    elsif ($_ eq "\\") {
 $sdata ? "\\" : $backslash_in_data;
    }
    else {
 $_;
    }
}


sub start_element {
   local($gi) = $_[0];
   if ($firstelement ) {
      $firstelement = 0;
      &Report_HyTime_Declarations();
   }
   local($htform) = "HYBRID";  # Default form name. 
   local($id)	 = "";
   local($treeloc) = "";
   push(@ancestors, $gi);
   $attstring = "";
   foreach $attname (@attlist) {
      $attype = $attribute_type{$level, $attname};
      $value  = $attribute_value{$level, $attname};
      if ($value ne "") {
	 if ($attname eq "HYTIME") { 
	    $htform = $value;
	 }
	 if ($attype eq "ID") { 
	    $htform = $value;
	 }
	 if ($attname eq "ID") {
	    $id = $value;
	 }
      }
   }
   if ($id eq "") { # Assign an ID
      $id = "#" . $IDctr++;
   }
   push(@currentid, $id);
   # Calculate tree location:
   # Pop child number, increment, push it, then push "0" on stack.
   local($childnum) = pop(@childnumstack);
   $childnum++;
   push(@childnumstack, $childnum);
   $myTL = "";
   foreach $num (@childnumstack) {
       $myTL = $myTL . " " . $num;
   }
   push(@childnumstack, "0");
 
   # Update tables:
   #	    
   $Treeloctable{$id} = $myTL;
   $GItable{$id} = $gi;
   $HTFormtable{$id} = $htform;
   $Linenumtable{$id} = $.;
   $IDtable{$myTL} = $id;

   #  select on element type:
   &say("Element: GI=$gi,\tHyTime
form=$htform,\tID=$id,\tTreeloc=\"$myTL\"");

   if (grep(/^$gi$/, @stag_ignore)) { }
   else { 
      if ($htform eq "NAMELOC") {
	 &Process_Nameloc($id);
      }
      elsif ($htform eq "NMLIST") {
	 &Process_NMList_Start($id);
      }
      elsif ($htform eq "ILINK") {
	$result = &Process_Ilink($id);
      }
      elsif ($htform eq "CLINK") {
	$result = &Process_Clink($id);
      }
      else {
      }
   }
   @attlist = ();
}

sub end_element {
    local($gi) = $_[0];
    local($currentid) = @currentid[$#currentid];

# Do any end-tag processing

   local($htform) = $HTFormtable{$currentid};
   if ( $htform eq "NMLIST" ) {
      &Process_NMList_End($currentid);
   }
   elsif ( $htform eq "NAMELOC" ) {
      &Process_Nameloc_End($currentid);
   }

# pop stacks

    pop(@ancestors);
    pop(@childnumstack);
    pop(@currentid);
}

sub data {
    local($data) = $_[0];
    local($gi) = @ancestors[$#ancestors];
    $temp = $*;
    if (grep(/^$gi$/, @tosl)) {
	 $* = 1;
	 $data =~ s/\n/ /g;
       }
    if ($innmlist) {
       $data =~ s/\n/ /g;
       $namelist = $namelist . $data;
    }
    else {
      &print("$data");
    }
    $* = $temp;
}

# A processing instruction.

sub pi {
    local($data) = $_[0];
    local($udata) = $data;
    $udata =~ tr/a-z/A-Z/;
    if ($udata =~ s/^HYTIME\b//) { #Must be HyTime use declaration
       &Validate_HyTime_Support_Declaration($udata);
    }
}

# A reference to an external entity.

sub entity {
    local($name) = $_[0];
    # XXX
}

sub start_subdoc {
    local($name) = $_[0];
    # XXX
}

sub end_subdoc {
    local($name) = $_[0];
    # XXX
}

sub print {
  print STDOUT "@_";
  $lastchar = chop(@_[0]);
#  &say("Lastchar=($lastchar)");
}

sub say {
  print STDERR "@_\n";
}

sub ID2IDList { # Argument is target ID
   local($id) = @_[0];
   local($idlist) = "";
   local($htform) = $HTFormtable{@_[0]};
   if (&IsLocAddr($id)) {
      local(@list) = split(' ',&Loc2IDList($id, $htform));
      foreach $listentry (@list) {
	  $idlist = $idlist . " " . &ID2IDList($listentry);
      }
   }
   else {
      $idlist = $idlist . " " . $id;
   }
   return($idlist);
}

sub IsLocAddr {
   local($htform) = $HTFormtable{@_[0]};
   grep(/^$htform$/, @locaddr);	 # Returns True or False
}

sub Loc2IDList {
   local($id) = @_[0];

   local($htform) = $HTFormtable{$id};
   if ($htform eq "NAMELOC") {
     &nameloc2IDList($id);
   }
   elsif ($htform eq "TREELOC") {
     return &treeloc2IDList($id);
   }
   elsif ($htform eq "DATALOC") {
     return &dataloc2IDList($id);
   }
   else {
      print STDERR "Unsupported location address form $htform ignored.";
      return "";
   }
}

sub HyTimeFormOf { # Argument is ID
   $HTFormtable{@_[0]};
}

sub nameloc2IDList { # argument is ID of nameloc element
  local($id) = @_[0];
  local(@nmlists) = split(' ',$nameloctbl{$id}); # IDs of NMLists in this nameloc
  local($idlist) = "";
  foreach $name (@nmlists) {
     $idlist .= " " . $NMlisttbl{$name};
  }
  return($idlist);
}

sub treeloc2IDList {
  local($id) = @_[0];
}

sub dataloc2IDList {
  local($id) = @_[0];
}

sub Process_Clink {
   local($id) = @_[0];
   &say("Processing Contextual link-form element...\n");
   local($currentid) = @currentid[$#currentid];
   if ($firstlink) {
      $firstlinkloc = 0;
      unless (grep(/^LOCS$/, @declaredmodules)) {
	print STDERR "HyTime error:\n";
	print STDERR "	$gi element found in document but hyperlinks module\n";
	print STDERR "	support not declared for this document.	 Links will be\n";
	print STDERR "	processed anyway.\n";
      }
   }
   local($id) = @_[0];
   local($linkend) = $attribute_value{$level, &HyAttName("LINKEND")};
   local($objects) = &ID2IDList($linkend);
   # Report what we found:
   &say("For clink, linkend objects are:\n");
   &Report_Linkend(split(' ', $objects));
   &say("");
}

sub Process_Ilink {
&say("Processing independent link element...\n");
   local($currentid) = @currentid[$#currentid];
   if ($firstlink) {
      $firstlinkloc = 0;
      unless (grep(/^LOCS$/, @declaredmodules)) {
	print STDERR "HyTime error:\n";
	print STDERR "	$gi element found in document but hyperlinks module\n";
	print STDERR "	support not declared for this document.	 Links will be\n";
	print STDERR "	processed anyway.\n";
      }
   }
   local($id) = @_[0];
   local($anchrole) = $attribute_value{$level, &HyAttName("ANCHROLE")};
   $anchrole =~ tr/a-z/A-Z/; #fold to upper case
   local($linkends) = $attribute_value{$level, &HyAttName("LINKENDS")};
   local($endterms) = $attribute_value{$level, &HyAttName("ENDTERMS")};
   local($extra) = $attribute_value{$level, &HyAttName("EXTRA")};
   local($intra) = $attribute_value{$level, &HyAttName("INTRA")};
   local($aggtrav) = $attribute_value{$level, &HyAttName("AGGTRAV")};
# &say("Anchor roles=\"$anchrole\"");
# &say("Link ends=\"$linkends\"");
   local(@anchroles) = ();
   local(@linkends) = ();
   local($temp) = $anchrole;
   @anchroles = split(' ',$anchrole);
   local(@temp) = (); local($ctr) = -1;

   # Re-attach instances of "#AGG" with the preceding anchor role name:

   foreach $role (@anchroles) {
      if ( substr($role,0,1) eq "#" ) {
	 @temp[$ctr] = @temp[$ctr] . " " . $role;
      }
      else {
	 $ctr++;
	 @temp[$ctr] = $role;
      }
   }
   @anchroles = @temp;
   @linkends = &Resolve_Linkends($linkends);

   unless (($#anchroles eq $#linkends) | ($#anchroles eq ($#linkends +1))) {
      print STDERR "HyTime error:\n";
      print STDERR "  Anchrole values do not correspond to linkends values on\n";
      print STDERR "  ilink-form element.\n  Anchrole=\"$anchrole\"\n";
      print STDERR "  Linkends=\"$linkends\"\n";
   }

   if ($#anchroles eq $#linkends -1) {
      unshift(@linkends, $currentid); # Make Ilink-form element first linkend
   }
 
   $ctr = 0;
   # now check to see if any non-aggregate anchors
   foreach $anchrole (@anchroles) {
      local(@objects) = split(' ', @linkends[$ctr]);
      if ( ($#objects gt 0) && (!($anchrole =~ m/#AGG/))) {
	 print STDERR "HyTime error:\n";
	 print STDERR "	 Aggregate location specified for anchor role for which #AGG\n";
	 print STDERR "	 was not specified (@anchroles[$ctr]).	This anchor does not allow\n";
	 print STDERR "	 aggregate locations.  May be mismatch between anchor roles\n";
	 print STDERR "	 and linkends specifications.\n";
	 print STDERR "	 Using first ID in aggregate as linkend.\n";
	 @linkends[$ctr] = @objects[0];
	 # At this point should probably provide some sort of reference traceback to
	 # provide a clue as to where the mistake was made.
      }
      &say("For anchor \"$anchrole\", objects are:\n");
      &Report_Linkend(@objects);
      &say(""); #  blank line.
      $ctr++;
   }
 }

sub Report_Linkend { # argument is array of objects
      foreach $objid (@_) {
	 if ($IDdocorsubtable{$objid} eq "") {
	    &say("o Element with ID \"$objid\" in this document");
	 }
	 else {
	     &say("o Element with ID \"$objid\" in document entity \"$IDdocorsubtable{$objid}\"");
	  }
      }
}

sub Resolve_Linkends {
   # walk through linkends value building list of actual pointers to
   # link ends.	 Check to see if each ID is in the IDaggloc table.  If it is,
   # then it satisfies an anchor, otherwise, walk down through the namelist
   # to which it refers.
   local(@linkends) = split(' ',@_[0]); 
   local(@reallinkends) = ();
   foreach $linkend (@linkends) {
       if ($IDaggloctable{$linkend} eq "" ) { # not an aggregate
	  if ($HTFormtable{$linkend} eq "NAMELOC") { # non-aggregate name list
	     local(@temp) = split(' ', $NMtable{$linkend}); # Get nmlist IDs
	     foreach $nmlist (@temp) {
	       @reallinkends = push(@reallinkends, &Resolve_Linkends($IDnmlisttable{$nmlist}));
	     }
	  }
	  else { # not a nameloc
	     push(@reallinkends, $linkend);
	  }
       }
       else { # an aggregate, treat as a list of IDs
	     push(@reallinkends, &ID2IDList($linkend));
       }
   }
   # At this point, each element of @reallinkends is either a single ID value
   # or a list of aggregated IDs.
   return(@reallinkends);
}

sub Process_Nameloc {
   if ($firstnameloc) {
     $firstnameloc = 0;
     unless (grep(/^LOCS$/, @declaredmodules)) {
       print STDERR "HyTime error:\n";
       print STDERR "  Nameloc element found in document but location address\n";
       print STDERR "  module support not declared for this document.  Namelocs will be\n";
       print STDERR "  processed anyway.\n";
     }
   }

# Get multloc attribute values and put in table for later use.

   $aggloc = $attribute_value{$level, &HyAttName("AGGLOC")};
   if ($aggloc eq "") { $aggloc = "NAGG"; };
   local($ordering) = $attribute_value{$level, &HyAttName("ORDERING")};
   if ($ordering eq "") { $ordering = "NOORDER"; };
   local($set) = $attribute_value{$level, &HyAttName("SET")};
   if ($set eq "") { $ordering = "NOTSET"; };
 
   $NLaggloctbl{$id} = $aggloc;
   $NLordertbl{$id} = $ordering;
   $NLsettbl{$id} = $set;

   local($id) = @_[0];
   $nameloctbl{$id} = "";
   $currentnameloc = $id;
   if ($firstmultloc && ($aggloc ne "NAGG")) {
      unless (grep(/^MULTLOC$/, @declaredlocsoptions)) {
	print STDERR "HyTime error:\n";
	print STDERR "	Multiple location specified (element type $gi with id $id)\n";
	print STDERR "	but MULTLOC option not declared on LOCS HyTime support\n";
	print STDERR "	declaration.\n";
	print STDERR "Multiple locations will still be resolved by this application\n";
      }
      $firstmultloc = 0;
   }
}

sub Process_Nameloc_End {
   if ($aggloc ne "NAGG") { # aggregate location, put in ID table as aggloc
      # For each nameloctbl value, look up name loc list:
      local(@temp) = split($nameloctbl{$currentnameloc});
      local($agglist) = "";
      foreach $nlid (@temp) {
	 $agglist = $agglist . " " . $IDnmlisttable{$nlid};
      }
      $IDaggloctable{$currentnameloc} = $agglist;
   }
   $currentnameloc = "";
   $aggloc = "";
}

sub Process_NMList_Start {
   local($id) = @_[0];
   $nameloctbl{$currentnameloc} .= " " . $id;
   $NMlisttbl{$id} = "";  # Table values will be set in end tag processing.
   $NMdocorsubtbl{$id} = $attribute_value{$level, "DOCORSUB"};
   $NMnametypetbl{$id} = $attribute_value{$level, "NAMETYPE"};
   $innmlist = 1; # Flag used by data processor
   $namelist = "";
}

sub Process_NMList_End {
   local($id) = @_[0];
   if ($NMnametypetbl{$id} eq "ELEMENT") {
      $namelist =~ tr/a-z/A-Z/;
      if ($namelist eq "") { $namelist = "#DOMROOT" };
      local(@temp) = split(' ', $namelist);
      foreach $objid (@temp) {
	 $IDdocorsubtable{$objid} = $attribute_value{$level, "DOCORSUB"};
      }
   }
   $NMlisttbl{$id} = $namelist;
   $innmlist = 0;
   $namelist = "";
}

sub Process_Dataloc {
   local($id) = @_[0];
&say("Found dataloc, id=$id");
}

sub Process_Treeloc {
   local($id) = @_[0];
&say("Found treeloc, id=$id");
}
sub Validate_HyTime_Support_Declaration { # Argument is PI data
       $udata =~ s/(\w+)\b//;  # Get declaration type token, either VERSION or MODULE
       if ($1 eq "VERSION") { # Check version to make sure it's correct
	  $udata =~ s/\"(.*)\"//;
	  $udata = $';
	  if ($1 ne $supportedHyTimeVersion) {
	     print STDERR "HyTime error:\n";
	     print STDERR "  Unsuppored HyTime version \"$1\" found in HyTime VERSION\n";
	     print STDERR "  support declaration.  This application supports version \n";
	     print STDERR "  \"$supportedHyTimeVersion\"\n";
	     print STDERR "  Cannot guarantee correct processing\n";
	  }
	  if ($udata =~ s/HYQCNT=(\d(\d\d?)?)//) {
	     $hyqcnt = $1;
	  }
	  else {
	     print STDERR "\nHyTime error:\n";
	     print STDERR "  No HYQCNT specification found in HyTime version declaration\n";
	     print STDERR "  assuming HYQCNT=32\n";
	     $hyqcnt = $32;
	  }
       }
       elsif ($1 eq "MODULE") {
	  local($decl) = $';
	  $decl =~ s/(\w+)\b//; # Get next word--module name
	  if ($1 eq "BASE") { # Base module
	     local($options) = $';
	     local(@ValidBaseOptions) = ("CONTEXT", "LEXTYPE", "HYLEX", "LEXORD",
				      "REFCTL", "EXIDREFS", "DVLIST", "DESCTXT",
				      "ACTIVITY", "DCNATTS", "XPROPDEF", "HYPD",
				      "UNPARSED");
	     push(@declaredmodules, "BASE");
	     while ($options =~ s/(\w+)\b//) {
		  if (grep(/^$1$/, @baseoptions)) {
		     push(@declaredbaseoptions, $1);
		  }
		  else {
		     if (grep(/^$1/, @ValidBaseOptions)) {
			print STDERR "\nHyTime error:\n";
			print STDERR "	Unsupported Base module option \"$1\" found.\n";
			print STDERR "	Functions requiring $1 will not be provided.\n";
		     }
		     else {
			print STDERR "\nHyTime error:\n";
			print STDERR "	Invalid Base module option \"$1\" found, ignored.\n";
		     }
		}
	     }
	  }
	  elsif ($1 eq "MEASURE") { # Measurement module
	     local($options) = $';
	     local(@ValidMeasureOptions) = ("DIMREF", "MARKFUN", "HYOP", 
					       "HYFUNK", "HOMOGRAN", "FCSMDU",
					       "AXISMDU");
	     push(@declaredmodules, "MEASURE");
	     while ($options =~ s/(\w+)\b//) {
		if (grep(/^$1$/, @measureoptions)) {
		     push(@declaredmeasureoptions, $1);
		  }
		  else {
		     if (grep(/^$1/, @ValidMeasureOptions)) {
			print STDERR "\nHyTime error:\n";
			print STDERR "	Unsupported Measurement module option \"$1\" found.\n";
			print STDERR "	Functions requiring $1 will not be provided.\n";
		     }
		     else {
			print STDERR "\nHyTime error:\n";
			print STDERR "	Invalid Measurement module option \"$1\" found, ignored.\n";
		     }
		}
	     }
	  }
	  elsif ($1 eq "LOCS") { # Location address module
	     local($options) = $';
	     local(@ValidLocsOptions) = ("MULTLOC", "SPANLOC", "ANYSGML",
					    "ANYDTD", "MIXSPACE", "COORDLOC",
					    "PATHLOC", "RELLOC", "NOTSRC", "QUERY",
					    "HYQ", "MIXCASE", "BIGMATCH", "UASSERT");
	     push(@declaredmodules, "LOCS");
	     while ($options =~ s/(\w+)\b//) {
		if (grep(/^$1$/, @locsoptions)) {
		     push(@declaredlocsoptions, $1);
		  }
		  else {
		     if (grep(/^$1/, @ValidLocsOptions)) {
		       print STDERR "\nHyTime error:\n";
		       print STDERR "  Unsupported Location address module option \"$1\" found.\n";
		       print STDERR "  Functions requiring $1 will not be provided.\n";
		     }
		     else {
			print STDERR "\nHyTime error:\n";
			print STDERR "	Invalid Measurement module option \"$1\" found, ignored.\n";
		     }
		}
	     }
	  }
	  elsif ($1 eq "LINKS") { # Hyperlink module
	     local($options) = $';
	     local(@ValidLinksOptions) = ("MANYANCH");
	     push(@declaredmodules, "LINKS");
	     while ($options =~ s/(\w+)\b//) {
		if (grep(/^$1$/, @linksoptions)) {
		     push(@declaredlinksoptions, $1);
		  }
		  else {
		      if (grep(/^$1/, @ValidLinksOptions)) {
			 print STDERR "\nHyTime error:\n";
			 print STDERR "	 Unsupported Hyperlinking module option \"$1\" found.\n";
			 print STDERR "	 Functions requiring $1 will not be provided.\n";
		     }
		     else {
			print STDERR "\nHyTime error:\n";
			print STDERR "	Invalid Hyperlinks module option \"$1\" found, ignored.\n";
		     }
		}
	     }
	  }
	  elsif ($1 eq "SCHED") { # Scheduling module
	     local($options) = $';
	     local(@ValidSchedOptions) = ("MANYAXES", "SPLITFCS", "GRPDEX",
					    "ACCANCH", "EXRECON", "CALSPEC",
					    "JULDATE");
	     push(@declaredmodules, "SCHED");
	     while ($options =~ s/(\w+)\b//) {
		if (grep(/^$1$/, @schedoptions)) {
		     push(@declaredschedoptions, $1);
		  }
		  else {
		      if (grep(/^$1/, @ValidLinksOptions)) {
			 print STDERR "\nHyTime error:\n";
			 print STDERR "	 Unsupported Scheduling module option \"$1\" found.\n";
			 print STDERR "	 Functions requiring $1 will not be provided.\n";
		     }
		     else {
			print STDERR "\nHyTime error:\n";
			print STDERR "	Invalid Scheduling module option \"$1\" found, ignored.\n";
		     }
		}
	     }
	  }
	  elsif ($1 eq "REND") { # Rendition module
	     local($options) = $';
	     local(@ValidRendOptions) = ("MODIFY", "PATCH", "PROJECT", "PROFUN",
					     "SCALEREF");
	     push(@declaredmodules, "REND");
	     while ($options =~ s/(\w+)\b//) {
		if (grep(/^$1$/, @rendoptions)) {
		     push(@declaredrendoptions, $1);
		  }
		  else {
		      if (grep(/^$1/, @ValidLinksOptions)) {
			print STDERR "\nHyTime error:\n";
			print STDERR "	Unsupported Rendition module option \"$1\" found.\n";
			print STDERR "	Functions requiring $1 will not be provided.\n";
		     }
		     else {
			print STDERR "\nHyTime error:\n";
			print STDERR "	Invalid Rendition module option \"$1\" found, ignored.\n";
		     }
		}
	     }
	  }
	  else {
	     print STDERR "\nHyTime error:\n";
	     print STDERR "  Invalid HyTime support declaration module \"$1\" found.\n";
	     print STDERR "  Support declaration ignored\n";
	  }
       }
       else {
	 print STDERR "Unknown HyTime declaration \"$1\" found, ignored.\n";
       }
}

sub Report_HyTime_Declarations {
   print STDERR "\nHyTime modules and options declared by this document:\n";
   print STDERR "\n";
   foreach $module (@declaredmodules) {
      if ($module eq "BASE") {
	 print STDERR "Base Module:  ";
	 print STDERR "@declaredbaseoptions\n";
      }
      if ($module eq "MEASURE") {
	 print STDERR "Measurement Module:  ";
	 print STDERR "@declaredmeasureoptions\n";
      }
      if ($module eq "LOCS") {
	 print STDERR "Location address Module:	 ";
	 print STDERR "@declaredlocsoptions\n";
      }
      if ($module eq "LINKS") {
	 print STDERR "Hyperlinking Module:  ";
	 print STDERR "@declaredlinksoptions\n";
      }
      if ($module eq "SCHED") {
	 print STDERR "Scheduling Module:  ";
	 print STDERR "@declaredschedoptions\n";
      }
      if ($module eq "REND") {
	 print STDERR "Scheduling Module:  ";
	 print STDERR "@declaredrendoptions\n";
      }
   }
  print STDERR "\n";
}

sub Print_HyTime_Banner {
  print STDERR "\nA HyTime application conforming to\n";
  print STDERR "International Standard ISO/IEC 10744 --\n";
  print STDERR "Hypermedia/Time-based Structuring Language\n";
}

sub Setup_For_HyTime {
$supportedHyTimeVersion = "ISO/IEC 10744:1992";
@declaredmodules = ();	   # holds HyTime modules actually declared
@baseoptions = ("EXIDREFS", "DCNATTS");
@declaredbaseoptions = (); # Holds options actually declared.
@measureoptions = ();
@declaredmeasureoptions = ();
@locsoptions = ("MULTLOC", "ANYSGML", "ANYDTD", "MIXSPACE", "COORDLOC");
@declaredlocsoptions = ();
@linksoptions = ();
@declaredlinksoptions = ();
@schedoptions = ();
@declaredschedoptions = ();
@rendoptions = ();
@declaredrendoptions = ();

@stag_ignore = ();
@etag_ignore = ();

@stag_nl = ();
@etag_nl = ();
@tosl	 = ();	 # Text on same line--for output where the data can't
		 # wrap in the output.
@valueatts = ();
@ancestors = ();  # Stack of parent GIs
@ancHTforms = (); # Stack of parent forms.
@treelocstack = (); # Stack of treelocs
@childnumstack = (); # Stack of child numbers, pushed for children, popped
		     # by etag.
@locaddr = ("NAMELOC", "TREELOC", "DATALOC", "LISTLOC", "RELLOC",
	      "PATHLOC", "NOTLOC", "BIBLOC", "PROPLOC");


%Treeloctable = ("#NULL", "0");
%GItable = ("#NULL", "#NULL", "sHyTime");
%HTFormtable = ("#NULL", "sHyTime");
%Linenumtable = ("#NULL", "0");

%IDaggloctable = ("#NULL", "#NULL"); # Contains entries for IDs that are the
					     # IDs of aggregate namelocs.

%idtable = ("1", "#ROOT", "0", "#NULL");
		# Indexes IDs by tree locations.

%IDnmlisttable	= ();
		      # Indexes name lists by their IDs.  The second
		      # value is a list of IDs as a blank-delimited string
		      # followed by the docorsub value.	 The reserved name
		      # "#DOCENT" refers to the current document (the one
		      # containing the nmlist-form element).
%Entnmlisttable = ();
		      # For lists of entity names.

%IDdocorsubtable = ();	# For IDs in other documents, lists the docorsub value
			# specified on the nmlist-form element that specified it.

#  The following flags are used to check to make sure support for a given
#  module or option has been declared for the document.

$firstnameloc = 1;
$firstlink    = 1;
$firstnmquery = 1;
$firstfcs    = 1;
$firstcoordloc = 1;
$firstmeasurement = 1;
$firstmultloc = 1;
$firstextidref = 1;

$IDctr = 0; # Used to generate IDs
}

sub HyAttName { # Uses HyNames to resolve names of HyTime attributes
     local($targatt) = @_[0];
     local($realatt) = $targatt;
     local($hynames) = $attribute_value{$level, "HYNAMES"};
     unless ($hynames eq "") {
       $hynames =~ tr/a-z/A-Z/;
       if ($hynames =~ m/($targatt)\b(\w+)\b/) {
	  $realatt = $2;
       }
     }
  return($realatt);
}