#!/usr/bin/env perl
# /=====================================================================\ #
# |  texscan                                                            | #
# | scan & analyze style, class file coverage                           | #
# |=====================================================================| #
# | support tools for LaTeXML:                                          | #
# |  Public domain software, produced as part of work done by the       | #
# |  United States Government & not subject to copyright in the US.     | #
# |---------------------------------------------------------------------| #
# | Bruce Miller <bruce.miller@nist.gov>                        #_#     | #
# | http://dlmf.nist.gov/LaTeXML/                              (o o)    | #
# \=========================================================ooo==U==ooo=/ #

use strict;
use warnings;
use Getopt::Long qw(:config no_ignore_case);
use Pod::Usage;
use FindBin;
# Assume we're in the tools directory of a development version of latexml (next to lib, blib..)
use lib "$FindBin::RealBin/../blib/lib";
use LaTeXML::Util::Pathname;

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# texscan : TeX class/style file scanner for LaTeXML.
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
my $identity = 'texscan';
my ($help) = (0);
local $::VERBOSITY = 0;
local $::AMSTEX    = 0;
my ($show, $internal, $cumulative, $basepkgs) = ('diff', undef, undef, undef);
my $do_all      = 0;
my @searchpaths = ();
GetOptions("tex" => sub { $show = 'tex'; },
  "latexml"   => sub { $show = 'latexml'; },
  "diff"      => sub { $show = 'diff'; },
  "signature" => sub { $show = 'signature'; },
  "stub"      => sub { $show = 'stub'; },
  "internal!" => \$internal,
  "cumulative!" => \$cumulative,
  "amstex!"     => \$::AMSTEX,
  "help"        => \$help,
  "verbose"     => sub { $::VERBOSITY++; },
  "quiet"       => sub { $::VERBOSITY--; },
  "path=s"      => \@searchpaths,
  "base=s"      => \$basepkgs,
  "all"         => \$do_all,
) or pod2usage(-message => $identity, -exitval => 1, -verbose => 0, -output => \*STDERR);
pod2usage(-message => $identity, -exitval => 1, -verbose => 2, -output => \*STDOUT) if $help;
pod2usage(-message => $identity, -exitval => 1, -verbose => 0, -output => \*STDOUT)
  unless $do_all or @ARGV;

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# Find available package/class implementations
# [Should get this from LaTeXML?]
our $LTXPACKAGEDIR = "$FindBin::RealBin/../blib/lib/LaTeXML/Package/";

my @files = ();
if ($do_all) {
  foreach my $dir ($LTXPACKAGEDIR, @searchpaths) {
    my $DIR_FH;
    opendir($DIR_FH, $dir) or die "Couldn't read LaTeXML Package directory $dir: $!";
    foreach my $file (sort readdir($DIR_FH)) {
      push(@files, $1) if $file =~ /^(.*)\.ltxml$/; }
    closedir($DIR_FH); } }
else {
  @files = @ARGV; }

