polymake-common 3.2r2-3 / usr / share / polymake / scripts / extract_docs

#  Copyright (c) 1997-2018
#  Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Berlin, Germany)
#  http://www.polymake.org
#
#  This program is free software; you can redistribute it and/or modify it
#  under the terms of the GNU General Public License as published by the
#  Free Software Foundation; either version 2, or (at your option) any
#  later version: http://www.gnu.org/licenses/gpl.txt.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#-----------------------------------------------------------------------------
#
#  Extracting pieces of documentation into XML files
#

require Polymake::Core::InteractiveHelp;
$Polymake::Core::InteractiveHelp::store_provenience=1;

require Polymake::Core::HelpAsHTML;

#############################################################################################
#
#  command line options:
#
#  --outdir PATH   put the output files APPNAME.xml into the given directory;
#                  creates the directory if needed.
#
#  --wiki URL      to substitute in wiki: references
#
#  --outsuffix .SFX  generate href="APPNAME.SFX" for cross-references between applications

my $outdir=".";
my $outsuffix=".xml";
my $wikiURL;
my $errors=0;

if ( !GetOptions( 'outdir=s' => \$outdir, 'wiki=s' => \$wikiURL, 'outsuffix=s' => \$outsuffix ) or
     !@ARGV ) {
   die "usage: polymake --script extract_docs [ --outdir PATH ] APPLICATION_NAME ...\n";
}

File::Path::mkpath($outdir);

#############################################################################################
#
#  XML namespace declarations

my $pmdocns="http://www.polymake.org/ns/docs#3";
my $xhtmlns=$Core::HelpAsHTML::xhtmlns;
my $xmlid=[ "http://www.w3.org/XML/1998/namespace", "id" ];

sub doc_namespace { $pmdocns }

#############################################################################################

# InteractiveHelp => [ 'ID', Application ]
my %topic2id_appname;

sub assign_ids {
   my ($app_name, @queue)=@_;
   my $id=0;
   while (my $help=shift @queue) {
      $topic2id_appname{$help}=[ generate_id($help, $app_name, $id++), $app_name ];
      push @queue, values %{$help->topics};
   }
}

sub generate_id {
   my ($help, $app_name, $ord) = @_;
   my $id=$app_name . "__" . $help->name . "__$ord";
   $id =~ s/\W/_/g;
   $id =~ s/_{3,}/__/g;
   return $id;
}

# InteractiveHelp => WORD => [ InteractiveHelp ... ]
my %searchTree;

sub matching_topic {
   my ($topic, $word)=@_;
   $topic->name eq $word and
   length($topic->text) || grep { exists $topic->annex->{$_} } qw(param tparam return options property)
}

sub search_in_tree {
   my ($help, $word)=@_;
   my (%taboo, @ancestors);

   do {
      foreach my $topic ($help, @{$help->related}) {
         if (matching_topic($topic, $word)) {
            my $me=[ $topic ];
            $searchTree{$_}->{$word}=$me for @ancestors;
            return $topic;
         }
         if (defined (my $cached=$searchTree{$topic}->{$word})) {
            $searchTree{$_}->{$word}=$cached for @ancestors;
            return @$cached;
         }
      }
      if (my @found=uniq( map { matching_topic($_, $word) ? ($_) : $_->find("!rel", $word) } grep { !exists $taboo{$_} } values %{$help->topics})) {
         @found=select_closest($_[0], @found) if @found>1;
         $searchTree{$_}->{$word}=\@found for @ancestors;
         return @found;
      }
      foreach my $topic (@{$help->related}) {
         if (my @found=$topic->find("!rel", $word)) {
            @found=select_closest($_[0], @found) if @found>1;
            $searchTree{$_}->{$word}=\@found for @ancestors;
            return @found;
         }
      }
      $taboo{$help}=1;
      push @ancestors, $help if $help != $_[0];
      $help=$help->parent;
   } while (defined $help);

   my $notfound=[ ];
   $searchTree{$_}->{$word}=$notfound for @ancestors;
   ()
}

sub select_closest {
   my $from=shift;
   my @closest=@_;
   my $mindist=100000000;
   foreach (@_) {
      if (defined (my $dist=$from->proximity($_))) {
         if ($dist<$mindist) {
            $dist=$mindist;
            @closest=($_);
         } elsif ($dist==$mindist) {
            push @closest, $_;
         }
      }
   }
   @closest;
}

