#!/usr/bin/env perl
# $Id$
# Copyright 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015
# 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 %idx_cmds = &read_refidx ("../texinfo.texi");
my %man_cmds = &read_refman ("../texinfo.texi");
my %tp_cmds = &read_tp ("../../util/txicmdlist");
# find the commands that are covered everywhere.
my @found = ();
for my $cc (keys %card_cmds) {
if (exists $idx_cmds{$cc}
&& exists $man_cmds{$cc}
&& exists $tp_cmds{$cc}) {
push (@found, $cc);
delete $card_cmds{$cc};
delete $idx_cmds{$cc};
delete $man_cmds{$cc};
delete $tp_cmds{$cc};
}
}
printf (" common %d: @{[sort @found]}\n", @found + 0)
unless $no_common;
# there are numerous @findex entries which are not @-commands, which
# can be seen this way:
#my @idx_only = keys %idx_cmds;
#printf "findex only %s: @{[sort @idx_only]}\n", @idx_only + 0;
#
# 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 %card_cmds) {
if (exists $man_cmds{$cc} && exists $tp_cmds{$cc}) {
push (@idx_missing, $cc);
delete $card_cmds{$cc};
delete $man_cmds{$cc};
delete $tp_cmds{$cc};
}
}
printf "findex missing %s: @idx_missing\n", @idx_missing + 0
if @idx_missing;
# now report on commands only in some other subset.
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 as the keys of a hash
# (with empty values). In principle it's a list, but as a practical
# matter we want to work with a hash anyway, so we might as well return
# it that way in the first place. (Ditto for the other functions.)
#
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
$c = '@&' if $c eq '@\&'; # 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 @ampchar @lbracechar @rbracechar @backslashchar));
close (FILE) || warn "close($FILE) failed: $!";
my %ret; @ret{@ret} = ();
return %ret;
}
# 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;
$FILE = $fname;
open (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/^/\@/ unless /^\@/; # prepend @ unless already there (@@ @{ @})
push (@ret, $_);
}
close (FILE) || warn "close($FILE) failed: $!";
my %ret; @ret{@ret} = ();
return %ret;
}
# Return command names from the @-Command List node in the reference
# manual as the keys of a hash (empty values).
#
sub read_refman {
my ($fname) = @_;
my @ret = ();
local *FILE;
$FILE = $fname;
open (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
push (@ret, $_);
}
push (@ret, '@{'); # our non-parsing above fails on this one
close (FILE) || warn "close($FILE) failed: $!";
my %ret; @ret{@ret} = ();
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_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
|set(short)?contentsaftertitlepage
|shorttitle$
|\|
/x;
push (@ret, $_);
}
close (FILE) || warn "close($FILE) failed: $!";
push (@ret, '@var{whitespace}');
my %ret; @ret{@ret} = ();
return %ret;
}