foreach my $file (@files) {
  if ($show eq 'tex') {
    print "" . ("=" x 50) . "\n";
    print "Showing symbols in LaTeX package $file\n";
    if (my $pkg = StylePackage->new($file, searchpaths => [@searchpaths])) {
      $pkg->cleanup($cumulative, $internal);
      $pkg->convertEnvironments;
      $pkg->show; } }
  elsif ($show eq 'latexml') {
    print "" . ("=" x 50) . "\n";
    print "Showing symbols in LaTeXML implementation $file\n";
    if (my $pkg = ImplementationPackage->new($file, searchpaths => [@searchpaths])) {
      $pkg->cleanup($cumulative, $internal);
      $pkg->convertEnvironments;
      $pkg->show; } }
  elsif ($show eq 'diff') {
    print "" . ("=" x 50) . "\n";
    print "Showing unimplemented symbols for package $file\n";
    if (my $pkg = StylePackage->new($file, searchpaths => [@searchpaths])) {
      if (my $ipkg = ImplementationPackage->new($file, searchpaths => [@searchpaths])) {
        # $pkg->subtract($ipkg);
        # $pkg->cleanup($cumulative, $internal);
        # $pkg->convertEnvironments;
        # $pkg->show; } } }
        print "Symbols missing from LaTeXML:\n";
        my $sdiff = $pkg->clone->subtract($ipkg);
        $sdiff->cleanup($cumulative, $internal);
        $sdiff->convertEnvironments;
        $sdiff->show;
        print "Extra Symbols in LaTeXML:\n";
        my $idiff = $ipkg->clone->subtract($pkg);
        $idiff->cleanup($cumulative, $internal);
        $idiff->convertEnvironments;
        $idiff->show;
  } } }

  elsif ($show eq 'signature') {
    if (my $pkg = StylePackage->new($file, searchpaths => [@searchpaths])) {
      $cumulative = 1 unless defined $cumulative;    # default IS cumulative
      $pkg->cleanup($cumulative, $internal);
      $pkg->convertEnvironments;
      $pkg->signature; } }
  elsif ($show eq 'stub') {
    if (my $pkg = StylePackage->new($file, searchpaths => [@searchpaths])) {
      $pkg->cleanup(1, $internal);
      $pkg->generateStub($basepkgs); } }
}

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# Abstract Package package.
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# To put things on common footing --- or at least as common as we can
# --- we initially load a package or class by "cumulative" & "internal".
# Additionally, we load latex.ltx, possibly article.cls...
# Think of it this way: The basic load/scan of a package contains all
# control sequences that would be accessible if the package were
# loaded "normally".  Thus loading a class also has latex.ltx's symbols.
# Loading a style file also has some class, might as well be article, symbols.
# (this only affects *.cls and *.sty files)
#
# ->new gets a copy of the class, so you can use add, subtract and
# various remove methods (which are otherwise `destructive') to get
# the collection of symbols you want.
# newInternal loads as needed and caches the result, so that a
# large collection of packages can be processed in batch.
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
package Package;
use strict;
use LaTeXML::Util::Pathname;

our %CACHE;

# Get a copy of the Package for $path; all subpackages & internal symbols are included.
sub new {
  my ($classorself, $path, %options) = @_;
  my $package = $classorself->newInternal($path, searchpaths => $options{searchpaths})->clone;
  foreach my $add ($package->getBase) {
    if (my $pkg = $package->newInternal($add)) {
      $package->add($pkg); } }
  return $package; }

# Get the cached version of Package;
# you must use ->clone() if you're going to modify it.
sub newInternal {
  my ($classorself, $path, %options) = @_;
  my $class = ref $classorself || $classorself;
  my ($dir, $name, $type) = pathname_split($path);
  $name .= '.' . $type if $type;
  $name = "latex.ltx" if $name eq "LaTeX.pool";
  $name = "plain.tex" if $name eq "TeX.pool";
  $dir = '.' unless $dir;

  if (my $cached = $CACHE{$class}{$name}) {
    return $cached; }

  my @paths = ();
  push(@paths, $dir);
  push(@paths, @{ $options{searchpaths} }) if $options{searchpaths};
  push(@paths, @{ $$classorself{searchpaths} }) if ref $classorself;

  my $self = bless { name => $name, %options, symbols => {}, includes => {}, searchpaths => [@paths] }, $class;
  $CACHE{$class}{$name} = $self;

  $self->scan;

  return $self; }

sub clone {
  my ($self) = @_;
  return bless {
    name          => $$self{name},
    declared_type => $$self{declared_type},
    declared_as   => $$self{declared_as},
    symbols       => { map { ($_ => 1) } keys %{ $$self{symbols} } },
    includes      => { map { ($_ => 1) } keys %{ $$self{includes} } },
    searchpaths   => [@{ $$self{searchpaths} }] }, ref $self; }

sub show {
  my ($self) = @_;
  my @syms = sort keys %{ $$self{symbols} };
  print "   Macros : " . (@syms ? join(', ', @syms) : "None") . "\n";
  return; }

