texinfo/doc/refcard/txivarcheck

#!/usr/bin/env perl
# $Id$
# Copyright 2012, 2013, 2016 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 <http://www.gnu.org/licenses/>.
#
# Original author: Karl Berry.
# 
# Kludge of a script to check customization variables in refman vs. tp
# for consistency.  Although this has nothing to do with the reference
# card, since it's similar to the txicmdcheck script, keep them
# together.  And maybe we'll add the cust.vars to the refcard.

exit (&main ());

sub main {
  my $no_common = $ARGV[0] eq "--no-common";
  
  my @man_vars = &read_refman ("../texinfo.texi");
  my @tp_vars = &read_tp ("../../util/txicustomvars");

  my (%man_vars, %tp_vars);  # list to hash
  @man_vars{@man_vars} = ();
  @tp_vars{@tp_vars} = ();

  my @found = ();
  for my $name (@tp_vars) {
    if (exists $man_vars{$name}) {
      push (@found, $name);
      delete $man_vars{$name};
      delete $tp_vars{$name};
    }
  }
  
  printf ("common %3d: @{[sort @found]}\n", @found + 0)
    unless $no_common;

  # we can't reasonly reduce the list of variable names only in the
  # manual to null, since the manual necessarily includes many non-variables.
  # 
  my @man_only = keys %man_vars;
  printf "man only %2s: @{[sort @man_only]}\n", @man_only + 0;

  my @tp_only = keys %tp_vars;
  printf "tp only %2s: @{[sort @tp_only]}\n", @tp_only + 0;
  
  return @tp_only;
}



# Return customization variable names from the section in the reference
# manual.  We assume their names are all uppercase, to avoid returning
# numerous non-variables.
# 
sub read_refman {
  my ($fname) = @_;
  my @ret = ();

  local *FILE;
  $FILE = $fname;
  open (FILE) || die "open($FILE) failed: $!";

  # since we have to look at generic commands like @item, at least
  # ignore until right section to reduce chance of false matches.
  while (<FILE>) {
    last if /^\@section Customization Variables$/;
  }

  while (<FILE>) {
    if (/^\@node Customization Variables for \@\@/) {
      # in this node we have a bare of bare @-commands which have cust.vars.
      while (<FILE>) {
        last if /^\@smallexample/;
      }
      my $atcmds = "";
      while (<FILE>) {
        last if /^\@end smallexample/;
        s/\@\@//g;  # the variable names don't start with @
        $atcmds .= $_;
      }
      # done with special node.
      my @atcmds = split (" ", $atcmds);
      push (@ret, @atcmds);      
      next;
    }
    
    # Stop looking for cust.var names after those nodes are done.
    last if /^\@node Internationalization of Document Strings/;
    
    # Otherwise, we're looking at a line in one of the cust.var
    # documentation nodes.
    next unless s/^\@(itemx?|vindex) *//;  # look for item[x]s and vindex
    next unless /^[A-Z0-9_]+$/;            # uppercase only
    
    chomp;
    push (@ret, $_);
  }

  close (FILE) || warn "close($FILE) failed: $!";
  return @ret;
}


# Return customization variable names implemented in the general parser.
# The argument is the command to run which returns the list.
#
sub read_tp {
  my ($prog) = @_;
  my @ret = ();
  
  local *FILE;
  $FILE = "$prog |";
  open (FILE) || die "open($FILE) failed: $!";
  while (<FILE>) {
    chomp;
    my ($var,$where) = split (/\t/);
    next if ($where eq 'variable_other_settables'
             || $where eq 'parser_options');
    next if $var eq "OUTPUT_PERL_ENCODING";  # not for users
    next if $var eq "HTMLXREF";  # not documented
    
    # these are documented, but their lowercase names don't match
    # everything 
    #next if $var =~ /^(even|every|odd)(heading|footing)$/; 
    push (@ret, $var);
  }
  close (FILE) || warn "close($FILE) failed: $!";  
  
  return @ret;
}