doc/txicmdcheck

#!/usr/bin/env perl
# Copyright 2008-2026 Free Software Foundation, Inc.
#
# 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 3 of the License,
# or (at your option) any later version.
#
# 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.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <https://www.gnu.org/licenses/>.
#
# Original author: Karl Berry.
#
# Kludge of a script to check command lists in appendix vs. texi2any
# for consistency.

use strict;

my $srcdir = $ENV{'srcdir'};
$srcdir = '.' if (!defined($srcdir));

exit (&main ());

sub main {
  my $no_common = $ARGV[0] eq "--no-common";

  my %idx_cmds = &read_refidx ("$srcdir/texinfo.texi");
  my %man_cmds = &read_appendix ("$srcdir/texinfo.texi");
  my %t2a_cmds = &read_cmds ("$srcdir/../util/txicmdlist");

  # find the commands that are covered everywhere.
  my @found = ();
  for my $cc (keys %idx_cmds) {
    if (exists $man_cmds{$cc}
        && exists $t2a_cmds{$cc}) {
      push (@found, $cc);
      delete $man_cmds{$cc};
      delete $t2a_cmds{$cc};
    }
  }

  printf ("    common %d: @{[sort @found]}\n", scalar(@found))
    unless $no_common;

  # there are numerous @findex entries which are not @-commands, which
  # can be seen this way:
  #my @findex_only = sort(keys(%idx_cmds));
  #printf "findex  only %d: ".join('|',@findex_only)."\n", scalar(@findex_only);
  #
  # let's not report those, but we do want to report normal commands that
  # did not have findex entries: those which are present in all the
  # other lists.

  my @idx_missing = ();
  for my $cc (sort keys %man_cmds) {
    if (exists $t2a_cmds{$cc}) {
      push (@idx_missing, $cc);
      delete $man_cmds{$cc};
      delete $t2a_cmds{$cc};
    }
  }
  printf "findex missing %d: @idx_missing\n", scalar(@idx_missing)
     if (scalar(@idx_missing));

  # now report on commands only in some other subset.
  my @man_only = sort(keys(%man_cmds));
  printf "appendix only %d: @man_only\n", scalar(@man_only);

  my @t2a_only = sort(keys(%t2a_cmds));
  printf "texi2any only %d: @t2a_only\n", scalar(@t2a_only);

  return scalar(@man_only) + scalar(@t2a_only);
}


# Return command names from @findex entries in the reference manual as
# the keys of a hash (empty values).
#
sub read_refidx {
  my ($fname) = @_;
  my %ret = ();

  local *FILE;
  my $FILE = $fname;
  open (FILE, $FILE) || die "open($FILE) failed: $!";
  while (<FILE>) {
    next unless s/^\@findex\s+//; # only consider @findex lines
    chomp;
    s/\s+\@r.*$//;# if /^[^a-zA-Z]/;        # remove comment
    s/\@\{\@\}//;         # remove @{@} used in atchar, etc.
    s/<colon>/:/;         # @:
    s/<newline>/var{whitespace}/;  # special generic entry: @var{whitespace}
    s/\s*\@sortas{[^}]+}\s*//;  # remove @sortas
    s/^/\@/ unless /^\@/; # prepend @ unless already there (@@ @{ @})
    $ret{$_} = 1;
  }
  close (FILE) || warn "close($FILE) failed: $!";

  return %ret;
}


# Return command names from the @-Command List node in the reference
# manual as the keys of a hash (empty values).
#
sub read_appendix {
  my ($fname) = @_;
  my %ret = ();

  local *FILE;
  my $FILE = $fname;
  open (FILE, $FILE) || die "open($FILE) failed: $!";
  while (<FILE>) {
    last if /^\@section \@\@-Command List/;  # ignore until right section
  }
  while (<FILE>) {
    last if /^\@end table/; # ignore again after the summary
    next unless s/^\@itemx? *\@//;  # only want item[x]s in the table
    chomp;
    s/\@\{.+//;  # remove braced arguments (but not @{)
    s/ .*//;     # remove arguments following a space
    s/\@\@/@/g;  # @@ -> @
    next if $_ =~ /^\@(br|ctrl)$/;  # @ignore-d in text
    $ret{$_} = 1;
  }
  $ret{'@{'} = 1; # our non-parsing above fails on this one
  close (FILE) || warn "close($FILE) failed: $!";

  return %ret;
}


# Return command names implemented in the general parser as the keys of
# a hash (empty values).  The argument is the command to run to return
# the list.
#
sub read_cmds {
  my ($prog) = @_;
  my %ret = ();

  local *FILE;
  my $FILE = "$prog |";
  open (FILE, $FILE) || die "open($FILE) failed: $!";
  while (<FILE>) {
    chomp;
    # excise @<whitespace> commands from normal list.
    next if $_ eq '@ ' || $_ eq "\@\t" || $_ eq "" || $_ eq '@';

    # obsolete and/or subsidiary commands we don't want to document as usual.
    next if $_ =~ /columnfractions
                   |(even|every|odd)(foot|head)ingmarks
                   |rmacro
                   |refill
                   |item_LINE
                   |^\@..index
                   |\|
                  /x;
    $ret{$_} = 1;
  }
  close (FILE) || warn "close($FILE) failed: $!";

  $ret{'@var{whitespace}'} = 1;

  return %ret;
}