# A variant of show that prints a compact signature (file:cs,...)
sub signature {
  my ($self) = @_;
  my @syms = keys %{ $$self{symbols} };
  print $$self{name} . ":" . ($$self{declared_as} || '') . ":" . join(',', sort @syms) . "\n";
  return; }

sub cleanup {
  my ($self, $include_inclusions, $include_internal) = @_;
  if ($include_inclusions) {
    $self->removeBase; }    # Remove at least Base
  else {
    $self->removeInclusions; }    # if not base and all other included
  $self->removeInternal unless $include_internal;
  return $self; }

# Convert any \foo, \endfoo combinations into {foo} an (assumed) environment.
sub convertEnvironments {
  my ($self) = @_;
  foreach my $cs (keys %{ $$self{symbols} }) {
    if ($cs =~ /^\\(.*)$/) {
      my $env   = $1;
      my $endcs = "\\end$env";
      if ($$self{symbols}{$endcs}) {
        $$self{symbols}{"{$env}"} = 1;
        delete $$self{symbols}{$cs};
        delete $$self{symbols}{$endcs}; } }
  }
  return; }

# Add any symbols defined in $package into the $self. Modifies $self!
sub add {
  my ($self, $package) = @_;
  print "Adding $$package{name} symbols to $$self{name}\n" if $::VERBOSITY >= 1;
  foreach my $cs (%{ $$package{symbols} }) {
    $$self{symbols}{$cs} = 1; }
  return $self; }

# Remove any symbols defined in $package from the $self.  Modifies $self!
sub subtract {
  my ($self, $package) = @_;
  print "Removing  $$package{name} symbols from $$self{name}\n" if $::VERBOSITY >= 1;
  foreach my $cs (%{ $$package{symbols} }) {
    delete $$self{symbols}{$cs}; }
  return $self; }

# Remove the contributions of any included packages.  Modifies $self!
sub removeInclusions {
  my ($self) = @_;
  foreach my $remove ($self->getBase, keys %{ $$self{includes} }) {
    if (my $pkg = $self->newInternal($remove)) {
      $self->subtract($pkg); } }
  return; }

# Remove the contributions of any base packages.  Modifies $self!
sub removeBase {
  my ($self) = @_;
  foreach my $remove ($self->getBase) {
    if (my $pkg = $self->newInternal($remove)) {
      $self->subtract($pkg); } }
  return; }

# Remove any "internal" symbols (those containing '@')
sub removeInternal {
  my ($self) = @_;
  foreach my $cs (keys %{ $$self{symbols} }) {
    delete $$self{symbols}{$cs} if $cs =~ /\@/; }
  return; }

# Return a list of packages that should be implicitly included.
sub getBase {
  my ($self) = @_;
  my @base = ();
  if ($::AMSTEX) {
    push(@base, "amstex.tex") if $$self{name} =~ /\.sty$/;
  }
  else {
    push(@base, "article.cls") if $$self{name} =~ /\.sty$/;
    push(@base, "latex.ltx")   if $$self{name} =~ /\.(sty|cls)$/;
  }
  return @base; }

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# StylePackage
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# A package scanned from a (La)TeX style/class file.
# The patterns may need more work;
# Some operations very sneakily end up defining symbols,
# which we'll miss if we don't work at it.
# We also scan any included files and include thier contributions.
# Of course, some definitions and inclusions are sufficiently
# indirect, via parameters or computed macros, that you would only
# know if you executed TeX.
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

package StylePackage;
use strict;
use LaTeXML::Util::Pathname;
use base qw(Package);

our $CSREGEXP;
our $ARGREGEXP;
our $BRACEREGEXP;
our $OPTREGEXP;