# try to resolve cross-references of different kinds
sub search {
   my ($help, $what)=@_;

   my $app=$application;
   my @how;
   if ($what =~ /^($id_re)::/o) {
      if (lc($1) eq "core") {
         undef $app;
         $what=$' if $1 eq "core";
         push @how, "!rel";
      } elsif (defined (my $other_app=lookup Core::Application($1))) {
         # [[APPNAME::something]] refers to other application
         $app=$other_app;
         $what=$';
         push @how, "!rel";
      }
   }
   my $top_help=$app ? $app->help : $Core::Help::core;

   my (@topics, $obj_help);
   if ($what =~ /[.:]/ && $what =~ /^ (?: ($id_re)::)? ($hier_id_re) $/xo) {
      if ($1 eq "Core" || $1 eq "Visual") {
         @topics=@how ? $top_help->find(@how, $what) : search_in_tree($help, $what);
      } elsif ($1 eq "props") {
         @topics=$top_help->find(@how, "property_types", $2);
      } else {
         # (ObjectType::)SUBOBJECT.PROPERTY
         @topics= defined($1) ? $top_help->find(@how, "objects", $1) : defined($app) ? uniq( grep { defined } map { $_->help_topic } @{$app->object_types} ) : ();
         foreach my $prop_name (split /\./, $2) {
            @topics=uniq( grep { defined } map { $_->find("?rel", "properties", $prop_name) } @topics );
         }
         @topics=select_closest($top_help, @topics) if @topics>1;
      }
   }
   if (!@topics  &&
       $what =~ /^(?: # qual_id_re is greedy, it would swallow the method name
                      (?'objtype' $id_re (?: ::$id_re)* )::(?'method' [^:]+) $
                      # match parametrized types
                    | (?'objtype' $type_re)::(?'method' [^:]+) $
                  ) /xo  &&
       defined ($obj_help=$top_help->find(@how, "objects", "property_types", $+{objtype}))) {
      # Qualified::Type::METHOD
      @topics=$obj_help->find("?rel", $+{method});
   }
   if (!@topics) {
      # try as a single term
      @topics=@how ? $top_help->find(@how, $what) : search_in_tree($help, $what);
   }

   if (@topics==1) {
      ref_to_topic($topics[0]) // '#'
   } elsif (@topics) {
      err_print( "Ambiguous reference to $_[1] from ", ($application ? $application->name : "Core"), "::", $help->full_path, "; candidates are:\n",
                 (map { "    ".$_->full_path."\n" } @topics),
                 "Please disambiguate by qualification with application name and/or object type at ", $help->defined_at );
      ++$errors;
      '#AMBIGUOUS'

   } elsif ($_[1] =~ /^($qual_id_re) \s*<\s* $types_re \s*>$/xo) {
      search($help, $1);
   } else {
      err_print( "Unresolved reference to $_[1] from ", ($application ? $application->name : "Core"), "::", $help->full_path, "\n",
                 $_[1] =~ /[<>]/ ? "Please remove the type parameters, because help topics are not stored with specializations"
                                 : "Please double-check the spelling and/or qualify with application name or object type",
                 " at ", $help->defined_at );
      ++$errors;
      '#UNRESOLVED'
   }
}

sub ref_to_topic {
   my ($topic)=@_;
   if (defined (my $id_appname=$topic2id_appname{$topic})) {
      ($id_appname->[1] ne ($application ? $application->name : "core") && $id_appname->[1].$outsuffix) . '#' . $id_appname->[0]
   } else {
      undef
   }
}

sub ref_to_type {
   my ($referrer, $type)=@_;
   if (defined (my $help=$type->help_topic)) {
      if (defined (my $ref=ref_to_topic($help))) {
         return $ref;
      }
   }
   if ($type->abstract) {
      return '#';
   }
   err_print( "Help topic ", $referrer->full_path, " defined at ", $referrer->defined_at, " refers to a ",
              (instanceof Core::ObjectType::Specialization($type) ? ("specialization ", $type->full_name) :
               instanceof Core::ObjectType($type) ? ("big object type ", $type->full_name) :
               instanceof Core::PropertyType($type) ? ("property type ", $type->full_name) :
               ("perl class ", ref($type))), " not represented in the help topic tree\n" );
   ++$errors;
   '#INVALID'
}

my %ignore_types;
@ignore_types{qw(ARRAY SCALAR HASH CODE Any enum)}=();

