#!/usr/bin/env perl
# $Id: txicmdcheck,v 1.8 2012/12/14 18:57:42 karl Exp $
# Copyright 2008, 2011, 2012 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 command lists in refcard vs. refman vs.
# tp for consistency.
exit (&main ());
sub main {
my $no_common = $ARGV[0] eq "--no-common";
my @card_cmds = &read_refcard ("txirefcard.tex");
my @man_cmds = &read_refman ("../texinfo.txi");
my @tp_cmds = &read_tp ("../../util/txicmdlist");
# perhaps we should check against the manual's fnindex too.
my (%card_cmds, %man_cmds, %tp_cmds);
@card_cmds{@card_cmds} = ();
@man_cmds{@man_cmds} = ();
@tp_cmds{@tp_cmds} = ();
my @found = ();
for my $cc (@card_cmds) {
if (exists $man_cmds{$cc} && exists $tp_cmds{$cc}) {
push (@found, $cc);
delete $man_cmds{$cc};
delete $card_cmds{$cc};
delete $tp_cmds{$cc};
}
}
printf (" common %d: @{[sort @found]}\n", @found + 0)
unless $no_common;
my @card_only = keys %card_cmds;
printf "refcard only %s: @{[sort @card_only]}\n", @card_only + 0;
my @man_only = keys %man_cmds;
printf "refman only %s: @{[sort @man_only]}\n", @man_only + 0;
my @tp_only = keys %tp_cmds;
printf "tp only %s: @{[sort @tp_only]}\n", @tp_only + 0;
return @card_only + @man_only + @tp_only;
}
# Return command names from the reference card.
#
sub read_refcard {
my ($fname) = @_;
my @ret = ();
local *FILE;
$FILE = $fname;
open (FILE) || die "open($FILE) failed: $!";
while (<FILE>) {
next unless /^\\txicmd/;
chomp;
my $xcmd = 0;
s/\\txicmdarg{.*?}}?//; # first get rid of the arguments
s/}{.*//; # then the descriptions
s/^\\txicmdx{// && ($xcmd = 1); # used for the @def...x
s/^\\txicmd{//; # finally the markup cmd itself
s/\\ttbraced{}//g; # quote cmd list
my (@cmds) = split (/,? +/, $_); # occasionally we combine cmds
# we typeset these specially in TeX.
if ("@cmds" eq "@#1footing") {
@cmds = ('@oddfooting', '@evenfooting', '@everyfooting');
} elsif ("@cmds" eq "@#1heading") {
@cmds = ('@oddheading', '@evenheading', '@everyheading');
}
# add each command from this line to the return.
for my $c (@cmds) {
#warn "refcard $c\n";
#warn "refcard $c{x}\n" if $xcmd;
next if $c eq "txicommandconditionals"; # variable not separate in manual
if ($c eq '@\tildechar') { # TeX specialties, forcibly make them match
$c = '@~';
} elsif ($c eq '@\var{whitespace}') {
$c = '@var{whitespace}';
}
$c = '@~' if $c eq '@\tildechar'; # TeX
$c = '@\\' if $c eq '@\bschar'; # TeX
$c = '@{' if $c eq '@\lbracechar'; # TeX
$c = '@}' if $c eq '@\rbracechar'; # TeX
push (@ret, $c);
push (@ret, "${c}x") if $xcmd;
}
}
push (@ret, '@end', '@uref', '@appendixsection'); # described in text
push (@ret, '@,'); # our non-parsing above lost these
push (@ret, qw(@atchar @lbracechar @rbracechar @backslashchar));
close (FILE) || warn "close($FILE) failed: $!";
return @ret;
}
# Return command names from the @-Command List
# node in the reference manual.
#
sub read_refman {
my ($fname) = @_;
my @ret = ();
local *FILE;
$FILE = $fname;
open (FILE) || die "open($FILE) failed: $!";
while (<FILE>) {
last if /^\@appendix \@\@-Command List/; # ignore until right appendix
}
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
push (@ret, $_);
}
push (@ret, '@{'); # our non-parsing above fails on this one
close (FILE) || warn "close($FILE) failed: $!";
return @ret;
}
# Return command names implemented in the general parser.
# The argument is the command to run to return the list.
#
sub read_tp {
my ($prog) = @_;
my @ret = ();
local *FILE;
$FILE = "$prog |";
open (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 $_ =~ /allow-recursion
|columnfractions
|cropmarks
|ctrl
|(even|every|odd)(foot|head)ingmarks
|quote-arg
|rmacro
|shorttitle$
|\|
/x;
push (@ret, $_);
}
close (FILE) || warn "close($FILE) failed: $!";
push (@ret, '@var{whitespace}');
return @ret;
}