BEGIN {
  $CSREGEXP    = qr/(\\(?:[\w\@]+|.))/;
  $ARGREGEXP   = qr/(?:\{([^\}\#]+)\}|(\\(?:[\w\@]+|.)))/;
  $BRACEREGEXP = qr/\{([^\}\#]+)\}/;
  $OPTREGEXP   = qr/(\[[^\]]*\])?/; }

sub scan {
  my ($self) = @_;

  my $name = $$self{name};
  my $file = `kpsewhich $name`; chomp($file);
  if (!$file) {
    $file = pathname_find($name, paths => $$self{searchpaths}); }
  if (!$file) {
    print STDERR "WARN: No stylefile found for $name\n";
    return $self; }

  # Scan the stylefile for apparently defined symbols
  $self->scan_internal($file);

  # Many important inclusions are invoked with macros for arguments (eg art1\@ptsize.sty !)
  # We'll make a grudging attempt to rescan for possible assignments to
  # these macros (within the same stylefile!)
  # see ->noteInclusion for how rescanfor got set up.
  # NOTE Also, that some latex209 `classes' REQUIRE that certain options
  # (which will load files) are used and that these classes are incomplete without them!!!
  if ($$self{rescanfor}) {
    $self->rescan_internal($file); }

  # Remove trivial things that probably are just font declarations
  foreach my $sym (keys %{ $$self{symbols} }) {
    delete $$self{symbols}{$sym} if length($sym) == 1; }

  # Need to explicitly add contributes from included packages.
  foreach my $add (keys %{ $$self{includes} }) {
    if (my $pkg = $self->newInternal($add)) {
      $self->add($pkg);
      if (($add =~ /\.cls$/) && ($name =~ /\.cls$/) && !$$self{declared_as}) {
        $$self{declared_as}   = $$pkg{declared_as};
        $$self{declared_type} = $$pkg{declared_type}; } } }

  if ($name =~ /\.cls$/) {
    my $c = $$self{declared_as};
    my $t = $$self{declared_type};
    if (!$c) {
      print STDERR "WARN: $name not declared with \\ProvidesClass\n"; }
    elsif (("$c.cls" ne $name) || ($t ne 'Class')) {
      print STDERR "NOTE: $name declared as $t $c\n"; } }

  return $self; }

sub scan_internal {
  my ($self, $file) = @_;
  print "Scanning style of $$self{name} from $file\n" if $::VERBOSITY >= 1;
  my $STYLE_FH;
  open($STYLE_FH, '<', $file) or die "Couldn't open stylefile $file: $!";
  while (<$STYLE_FH>) {
    s/%.*$//;
    # Note that more than 1 "defn" can appear per line! so no "elsif"
    # Various standard definitions
    if (/\\(?:define|def|xdef|gdef|edef)\s*$CSREGEXP/o) {
      $$self{symbols}{$1} = 1; }
    if (/\\new(?:count|dimen|skip|muskip|box|help|toks|read|write|fam|language|insert)\s*$CSREGEXP/o) {
      $$self{symbols}{$1} = 1; }
    if (/\\newif\s*\\if([\w\@]+)/) {
      $$self{symbols}{"\\if$1"}      = 1;
      $$self{symbols}{"\\${1}true"}  = 1;
      $$self{symbols}{"\\${1}false"} = 1; }
    if (/\\(?:renew|new|provide)command\s*\*?\s*$ARGREGEXP/o) {
      $$self{symbols}{ $1 || $2 } = 1; }
    if (/\\(?:Declare|Provide)(?:TextFont|Text|Robust)Command(?:Default)?\s*\*?\s*$ARGREGEXP/o) {
      $$self{symbols}{ $1 || $2 } = 1; }
    if (/\\let$CSREGEXP\s*=?\s*$CSREGEXP/o) {
      $$self{symbols}{$1} = 1; }
    # Defining math/text symbols
    if (/\\DeclareMath(?:Symbol|Accent|Delimiter)\s*$ARGREGEXP/o) {
      $$self{symbols}{ (defined $1 ? $1 : $2) } = 1; }
    if (/\\re\@DeclareMath(?:Symbol|Accent|Delimiter)\s*$ARGREGEXP/o) {    # txfonts
      $$self{symbols}{ (defined $1 ? $1 : $2) } = 1; }
    # Other packages used.
    if (/\\(?:usepackage|RequirePackage)\s*$OPTREGEXP\s*$BRACEREGEXP/o) {
      map { $self->noteInclusion($_, 'sty') } split(/,/, $2); }
    if (/\\(?:LoadClassWithOptions|LoadClass)\s*$OPTREGEXP\s*$BRACEREGEXP/o) {
      $self->noteInclusion($2, 'cls'); }
    if (/\\(?:input|InputIfFileExists)\s*$BRACEREGEXP/o) {
      $self->noteInclusion($1 || $2); }
    elsif (/\\(?:input)\s+(.*?)(?:\s|\\relax|}|$)/o) {
      $self->noteInclusion($1); }
    # DLMF functions
    if (/\\defSpecFun$ARGREGEXP/) {
      $$self{symbols}{"\\$1"} = 1; }
    # Environments
    if (/\\(?:re)?newenvironment\s*\*?\s*$BRACEREGEXP/o) {
      $$self{symbols}{ "\\" . $1 }    = 1;
      $$self{symbols}{ "\\end" . $1 } = 1; }
    # Other signifcant declarations
    if (/\\Provides(Class|Package)\s*$BRACEREGEXP/o) {
      $$self{declared_type} = $1;
      $$self{declared_as}   = $2; }
    if (/\\(?:include|exclude)comment$ARGREGEXP/) {
      $$self{symbols}{ "\\" . $1 }    = 1;
      $$self{symbols}{ "\\end" . $1 } = 1; }
  }
  close($STYLE_FH);
  return; }

sub noteInclusion {
  my ($self, $file, $defaulttype) = @_;
  $file =~ s/^\s+//; $file =~ s/\s+$//;
  my ($dir, $name, $type) = pathname_split($file);
  $type = $defaulttype unless $type;
  $name .= '.' . $type if $type;
  return if $name eq $$self{name};
  $name =~ s/1?\\\@ptsize/10/;
  if ($name =~ /^([^\\]*)\\([a-zA-Z\@]+)([^\\]*)$/) {    # Ugh...
    $$self{rescanfor}{$2} = [$1, $3]; }
  elsif ($name =~ /(?:\\|#)/) { }                        # just skip it if too hard or unknowable
  else {
    $$self{includes}{$name} = 1; }
  return; }

sub rescan_internal {
  my ($self, $file) = @_;
  my $rescan = '(' . join('|', map { $_ } keys %{ $$self{rescanfor} }) . ')';
  my $STYLE_FH;
  open($STYLE_FH, '<', $file) or die "Couldn't open stylefile $file: $!";
  while (<$STYLE_FH>) {
    s/%.*$//;
    # Line defines one of the indirection macros, so reconstruct the likely file to be input.
    if (/\\(?:def|xdef|gdef|edef|newcommand|renewcommand)\s*\\$rescan\s*\{(\w+)\}/) {
      my ($pre, $post) = @{ $$self{rescanfor}{$1} };
      my $inclusion = $pre . $2 . $post;
      $self->noteInclusion($inclusion); } }
  close($STYLE_FH);
  return; }

# Generate a stub implementation for a given package.

our $STUB_HEADER;
# NOTE: Rearrange this so that the base packages are ALWAYS loaded (?)
# and inclusions only if they actually contribute something?
sub generateStub {
  my ($self, $base) = @_;
  my $dest = $$self{name} . ".ltxml";
  # Copy any existing file to *.bak --- but ONLY if there isn't already a bak!
  if ((-f $dest) && !(-f "$dest.bak")) {
    rename $dest, "$dest.bak" or die "Couldn't rename $dest to $dest.bak: $!";
    print "Saved previous $dest to $dest.bak\n"; }
  my $STUB_FH;
  open($STUB_FH, '>', $dest) or die "Couldn't open '$dest' for writing: $!";

  my %inc  = %{ $$self{includes} };
  my @base = split(/,/, $base);
  my %base = ($base ? map { ($_ => 1) } @base : ());

  $self->removeBase;
  $self->removeInternal unless $internal;

  my $header = $STUB_HEADER;
  my $headername = $$self{name} . (' ' x (68 - length($$self{name}))) . "| #";
  $header =~ s/BINDINGNAME/$headername/;
  print $STUB_FH $header;

  # get unique classes, starting with those in $base
  my @classes = ((grep { /\.cls$/ } keys %base), (grep { /\.cls$/ && !$base{$_} } keys %inc));
  if (($$self{name} =~ /\.sty$/) && @classes) {
    print STDERR "WARN: Ignoring class file used in style file $$self{name}: " . join(', ', @classes) . "\n";
    @classes = (); }
  elsif (@classes > 1) {
    print STDERR "WARN: Ignoring excess classes for $$self{name}: " . join(', ', @classes[1 .. $#classes]) . "\n";
    @classes = ($classes[0]); }
  if (@classes) {
    my $c = $classes[0]; $c =~ s/\.cls$//;
    print $STUB_FH "LoadClass('$c',withoptions=>1);\n";
    $self->subtract($self->new($classes[0])); }

  # The process inclusions starting with $base, then the actual package's inclusions
  # But only include the ones that have an "effect".
  foreach my $pkg (@base, grep { /\.sty$/ } keys %inc) {
    my $nbefore = scalar(keys %{ $$self{symbols} });
    my $package = $self->new($pkg);
    $package->removeBase;    #?
    $self->subtract($package);
    my $p = $pkg; $p =~ s/\.sty$//;
    my $nafter = scalar(keys %{ $$self{symbols} });
    if ($nbefore > $nafter) {
      if ($base{$pkg}) {
        print $STUB_FH "RequirePackage('$p',withoptions=>1);\n"; }
      else {
        print $STUB_FH "RequirePackage('$p');\n"; } }
    else {
      print $STUB_FH "# No effect from $pkg\n"; } }

  $self->convertEnvironments;
  my @syms = sort keys %{ $$self{symbols} };
  if (@syms) {
    printStubComments($STUB_FH, "-",
      "INCOMPLETE IMPLEMENTATION",
      "remove this comment, when done.",
      "Drafted by texscan --stub" . ($base ? " --base=$base" : '') . ' ' . $$self{name},
      "-");
    foreach my $sym (@syms) {
      if ($sym =~ /^\{.*\}$/) {
        print $STUB_FH "# DefEnvironment('$sym','#body');\n"; }
      else {
        print $STUB_FH "# DefMacro('$sym',Tokens());\n"; } } }

  print $STUB_FH "#" . ("=" x 70) . "\n1;\n";
  close($STUB_FH);

  print "Wrote binding of $$self{name} to $dest\n";
  print "NOTE: Please edit to complete " . scalar(@syms) . " definitions.\n" if @syms;
  return; }

BEGIN {
  $STUB_HEADER = <<'EOHeader';
# -*- mode: Perl -*-
# /=====================================================================\ #
# | BINDINGNAME
# | Implementation for LaTeXML                                          | #
# |=====================================================================| #
# | Part of LaTeXML:                                                    | #
# |  Public domain software, produced as part of work done by the       | #
# |  United States Government & not subject to copyright in the US.     | #
# |---------------------------------------------------------------------| #
# | Bruce Miller <bruce.miller@nist.gov>                        #_#     | #
# | http://dlmf.nist.gov/LaTeXML/                              (o o)    | #
# \=========================================================ooo==U==ooo=/ #
package LaTeXML::Package::Pool;
use strict;
use warnings;
use LaTeXML::Package;

#======================================================================
EOHeader
}

sub printStubComments {
  my ($out, @lines) = @_;
  my $LENGTH = 70;
  my $N      = scalar(@lines);
  for (my $i = 0 ; $i < $N ; $i++) {
    my $line = $lines[$i];
    if ($line =~ /^[-_=%\*#]$/) {
      print $out "# "
        . ($i == 0 ? " /" : ($i == $N - 1 ? " \\" : " >"))
        . ($line x ($LENGTH - 2))
        . ($i == 0 ? "\\" : ($i == $N - 1 ? "/" : "<")) . "\n"; }
    else {
      my $n = $LENGTH - length($line) - 1;
      print $out "# | " . $line . (' ' x $n) . "|\n"; } }
  return; }

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# ImplementationPackage
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# A package scanned from a LaTeXML implementation.
# This gets its list of symbols by loading the package into LaTeXML,
# and then extracting all defined symbols from the STATE table.
# In order to be able to load the package, TeX.pool and LaTeX.pool
# must be loadd, and by executing the laod, any included packages
# are automatically included (ie. it is automatically cumulative)
# To compute the non-cumulative list takes more work:
# We must find all included packages, load them, and subtract them.
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

package ImplementationPackage;
use strict;
use base qw(Package);
use LaTeXML::Core;
use LaTeXML::Global;
use LaTeXML::Util::Pathname;

sub scan {
  my ($self) = @_;
  my $name = $$self{name};
  print "Loading $name into LaTeXML\n" if $::VERBOSITY >= 1;
  my $latexml = LaTeXML::Core->new(searchpaths => ($$self{searchpaths} || []), verbosity => $::VERBOSITY - 1);
  $latexml->withState(sub {
      my $stomach = $STATE->getStomach;    # The current Stomach;
      my $gullet  = $stomach->getGullet;
      $stomach->initialize;
      my $paths = $STATE->lookupValue('SEARCHPATHS');

      my @pkgs = ("TeX.pool");
      if ($::AMSTEX) {
        push(@pkgs, "amstex.tex") if $$self{name} =~ /\.sty$/; }
      elsif ($name eq 'plain.tex') { }
      else {
        push(@pkgs, "LaTeX.pool");
        push(@pkgs, "article.cls") unless $name =~ /\.(cls|ltx)$/;
      }
      push(@pkgs, $name) unless $name eq 'latex.ltx';
      ## Since we're mucking with STATE, we'll reload, BUT we'll get redefinitions;
      ## We'd really rather not get all the warnings, though!!
      #### These didn't work;
      #### no warnings;
      #### local $^W = 0;
      # Try Deyan's heavier hammer!
      foreach my $subname (keys %LaTeXML::Package::Pool::) {
        undef $LaTeXML::Package::Pool::{$subname};
        delete $LaTeXML::Package::Pool::{$subname}; }

      foreach my $pkg (@pkgs) {
        my $loadpath = pathname_find("$pkg.ltxml", paths => $paths, installation_subdir => 'Package');
        if (!$loadpath) {
          if ($pkg =~ /(.*)\.cls$/) {
            print STDERR "WARN: Couldn't find LaTeXML implementation for $pkg; using article.cls\n";
            LaTeXML::Package::LoadClass('article'); }
          else {
            print STDERR "WARN: Couldn't find LaTeXML implementation for $pkg\n";
            return; } }
        if    ($pkg =~ /(.*)\.pool$/) { LaTeXML::Package::LoadPool($1); }
        elsif ($pkg =~ /(.*)\.sty$/)  { LaTeXML::Package::RequirePackage($1); }
        elsif ($pkg =~ /(.*)\.cls$/)  { LaTeXML::Package::LoadClass($1); }
        else { LaTeXML::Package::InputDefinitions($loadpath); } }

      print "Scanning defined symbols\n" if $::VERBOSITY >= 1;
      my $table = $$STATE{meaning};
      foreach my $entry (keys %{$table}) {
        if ($entry =~ /^\\begin\{(.*?)\}$/) {
          $$self{symbols}{ "\\" . $1 } = 1; }
        elsif ($entry =~ /^\\end\{(.*?)\}$/) {
          $$self{symbols}{ "\\end" . $1 } = 1; }
        elsif ($entry =~ /^(\\.*)$/) {
          $$self{symbols}{$1} = 1; }
        elsif ($entry =~ /^(.*)\.ltxml_loaded$/) {
          my $inc = $1;
          $$self{includes}{$inc} = 1 unless ($inc eq $name) || $inc =~ /\\/; } } });
  return $self; }

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

__END__

=head1 NAME

C<texscan> I<options> I<stylefile> ...

=head1 SYNOPSIS

texscan [options] styles

texscan scans (La)TeX class or style files or LaTeXML implementation files
for control sequences that are defined defined. The options
C<--tex>, C<--latexml>, C<--diff>, C<--signature>, C<--stub>
specify what to do with the symbol lists.

NOTE: You generally have to specify the style with explicit .sty

Options:

  --tex         Show the symbols defined in a (La)TeX package or class.
  --latexml     Show the symbols defined in a LaTeXML implementation.
  --diff        Show the symbols missing from a LaTeXML implementation.
  --signature   Generate a signature of a (La)TeX package. (see C<cluster>)
  --stub        Generate a stub implementation of a (La)TeX package.
  --all         Scan all implementation files.

  --internal    Include internal symbols (including '@'), default no.
  --nointernal  Don't include internal symbols
  --cumulative  Include the definitions from included files.
  --nocumulative Don't include symbols defined in included files.
  --amstex      process in amstex mode (no LaTeX or article assumed)
  --path=dir    Add dir to the list of paths to search for files.
  --base=names  comma separated list of base packages for --stub
                these are included in the code whether or not they
                were loaded from the style file.
  --help        Shows this help message.
  --quiet       Runs more quietly
  --verbose     Runs more noisily

=head1 Scanning

Scanning of TeX files uses a variety of regular expressions to
recognize all control sequences that are (or might be) defined.
Any included files (\usepackage, \LoadClass, etc) are also scanned
and added. 

Scanning of LaTeXML files is done by loading the the implementation
file into a C<LaTeXML> object and scanning for any symbols that
are bound in the C<State> object. 

The base LaTeX file C<latex.ltx> (and its inclusions)
is considered to be implicitly included by all style (C<*.sty>)
and class files (C<*.cls>),
whereas C<article.cls> (and its inclusions) are considered to
be included by all style files (C<*.sty>).
However, these are removed before display, even when cumulative.

Inclusions are removed unless cumulative is requested.
The default is non-cumulative, except for C<--signature>,
which removes only the base inclusions (C<latex.ltx> and C<article.cls>).

Internal symbols (containing a C<@>) are removed unless
internal is requested. The default excludes internal symbols.

=head1 Stub implementations

texscan with option C<--tex> lists what control sequences are
defined in a given style file. With option C<--diff>, it lists
which control sequences are defined in the TeX style file, but
missing from the LaTeXML implementation.  As a convenience,
using the option C<--stub> can be used to generate an initial
implementation for the package. In most cases, this will still
need to be editted to be complete and useful, however.

A command such as

   texscan --stub --base=article.cls,graphicx.sty foo.sty bar.sty baz.sty

will create stub LaTeXML implementations for C<foo.sty.ltxml>,...,
consisting of commands to load the classes or styles in C<--base>.
Then commands are generated for any remaining inclusions
in the source file, provided they contribute anything
(after having removed the affect of previously loaded packages).
Finally, commented-out definitions are generated for any remaining
control sequences defined by in C<foo.sty>.

=head1 Bugs

The set of regular expressions used to scan TeX files is
undoubtedly incomplete. Since both definitions and inclusions
can also be effected at run time (eg. by passing or constructing
the symbol to define), such symbols are also missed.

The symbols scanned from a TeX file include any symbol that
may end up defined only within certain contexts, whereas
the LaTeXML scan includes only symbols that are defined globally.

For all these reasons, both lists and comparisons of defined symbols
can have differences that are not significant.  The results
of texscan thus require supervision with at least minimal
understanding of the style files involved.

Additionally, in its current form, C<texscan> knows nothing
about the intended parameters for any control sequences.

=cut