####################################################################### # SGMLSPL script produced automatically by the script sgmlspl.pl # # Document Type: dtd (gellmu) # Output Type: text/plain (SGML DTD) # Author: William F. Hammond # Begun: 19980925 # Last-revison: check the file system datestamp or the http header # ######################################################################## use SGMLS; # Use the SGMLS package. use SGMLS::Output; # Use stack-based output. $doctype = ""; $dtdref = ""; @elt_arg = (); $elt_argc = 0; @enp_arg = (); $enp_argc = 0; @ent_arg = (); $ent_argc = 0; @empt_arg = (); $empt_argc = 0; @precmt = (); $precn = 0; $verb_on = 0; # Document Handlers. sgml('start', ""); sgml('end', ""); # Element Handlers. # Element: dtd sgml('', ""); sgml('', "\n"); # Element: preamble sgml('', sub{ push_output('string'); }); sgml('', sub{ my $pos = pop_output; my $os = ""; my $es = ""; my $jj = 0; # Write a comment \n"; # where "test" is the value of $doctype # and "ref.dtd" is the value of $dtdref # Then pull up any comments found in the preamble. # There should be no output to pop. if($doctype eq ""){ $es = "This markup does not declare a DOCUMENT TYPE,\n"; $es = $es . "i.e., there is no name declared for its root ELEMENT\n"; die $es; } elsif($dtdref ne ""){ $os = $os . "\n"; } else{ ; }; $jj = 1; while($jj <= $precn){ $os = $os . $precmt[$jj] . "\n"; $jj++; }; output($os); }); # Element: doctype sgml('', sub{ push_output('string'); }); sgml('', sub{ $doctype = pop_output; }); # Element: dtdref sgml('', sub{ push_output('string'); }); sgml('', sub{ $dtdref = pop_output; }); # Element: body sgml('', ""); sgml('', ""); # Element: verb -- possibly headed for LaTeX "\verb+...+" sgml('', sub{ $verb_on = 1; }); sgml('', sub{ $verb_on = 0; }); # Element: ag0 -- auto-generated command argument sgml('', sub{ push_output('string'); my $pan = $_[0]->parent->name; if($pan eq "elt"){ ; } elsif($pan eq "enp"){ ; } elsif($pan eq "ent"){ ; } elsif($pan eq "empt"){ ; } elsif($pan eq "cmt"){ ; } else{ output("{*ELT " . $_[0]->name . " IN " . $pan); } }); sgml('', sub{ my $pos = pop_output; my $os = ""; my $pan = $_[0]->parent->name; if($pan eq "elt"){ $elt_argc++; $elt_arg[$elt_argc] = $pos; } elsif($pan eq "enp"){ $enp_argc++; $enp_arg[$enp_argc] = $pos; } elsif($pan eq "ent"){ $ent_argc++; $ent_arg[$ent_argc] = $pos; } elsif($pan eq "empt"){ $empt_argc++; $empt_arg[$empt_argc] = $pos; } elsif($pan eq "cmt"){ $os = "\n"; $os = $os . "\n"; $os = $os . "\n"; output($os); } else{ $os = $os . "\n"; output($os); }; }); # Element: elt sgml('',sub{ $elt_argc = 0; push_output('string'); }); sgml('', sub{ # args: name, tags, defn, comment? my $name = ""; my $pos = pop_output; my $os = ""; my $es = ""; my $jj = 0; my $reqarg = 3; my $itags = ""; my $jtags = ""; my $tags = ""; if($elt_argc < $reqarg){ $es = "\n"; output($es); } else{ $itags = $elt_arg[2]; $jtags = $itags; $jtags =~ s/\s*//g; # Now check the correctness of the input tagging requirement if(($jtags eq "rr")||($jtags eq "RR")||($jtags eq "--")){ $tags = " - - "; } elsif(($jtags eq "ro")||($jtags eq "RO")||($jtags eq "-O")){ $tags = " - O "; } elsif(($jtags eq "or")||($jtags eq "OR")||($jtags eq "O-")){ $tags = " O - "; } elsif(($jtags eq "oo")||($jtags eq "OO")){ $tags = " O O "; } else{ $es = "\n"; output($es); $tags = " x x "; }; $os = $os . "\n"; output($os); }; }); # Element: enp sgml('',sub{ # args: name, defn, comment? $enp_argc = 0; push_output('string'); }); sgml('', sub{ my $name = "enp"; my $pos = pop_output; my $os = ""; my $es = ""; my $jj = 0; my $reqarg = 2; if($enp_argc < $reqarg){ $es = "Error: Number of args for enp -- " . $enp_argc . " is too small (" . $reqarg . ")\n"; output($es); } else{ $os = $os . "\n"; output($os); } }); # Element: ent sgml('',sub{ $ent_argc = 0; push_output('string'); }); sgml('', sub{ my $name = "ent"; my $pos = pop_output; my $os = ""; my $es = ""; my $jj = 0; my $reqarg = 2; if($ent_argc < $reqarg){ $es = "Error: Number of args for ent -- " . $ent_argc . " is too small (" . $reqarg . ")\n"; output($es); } else{ $os = $os . "\n"; output($os); }; }); # Element: empt sgml('',sub{ $empt_argc = 0; push_output('string'); }); sgml('', sub{ my $name = "empt"; my $pos = pop_output; my $os = ""; my $es = ""; my $jj = 0; my $reqarg = 1; if($empt_argc < $reqarg){ $es = "Error: Number of args for empt -- " . $empt_argc . " is too small (" . $reqarg . ")\n"; output($es); } else{ $os = $os . "\n"; output($os); }; }); # Element: cmt sgml('', sub{ $precn++; push_output('string'); }); sgml('', sub{ my $pos = pop_output; $precmt[$precn] = ""; }); # Element: gx0 -- for bootstrapping new DTD tags sgml('',sub{ $gx0_argc = 0; push_output('string'); }); sgml('', sub{ my $name = "gx0"; my $pos = pop_output; my $os = ""; my $es = ""; my $jj = 0; my $reqarg = 0; # number of required 's; check "boot.dtd" if($gx0_argc < $reqarg){ $es = "\n"; output($es); }; $os = $os . "\n"; output($os); }); # Code for setting comments embedded in other declaration tags. # (The design of "boot.dtd" is that any beyond the required # number is a comment.) sub set_cmt{ my $is = $_[0]; my $os = " -- " . $is . "--"; return($os); }; # # Default handlers (uncomment these if needed). Right now, these are set # up to gag on any unrecognised elements, sdata, processing-instructions, # or entities. # sgml('start_element', sub{ output("*ELT " . $_[0]->name . "*"); push_output('string'); }); sgml('end_element',sub{ my $os = pop_output; output($os . "**"); }); # sgml('cdata',sub {output("*CDATA* " . $_[0] . "**");}); sgml('sdata',sub { die "Unknown SDATA: " . $_[0]; }); # sgml('re',"\n"); sgml('pi',sub { die "Unknown processing instruction: " . $_[0]; }); sgml('entity',sub { die "Unknown external entity: " . $_[0]->name; }); sgml('start_subdoc',sub { die "Unknown subdoc entity: " . $_[0]->name; }); # sgml('end_subdoc',''); # sgml('conforming',''); # Element: eos -- end of sentence mark sgml('', ". "); sgml('', ""); # Element: eoq -- end of question mark sgml('', "? "); sgml('', ""); # Element: eoe -- end of exclamation mark sgml('', "! "); sgml('', ""); # Element: bsl -- abstract char "\" sgml('', "\\"); sgml('', ""); # Element: lbr -- abstract char "{" sgml('', "{"); sgml('', ""); # Element: rbr -- abstract char "}" sgml('', "}"); sgml('', ""); # Element: lsb -- abstract char "[" sgml('', "["); sgml('', ""); # Element: rsb -- abstract char "]" sgml('', "]"); sgml('', ""); # Element: quo -- abstract char "\"" sgml('', '"'); sgml('', ""); # Element: sol -- abstract char "/" sgml('', "/"); sgml('', ""); # Element: eqc -- abstract char "=" sgml('', "="); sgml('', ""); # Element: spc -- ordinary blank (like LaTeX's "\ ") sgml('', " "); # no forcing sgml('', ""); # Element: brk sgml('', "\n"); sgml('', ""); # Element: exc sgml('', "!"); sgml('', ""); # Element: atc sgml('', "@"); sgml('', ""); # Element: hsh sgml('', "#"); sgml('', ""); # Element: dol sgml('', "\$"); sgml('', ""); # Element: pct sgml('', "%"); sgml('', ""); # Element: crt sgml('', "^"); sgml('', ""); # Element: amp sgml('', sub{ my $pan = $_[0]->parent->name; if(($pan eq "cmt")||($pan eq "verb")){ output("&"); } else{ output("&"); }; }); sgml('', ""); # Element: ast sgml('', "*"); sgml('', ""); # Element: und sgml('', "_"); sgml('', ""); # Element: tld sgml('', "~"); sgml('', ""); # Element: lsq sgml('', '`'); sgml('', ""); # Element: rsq sgml('', "'"); sgml('', ""); # Element: plu sgml('', "+"); sgml('', ""); # Element: hyp -- abstract hyphen (deliberate, but could be "minus") sgml('', "-"); sgml('', ""); # Element: lpr sgml('', "("); sgml('', ""); # Element: rpr sgml('', ")"); sgml('', ""); # Element: ltc sgml('', sub{ my $pan = $_[0]->parent->name; if(($pan eq "cmt")||($pan eq "verb")){ output("<"); } else{ output("<"); }; }); sgml('', ""); # Element: gtc sgml('', sub{ my $pan = $_[0]->parent->name; if(($pan eq "cmt")||($pan eq "verb")){ output(">"); } else{ output(">"); }; }); sgml('', ""); # Element: vbr sgml('', "|"); sgml('', ""); # Element: cln sgml('', ":"); sgml('', ""); # Element: scl sgml('', ";"); sgml('', ""); # Element: per sgml('', "."); sgml('', ""); # Element: cma sgml('', ","); sgml('', ""); # Element: qum sgml('', "?"); sgml('', ""); # Element: rdash -- set in GELLMU input as "--", not allowed here # inasmuch as separate comments may be done with "\cmt" # and in-tag comments with extra arguments sgml('', sub{ my $pan = $_[0]->parent->name; my $gpan = $_[0]->parent->parent->name; my $os = ""; my $es = "ERROR: detected element \"rdash\", probably arising from\n"; # Note: the tagging requirement is the SECOND argument of an element, # but the argument sequence counter is only advanced with the closetag. if(($pan eq "ag0") && ($gpan eq "elt") && ($elt_argc == 1)){ $os = "rr"; output($os); } else{ $es = $es . "the string \"--\" in GELLMU input for this DTD\n"; $es = $es . "at a dangerous location with ancestry as follows.\n"; $es = $es . " Parent element: " . $pan . "\n"; if ($pan eq "ag0"){ $es = $es . " Arg. sequence: " . $elt_argc . "\n"; } $es = $es . "Grandparent elt.: " . $gpan . "\n"; my $element = shift; my $event = shift; my $line = $event->line; $es = $es . " Error exit at input line " . $line . ".\n"; die $es; }; }); sgml('', ""); # Element: pdash -- set in GELLMU input as "---"; hazardous in a DTD. sgml('', sub{ my $pan = $_[0]->parent->name; my $es = "ERROR: detected element \"pdash\", probably arising from\n"; $es = $es . "the hazardous string \"---\" in GELLMU input for this DTD.\n"; $es = $es . " Parent element: " . $pan . "\n"; my $element = shift; my $event = shift; my $line = $event->line; $es = $es . " Error exit at input line " . $line . ".\n"; die $es; }); sgml('', ""); 1;