sub resolve_ref {
   my ($help, $ref, $force)=@_;
   if ($ref =~ m{^ wiki: ([^\s\#]+) (\# \S+)? $}x ) {
      return "$wikiURL/$1".lc($2);
   }
   if ($ref =~ m{^ $id_re :// }xo) {
      return $ref;
   }
   if (!$force && $ref =~ /^$id_re$/o) {
      if (exists $ignore_types{$ref}) {
         return '#';
      }

      for (my $topic=$help; defined($topic); $topic=$topic->parent) {
         if (defined (my $tparams=$topic->annex->{tparam})) {
            if (grep { $_->[0] eq $ref } @$tparams) {
               return '#';
            }
         }
         if (defined (my $params=$topic->annex->{param})) {
            if (grep { $_->[0] =~ /^$id_re<.*\b$ref\b.*>$/ } @$params) {
               return '#';
            }
         }
      }

      $ref =~ s/^(Object(?:Type)?)$/Core::$1/;
   }

   my $func_help;
   if (defined (my $ovcnt=$help->annex->{function}) &&
       ($help->parent->category ? $help->parent->parent : $help->parent)->name ne "methods") {
      $func_help= $ovcnt ? $help->topics->{"overload#0"} : $help;
   }
   local_array($help->related, ($application ? $application->help : $Core::Help::core)->related_objects($func_help)) if defined($func_help);
   search($help, $ref);
}

sub help_text_writer {
   my ($writer, $help)=@_;
   new_fragment Core::HelpAsHTML($writer, sub { resolve_ref($help, $_[0], 1) })
}

sub write_descr {
   my ($writer, $help, $optional)=@_;
   if ($help->text =~ /\S/) {
      $writer->startTag("description");
      help_text_writer($writer, $help)->writeBlock($help->text, "p");
      $writer->endTag("description");
   } elsif (!$optional) {
      $writer->dataElement("description", "UNDOCUMENTED");
   }
}

sub write_descr_string {
   my ($writer, $help, $text)=@_;
   if ($text =~ /\S/) {
      $writer->startTag("description");
      help_text_writer($writer, $help)->writeBlock($text, "div");
      $writer->endTag("description");
   }
}

sub write_type_params {
   my ($writer, $help)=@_;
   if (defined (my $tparams=$help->annex->{tparam})) {
      foreach (grep { @$_>1 } @$tparams) {
         $writer->startTag("tparam", name => $_->[0]);
         write_descr_string($writer, $help, $_->[1]);
         $writer->endTag;
      }
   }
}

sub write_function {
   my ($writer, $help, $ovcnt, @attrs)=@_;
   if (!@attrs) {
      @attrs=(name => $help->name, $xmlid => $topic2id_appname{$help}->[0]);
      if ($ovcnt=$help->annex->{function}) {
         foreach (0..$ovcnt) {
            my $ov_topic=$help->topics->{"overload#$_"};
            $attrs[-1]=$topic2id_appname{$ov_topic}->[0] if $_;     # the first instance inherits the id of the common parent node
            write_function($writer, $ov_topic, $_, @attrs);
         }
         return 1;
      }
   }

   $writer->startTag("function", @attrs, ext_attr_dir($help));
   write_type_params($writer, $help);

   if (defined (my $params=$help->annex->{param})) {
      foreach (@$params) {
         $writer->startTag("param", name => $_->[1], type => $_->[0], href => resolve_ref($help, $_->[0]));
         if ($_->[1] eq "the") {
             warn_print( "\"the\" used as a parameter name. Revise the docstring: ", ($application ? $application->name : "Core"), "::", $help->name, " defined at ", $help->defined_at );
         }
         my $descr=$_->[2];
         my $value_list=$_->[3];
         if ($descr =~ /\S/ || defined($value_list)) {
            $writer->startTag("description");
            my $text_writer=help_text_writer($writer, $help);
            $text_writer->writeBlock($descr, "div");
            if (defined $value_list) {
               $text_writer->write_possible_values($value_list);
            }
            $writer->endTag("description");
         }
         $writer->endTag;
      }
   }
   if (defined (my $options=$help->annex->{options})) {
      foreach my $opt_group (@$options) {
         if (is_object($opt_group)) {
            my $group_ref=ref_to_topic($opt_group)
                          // die "Internal error: orphaned option group help node ", $opt_group->full_path, "\n";
            $writer->emptyTag("common-option-list", name => $opt_group->name, href => $group_ref);
         } else {
            my $group_text=local_shift($opt_group);
            if (length($group_text)) {
               $writer->startTag("options");
               write_descr_string($writer, $help, $group_text);
            }
            foreach my $opt (@$opt_group) {
               $writer->startTag("option", name => $opt->[1], type => $opt->[0], href => resolve_ref($help, $opt->[0]));
               write_descr_string($writer, $help, $opt->[2]);
               $writer->endTag;
            }
            if (length($group_text)) {
               $writer->endTag("options");
            }
         }
      }
   }
   if (defined (my $return=$help->annex->{return})) {
      $writer->startTag("return", type => $return->[0], href => resolve_ref($help, $return->[0]));
      write_descr_string($writer, $help, $return->[1]);
      $writer->endTag;
   }

   if (defined (my $author=$help->annex->{author})) {
      $writer->emptyTag("author", name => $author);
   }

   if (defined (my $spez=$help->annex->{spez})) {
      $writer->emptyTag("only", name => $spez->name, href => ref_to_topic($spez));
   }

   if (defined (my $depends=$help->annex->{depends})) {
      $writer->emptyTag("depends", name => "$depends");
   }

   if (defined (my $examples=$help->annex->{examples})) {
      $writer->startTag("examples");
      write_examples($writer, $help, $examples);
      $writer->endTag;
   }

   write_descr($writer, $help, $ovcnt);
   $writer->endTag("function");
   1
}

sub write_option_list {
   my ($writer, $help)=@_;
   $writer->startTag("common-option-list", name => $help->name, $xmlid => $topic2id_appname{$help}->[0]);
   write_descr($writer, $help);

   if (@{$help->related}) {
      $writer->startTag("imports-from");
      foreach my $rel_topic (@{$help->related}) {
         my $rel_ref=ref_to_topic($rel_topic)
                     // die "internal error: orphaned option group help node ", $rel_topic->full_path, "\n";
         $writer->emptyTag("common-option-list", name => $rel_topic->name, href => $rel_ref);
      }
      $writer->endTag("imports-from");
   }

   foreach my $key (@{$help->annex->{keys}}) {
      $writer->startTag("option", name => $key->[1], type => $key->[0], href => resolve_ref($help, $key->[0]));
      write_descr_string($writer, $help, $key->[2]);
      $writer->endTag;
   }

   $writer->endTag("common-option-list");
}

sub write_property_type {
   my ($writer, $help)=@_;

   my $pkg=$application->pkg."::props::".$help->name;
   my @ext;
   if (UNIVERSAL::can($pkg, "self")) {
      my $proto=$pkg->self;
      @ext = ext_attr($proto);
   }
   $writer->startTag("property-type", name => $help->name, @ext, $xmlid => $topic2id_appname{$help}->[0]);
   write_type_params($writer, $help);
   write_descr($writer, $help);

   if (UNIVERSAL::can($pkg, "self")) {
      my $proto=$pkg->self;
      if (defined($proto->super)) {
         $writer->emptyTag("derived-from",
                           type => ($proto->super->application != $application && $proto->super->application->name."::").$proto->super->full_name,
                           href => ref_to_type($help, $proto->super));
      }
   }
   if (defined (my $methods=$help->topics->{methods})) {
      $writer->startTag("user-methods");
      write_categories($writer, $methods, \&write_function);
      $writer->endTag("user-methods");
   }
   $writer->endTag("property-type");
}

sub write_property_contents {
   my ($writer, $help)=@_;
   write_descr($writer, $help);

   if (defined (my $depends=$help->annex->{depends})) {
      $writer->emptyTag("depends", name => "$depends");
   }

   if (defined (my $examples=$help->annex->{examples})) {
      $writer->startTag("examples");
      write_examples($writer, $help, $examples);
      $writer->endTag;
   }

   if (defined (my $properties=$help->topics->{properties})) {
      $writer->startTag("properties");
      write_categories($writer, $properties, \&write_property);
      $writer->endTag("properties");
   }
   if (defined (my $methods=$help->topics->{methods})) {
      $writer->startTag("user-methods");
      write_categories($writer, $methods, \&write_function);
      $writer->endTag("user-methods");
   }
}

sub write_examples {
   my ($writer, $help, $examples) = @_;
   foreach my $ex (@$examples) {
      $writer->startTag("example");
      $writer->startTag("description");
      help_text_writer($writer, $help)->example($ex->body);
      $writer->endTag;
      $writer->endTag;
   }
}

sub write_property {
   my ($writer, $help)=@_;
   my $prop=$help->annex->{property};
   my $type=$prop->type;

   $writer->startTag("property", name => $help->name,
                     type => ($type->application != $application && $type->application->name."::").$type->full_name,
                     href => ref_to_type($help, $type),
                     ext_attr($prop),
                     $xmlid => $topic2id_appname{$help}->[0]);

   if (defined (my $spez=$help->annex->{spez})) {
      $writer->emptyTag("only", name => $spez->name, href => ref_to_topic($spez));
   }
   write_property_contents($writer, $help);
   $writer->endTag("property");
   1
}

sub write_permutation {
   my ($writer, $help)=@_;
   $writer->startTag("permutation", name => $help->name, $xmlid => $topic2id_appname{$help}->[0]);
   write_property_contents($writer, $help);
   $writer->endTag("permutation");
}

sub write_object {
   my ($writer, $help)=@_;
   my $obj_proto=$help->annex->{type};

   $writer->startTag("object", name => $help->name, $xmlid => $topic2id_appname{$help}->[0],
                               defined($obj_proto) ? ext_attr($obj_proto) : ());
   write_type_params($writer, $help);

   if (defined (my $spezs=$help->topics->{specializations})) {
      foreach my $s (@{$spezs->topics}{@{$spezs->toc}}) {
         $writer->startTag("specialization", name => $s->name, $xmlid => $topic2id_appname{$s}->[0]);
         write_descr($writer, $s, 1);
         $writer->endTag;
      }
   }

   if (defined $obj_proto) {
      write_descr($writer, $help, defined($obj_proto->generic));
      my %shown_super_types;
      foreach my $super (@{$obj_proto->super}) {
         if (defined($super->help_topic) && !instanceof Core::ObjectType::Specialization($super) && !$shown_super_types{$super->name}++ && $super != $obj_proto->generic) {
            $writer->emptyTag("derived-from",
                              object => ($super->application != $obj_proto->application && $super->application->name."::").$super->full_name,
                              href => ref_to_type($help, $super));
         }
      }

      if (defined (my $properties=$help->topics->{properties})) {
         $writer->startTag("properties");
         write_categories($writer, $properties, \&write_property);
         $writer->endTag("properties");
      }

      if (defined (my $perms=$help->topics->{permutations})) {
         $writer->startTag("permutations");
         write_categories($writer, $perms, \&write_permutation);
         $writer->endTag("permutations");
      }
   } else {
      if (defined (my $super=$help->annex->{super})) {
         $writer->emptyTag("derived-from",
                           object => $super,
                           href => resolve_ref($help, $super));
      }
      write_descr($writer, $help, 1);
   }

   if (defined (my $examples=$help->annex->{examples})) {
      $writer->startTag("examples");
      write_examples($writer,$help,$examples);
      $writer->endTag;
   }

   if (defined (my $methods=$help->topics->{methods})) {
      $writer->startTag("user-methods");
      write_categories($writer, $methods, \&write_function);
      $writer->endTag("user-methods");
   }
   $writer->endTag("object");
}

sub write_categories {
   my ($writer, $help, $write_sub, %taboo)=@_;
   my $has_categories;
   foreach my $topic (grep { $_->category && !$taboo{$_->name} } values %{$help->topics}) {
      $has_categories=1;
      $writer->startTag("category", name => $topic->name, ext_attr_dir($topic), $xmlid => $topic2id_appname{$topic}->[0]);
      write_descr($writer, $topic);
      unless (@{$topic->toc}) {
         warn_print( "Category without items: ", ($application ? $application->name : "Core"), "::", $topic->full_path );
      }
      foreach (@{$topic->toc}) {
         $write_sub->($writer, $topic->topics->{$_});
      }
      $writer->endTag("category");
   }
   foreach (@{$help->toc}) {
      next if $_ eq "any";
      my $topic=$help->topics->{$_};
      unless ($topic->category) {
         if ($has_categories) {
            warn_print( "Item without category: ", ($application ? $application->name : "Core"), "::", $topic->full_path);
         }
         $write_sub->($writer, $topic);
      }
   }
}

sub ext_attr {
   my ($thing)=@_;
   if (defined $thing->extension) {
      (ext=>$thing->extension->URI, ext_name=>$thing->extension->short_name)
   } else {
      ()
   }
}

sub ext_attr_dir {
   my ($help)=@_;
   my $dir = $help->defined_at;
   $dir =~ s@/apps/$id_re/(?:rules|src)/\S+, line \d+$@@o;
   if (my $e = $Core::Extension::registered_by_dir{$dir}) {
      (ext => $e->URI, ext_name => $e->short_name)
   } else {
      ()
   }
}

sub ext_attr_app {
   my ($app)=@_;
   my $dir = $app->top;
   $dir =~ s@/apps/$id_re$@@o;
   if (my $e = $Core::Extension::registered_by_dir{$dir}) {
      (ext => $e->URI, ext_name => $e->short_name)
   } else {
      ()
   }
}

sub open_doc_file {
   my ($filename, %namespaces)=@_;
   $namespaces{$pmdocns}="";
   open my $out, ">$outdir/$filename" or die "can't create file $outdir/$filename: $!\n";
   my $writer=new Core::XMLwriter($out, PREFIX_MAP => \%namespaces, FORCED_NS_DECLS => [ keys %namespaces ]);
   $writer->xmlDecl;
   return $writer;
}

sub close_doc_file {
   my ($writer)=@_;
   $writer->end;
   close($writer->getOutput);
}

sub open_app_doc_file {
   my ($appname, @attrs)=@_;
   my $writer=open_doc_file($appname.".xml", $xhtmlns => "html");
   $writer->getOutput->print(<<'.');
<!DOCTYPE application [
  <!ENTITY % HTMLsymbol PUBLIC "-//W3C//ENTITIES Symbols for XHTML//EN" "xhtml-symbol.ent">
  <!ENTITY % HTMLlat1   PUBLIC "-//W3C//ENTITIES Latin 1 for XHTML//EN" "xhtml-lat1.ent">
  %HTMLsymbol; %HTMLlat1;
]>
.
   $writer->startTag( [ $pmdocns, "application" ], name => $appname, @attrs);
   return $writer;
}

sub close_app_doc_file {
   my ($writer)=@_;
   $writer->endTag("application");
   &close_doc_file;
}

#############################################################################################
#
#  main function goes on

map { assign_ids($_->name, $_->help) } map { application($_) } @ARGV;
assign_ids("core", $Core::Help::core);

foreach my $app (@ARGV) {
   application($app);
   my $writer=open_app_doc_file($application->name, ext_attr_app($application));

   write_descr($writer, $application->help);

   if (@{$application->import_sorted}) {
      $writer->startTag("imports-from");
      $writer->emptyTag("application", name => $_) for @{$application->import_sorted};
      $writer->endTag("imports-from");
   }

   if (my @uses=grep { ! exists $application->imported->{$_} } keys %{$application->used}) {
      $writer->startTag("uses");
      $writer->emptyTag("application", name => $_) for @uses;
      $writer->endTag("uses");
   }

   if (defined (my $types=$application->help->topics->{property_types})) {
      $writer->startTag("property-types");
      write_categories($writer, $types, \&write_property_type);
      $writer->endTag("property-types");
   }

   if (defined (my $types=$application->help->topics->{options})) {
      $writer->startTag("common-option-lists");
      write_categories($writer, $types, \&write_option_list);
      $writer->endTag("common-option-lists");
   }

   if (defined (my $objects=$application->help->topics->{objects})) {
      $writer->startTag("objects");
      write_categories($writer, $objects, \&write_object);
      $writer->endTag("objects");
   }

   if (defined (my $functions=$application->help->topics->{functions})) {
      if (@{$functions->toc}) {
         $writer->startTag("user-functions");
         write_categories($writer, $functions, \&write_function);
         $writer->endTag("user-functions");
      }
   }

   close_app_doc_file($writer);
}

{
   local $application;
   local_push($Core::Help::core->related, application("common")->help);

   my $writer=open_app_doc_file("core");

   write_descr_string($writer, $Core::Help::core, <<'.');
Core functionality available in all applications.
.

   if (defined (my $objects=$Core::Help::core->topics->{objects})) {
      $writer->startTag("objects");
      write_categories($writer, $objects, \&write_object);
      $writer->endTag("objects");
   }

   if (defined (my $functions=$Core::Help::core->topics->{functions})) {
      if (@{$functions->toc}) {
         $writer->startTag("user-functions");
         write_categories($writer, $functions, \&write_function);
         $writer->endTag("user-functions");
      }
   }

   close_app_doc_file($writer);
}

if ($errors) {
   die "Encountered $errors error", ($errors>1 && "s"), ", generation aborted\n";
}

# Local Variables:
# mode: perl
# cperl-indent-level: 3
# indent-tabs-mode:nil
# End: