view release on metacpan or  search on metacpan

lib/LaTeXML/Common/Model/RelaxNG.pm  view on Meta::CPAN

    else {
      return ([$op, $name, $self->simplify_args($binding, $parentbinding, $container, @args)]); } }
  else {
    return ($form); } }

sub simplify_args {
  my ($self, $binding, $parentbinding, $container, @forms) = @_;
  return map { $self->simplify($_, $binding, $parentbinding, $container) } @forms; }

sub simplify_override {
  my ($self, $binding, $parentbinding, $container, @args) = @_;
  # Note that we do NOT simplify till we've made the replacements!
  my ($module, @replacements) = @args;
  my ($modop, $modname, @patterns) = @$module;
  # Replace any start from @patterns by that from @replacement, if any.
  if (my @replacement_start = grep { eqOp($_, 'start') } @replacements) {
    @patterns = grep { !eqOp($_, 'start') } @patterns; }
  foreach my $def (grep { (ref $_ eq 'ARRAY') && ($$_[0] =~ /^def/) } @replacements) {
    my ($defop, $symbol) = @$def;
    @patterns = grep { !(eqOp($_, $defop) && ($$_[1] eq $symbol)) } @patterns; }
  # Recurse on the overridden module
  return $self->simplify(['module', "$modname (overridden)", @patterns, @replacements],
    $binding, $parentbinding, $container); }

sub simplifyCombination {
  my ($combination) = @_;
  if ((ref $combination) && ($$combination[0] eq 'combination')) {
    my ($c, $op, @stuff) = @$combination;
    @stuff = map { simplifyCombination($_) } @stuff;
    if ($op =~ /^(group|choice)$/) {    # These can be flattened.
      @stuff = map { ((ref $_) && ($$_[0] eq 'combination') && ($$_[1] eq $op)
          ? @$_[2 .. $#$_] : ($_)) }
        @stuff; }
    return (($op eq 'group') && (scalar(@stuff) == 1) ? $stuff[0] : [$c, $op, @stuff]); }
  else {
    return $combination; } }

#======================================================================
# For debugging...
sub showSchema {
  my ($item, $level) = @_;
  $level = 0 unless defined $level;
  if (ref $item eq 'ARRAY') {
    my ($op, $name, @args) = @$item;
    if ($op eq 'doc') { $name = "..."; @args = (); }
    Debug("" . (' ' x (2 * $level)) . $op . ($name ? " " . $name : ''));

    foreach my $arg (@args) {
      showSchema($arg, $level + 1); } }
  else {
    Debug("" . (' ' x (2 * $level)) . $item); }
  return; }

#======================================================================
# Generate TeX documentation for a Schema
#======================================================================
# The svg schema can only just barely be read in and recognized,
# but it is structured in a way that makes a joke of our attempt at automatic documentation
my $SKIP_SVG   = 1;    # [CONFIGURABLE?]
my $SKIP_ARIA  = 1;
my $SKIP_XHTML = 1;

sub documentModules {
  my ($self) = @_;
  my $docs = "";
  $$self{defined_patterns} = {};
  foreach my $module (@{ $$self{modules} }) {
    my ($op, $name, @content) = @$module;
    next if $SKIP_SVG && $name =~ /:svg:/;                        # !!!!
    $name =~ s/^urn:x-LaTeXML:RelaxNG://;                         # Remove the urn part.
    $docs = join("\n", $docs,
      "\\begin{schemamodule}{$name}",
      (map { $self->toTeX($_) } @content),
      "\\end{schemamodule}"); }
  foreach my $name (sort keys %{ $$self{defined_patterns} }) {
    if ($$self{defined_patterns}{$name} < 0) {
      $docs =~ s/\\patternadd\{$name\}/\\patterndefadd{$name}/s; } }
  return $docs; }

sub cleanTeX {
  my ($string) = @_;
  return '\typename{text}' if $string eq '#PCDATA';
  $string =~ s/^urn:x-LaTeXML:RelaxNG://;    # Remove the urn part, if any
  $string =~ s/\#/\\#/g;
  $string =~ s/<([^>]*)>/\\texttt{$1}/g;     # An apparent convention <sometext> == ttfont?
  $string =~ s/_/\\_/g;
  return $string; }

sub cleanTeXName {
  my ($string) = @_;
  $string = cleanTeX($string);
  $string =~ s/^ltx://;
  #  $string =~ s/:/../;
  return $string; }

sub toTeX {
  my ($self, $object) = @_;
  if (ref $object eq 'HASH') {
    return join(', ', map { "$_=" . $self->toTeX($$object{$_}) } sort keys %$object); }
  elsif (ref $object eq 'ARRAY') {    # an object?
    my ($op, $name, @data) = @$object;
    if ($op eq 'doc') {
      return join(' ', map { cleanTeX($_) } @data) . "\n"; }
    elsif ($op eq 'ref') {
      return $self->toTeX_ref($op, $name); }
    elsif ($op =~ /^def(choice|interleave|)$/) {
      return $self->toTeX_def($1, $name, @data); }
    elsif ($op eq 'element') {
      return $self->toTeX_element($name, @data); }
    elsif ($op eq 'attribute') {
      return $self->toTeX_attribute($name, @data); }
    elsif ($op eq 'combination') {
      return $self->toTeX_combination($name, @data); }
    elsif ($op eq 'data') {
      return "\\typename{" . cleanTeX($data[0]) . "}"; }
    elsif ($op eq 'value') {
      return '\attrval{' . cleanTeX($data[0]) . "}"; }
    elsif ($op eq 'start') {
      my ($docs, @spec) = $self->toTeXExtractDocs(@data);
      my $content = join(' ', map { $self->toTeX($_) } @spec);
      return "\\item[\\textit{Start}]\\textbf{==}\\ $content" . ($docs ? " \\par$docs" : ''); }
    elsif ($op eq 'grammar') {    # Don't otherwise mention it?
      my (@mods, @rest);          # Collapse any iniitial module inclusions for brevity
      foreach my $datum (@data) {
        if ((ref $datum eq 'ARRAY') && ($$datum[0] eq 'module')) {
          push(@mods, $$datum[1]); }
        else { push(@rest, $datum); } }
      return join("\n",
        (@mods
          ? '\item[\textit{Included}]' . join(', ', map { '\moduleref{' . cleanTeX($_) . '}'; } @mods)
          : ()),
        map { $self->toTeX($_) } @rest); }
    elsif ($op eq 'module') {
      if (($name =~ /:svg:/) && $SKIP_SVG) {
        return '\item[\textit{Module }' . cleanTeX($name) . '] included.'; }
      else {
        return '\item[\textit{Module }\moduleref{' . cleanTeX($name) . '}] included.'; } }
    else {
      Warn('unexpected', $op, undef, "RelaxNG->toTeX: Unrecognized item $op");
      return "[$op: " . join(', ', map { $self->toTeX($_) } @data) . "]"; } }
  else {
    return cleanTeX($object); } }

sub toTeX_ref {
  my ($self, $op, $name) = @_;
  if (my $el = $$self{elementdefs}{$name}) {
    $el = cleanTeXName($el);
    return ($SKIP_XHTML && ($el eq 'xhtml:*') ? '\texttt{xhtml:*}' : "\\elementref{$el}"); }
  elsif ($name =~ /_(?:attributes|model)$/) {
    return $self->toTeX($$self{defs}{$name}); }
  else {
    $name =~ s/^\w+://;    # Strip off qualifier!!!! (watch for clash in docs?)
    return ($SKIP_SVG && ($name eq 'svg') ? '\texttt{svg:svg}'
      : "\\patternref{" . cleanTeX($name) . "}"); } }

sub toTeX_def {
  my ($self, $combiner, $name, @data) = @_;
  my $qname = $name;
  return "" if ($name =~ /\baria\b/) && $SKIP_ARIA;
  return "" if $name =~ /_(?:attributes|model)$/;
  $name =~ s/^\w+://;    # Strip off qualifier!!!! (watch for clash in docs?)
  return "" if $SKIP_SVG && ($name =~ /^svg/);
  $name = cleanTeX($name);
  my ($docs, @spec)    = $self->toTeXExtractDocs(@data);
  my ($attr, $content) = $self->toTeXBody(@spec);

  if ($combiner) {
    my $body = $attr;
    $body .= '\item[' . ($combiner eq 'choice' ? '\textbar=' : '\&=') . '] ' . $content if $content;
    $$self{defined_patterns}{$name} = -1 unless defined $$self{defined_patterns}{$name};
    return "\\patternadd{$name}{$docs}{$body}\n"; }
  else {
    $attr    = '\item[\textit{Attributes:}] \textit{empty}' if !$attr    && ($name =~ /\\_attributes/);
    $content = '\textit{empty}'                             if !$content && ($name =~ /\\_model/);
    my $body = $attr;
    $body .= '\item[\textit{Content}:] ' . $content if $content;
    if (!$attr && $self->toTeX_isContent($$self{defs}{$qname})) {
      my ($xattr, $xcontent) = $self->toTeXBody($$self{defs}{$qname});
      $body .= '\item[\textit{Expansion}:] ' . $xcontent
        if !$xattr && $xcontent && ($xcontent ne $content); }
    if (my $uses = $self->getSymbolUses($qname)) {
      $body .= '\item[\textit{Used by}:] ' . $uses; }
    if ((defined $$self{defined_patterns}{$name}) && ($$self{defined_patterns}{$name} > 0)) { # Already been defined???
      return ''; }
    else {
      $$self{defined_patterns}{$name} = 1;
      return "\\patterndef{$name}{$docs}{$body}\n"; } } }

sub toTeX_element {
  my ($self, $name, @data) = @_;
  my $qname = $name;
  $name =~ s/^ltx://;
  return "" if $SKIP_XHTML && ($name eq 'xhtml:*');
  $name = cleanTeXName($name);
  my ($docs, @spec)    = $self->toTeXExtractDocs(@data);
  my ($attr, $content) = $self->toTeXBody(@spec);
  $content = "\\typename{empty}" unless $content;
  # Shorten display for element-specific attributes & model, ASSUMING they immediately folllow!
  my $body = $attr;
  $body .= '\item[\textit{Content}:] ' . $content if $content;
  if (my $ename = $$self{elementreversedefs}{$qname}) {
    if (my $uses = $self->getSymbolUses($ename)) {
      $body .= '\item[\textit{Used by}:] ' . $uses; } }
  return "\\elementdef{$name}{$docs}{$body}\n"; }

sub toTeX_attribute {
  my ($self, $name, @data) = @_;
  $name = cleanTeXName($name);
  my ($docs, @spec) = $self->toTeXExtractDocs(@data);
  my $content = join(' ', map { $self->toTeX($_) } @spec) || '\typename{text}';
  if ($name =~ /^!(.*)/) {    # Excluded attribute?
    return "\\item[\\textit{Exluding attribute }]\\texttt{$1}"; }
  return "\\attrdef{$name}{$docs}{$content}"; }

sub toTeX_combination {
  my ($self, $name, @data) = @_;
  if ($name eq 'group') {
    return (scalar(@data) == 1 ? $self->toTeX($data[0])
      : "(" . join(', ', map { $self->toTeX($_) } @data) . ")"); }
  elsif ($name eq 'interleave') {
    return "(" . join(' ~\&~ ', map { $self->toTeX($_) } @data) . ")"; }    # ?
  elsif ($name eq 'choice') {
    return "(" . join(' ~\textbar~ ', map { $self->toTeX($_) } @data) . ")"; }
  elsif ($name eq 'optional') {
    if ((@data == 1) && eqOp($data[0], 'attribute')) {
      return $self->toTeX($data[0]); }
    else {
      return $self->toTeX($data[0]) . '\textsuperscript{?}'; } }
  elsif ($name eq 'zeroOrMore') {
    return $self->toTeX($data[0]) . '\textsuperscript{*}'; }
  elsif ($name eq 'oneOrMore') {
    return $self->toTeX($data[0]) . '\textsuperscript{*}'; }
  elsif ($name eq 'list') {
    return "(" . join(', ', map { $self->toTeX($_) } @data) . ")"; }    # ?
  else {
    Warn('unexpected', $name, undef, "RelaxNG->toTeX: Unrecognized combination $name");
    return; } }

sub getSymbolUses {
  my ($self, $qname) = @_;
  if (my $uses = $$self{usesname}{$qname}) {
    my @uses = sort keys %$uses;
    @uses = grep { !/\bSVG./ } @uses if $SKIP_SVG;                                               # !!!
    @uses = map  { (/pattern:[^:]*:(.*?)_(?:attributes|model)$/ ? "element:$1" : $_); } @uses;
    return join(', ',
      (map { /^pattern:[^:]*:(.*)$/ ? ('\patternref{' . cleanTeX($1) . '}')     : () } @uses),
      (map { /^element:(.*)$/       ? ('\elementref{' . cleanTeXName($1) . '}') : () } @uses)); }
  else {
    return ''; } }

# Extract any documentation nodes from @data
sub toTeXExtractDocs {
  my ($self, @data) = @_;