#!/usr/bin/perl
# Copyright (c) 2002 Felix Rosencrantz
#
# Information about this tool can be found at:
# http://www.geocities.com/f_rosencrantz/xml_completion.htm
#
# This script is designed to take command help output and generate an XML
# version that can be converted to completion function for zsh. Potentially
# other useful things could be generated (e.g. bash,tcsh completion code).
#use warnings; Used for debugging
#require Data::Dumper; Used for debugging
use Getopt::Long;
## Define command line options
my $usage = 0,$multiple = 0, $command = '', $single_char_flags = 0;
my $unique_args = 0, $no_args=0, $pyx = 0;
my (@m_array, @x_array, @p_array, @args);
my %options = (
"c" => \$command,
"m" => \$multiple,
"x" => \@x_array,
"M" => \@m_array,
"u" => \$usage,
"p" => \@p_array,
"S" => \$single_char_flags,
"n" => \$unique_args,
"a" => \@args,
"A" => \$no_args,
"pyx" => \$pyx,
);
my $cmdline = join(" ",@ARGV);
## Parse command line options
Getopt::Long::Configure("no_ignore_case");
GetOptions(\%options, "c|command=s", "u|usage", "m|multiple+","M|multiple-flags=s@","x|exclusion-set=s@","p|prefix-flags=s@","S|single-char-flags","n|unique-args", "a|args=s@", "pyx") || &usage();
&usage() if ($usage);
# Create a function that performs flag prefix parsing.
&create_handle_prefix();
#Generate information PYX format, which can be easily converted to XML.
&open_pyx();
#Generate the header
&send_pyx("(command\n");
&send_pyx("Acommand $command\n");
&send_pyx("Amultiple true\n") if $multiple;
# Read the help/usage information
$order = 0;
while (<>)
{
#The extract_flag sub extracts information about a flag.
my $flag_hash = &extract_flag($_);
my $flag = $flag_hash->{flag};
my $flag2 = "";
# Sometimes a flag has an alias, flag2
$flag2 = $flag_hash->{flag2} if (defined $flag_hash->{flag2});
next if (!defined $flag || $flag eq "");
#Add the flag (and it's alias)
&add_flag($flag,$flag_hash);
&add_flag($flag2,$flag_hash) if (defined $flag2 && $flag2 ne "");
}
#Record if a flag can be used more than once.
#Each element of m_array is the argument to -M flag on the command line.
# So each element is a comma separated list of flags that should be marked
# as being allowed multiple times.
foreach my $flagset (@m_array)
{
my @parts = ();
if ($flagset =~ m#,#)
{
@parts = split(/,/,$flagset);
}
else
{
@parts = ($flagset)
}
foreach $flag (@parts)
{
$flags{$flag}{multiple} = 1 if defined $flags{$flag};
}
}
#Handle command line specified exclusion lists.
#Each element of the x_array is the argument to the -x flag on the command line.
#So each element is a comma separated list of flags that should be mutually
#exclusive.
foreach my $e_list (@x_array)
{
my @parts= split(/,/,$e_list);
my %list;
foreach my $p (@parts)
{
next if $p eq ""; # Get ride of empty flags caused by split command.
$list{$p} = 1;
#If a flag has a sameas alias, then the alias is also excluded.
$list{$flags{$p}{f}[0]{sameas}} = 1
if (defined $flags{$p}{f}[0]{sameas}
&& $flags{$p}{multiple} != 1);
}
foreach my $k (keys %list)
{
my $ex_set = "";
$ex_set=$flags{$k}{exclusionlist} if defined $flags{$k}{exclusionlist};
my @set = grep(!(/^$k$/ || /^$/) ,keys %list,$ex_set);
foreach my $f (@set)
{
$flags{$k}{exclusionlist} .= $f . " ";
}
}
}
#Automatically Generate exclusion lists for sameas aliases.
#If a flag is allowed multiple times, then no exclusion list is generated.
foreach my $k (keys %flags)
{
next if $multiple; #All flags are allowed multiple times. (should hoist)
next if defined $flags{$k}{exclusionlist}; #Already handled above.
next if defined $flags{$k}{multiple} && $flags{$k}{multiple};
if (defined $flags{$k}{f}[0]{sameas})
{
$flags{$k}{exclusionlist} .= "$flags{$k}{f}[0]{sameas}";
}
}
#Fix up %flags.
# Figure out if a flag is listed more than once, which we assume means
# fixed strings.
# Figure other things.
foreach $flag (keys %flags)
{
# We have fixed strings.
if ($#{$flags{$flag}{f}} > 0)
{
my $parts = ${flags{$flag}{f}};
#print Data::Dumper::Dumper($parts),"\n"; #lll
if (! defined ${$$parts[0]}{tag})
{
# We should have a tag with multiple lines...
# print STDERR "Flag ($flag): seems not to have a tag...\n";
}
foreach my $option (@$parts)
{
$flags{$flag}{fixedstrings} .= "$$option{tag}:$$option{taghelp} ";
}
}
else
{
#We have only one information tag on this flag, save the information
# at the top level of the entry. (We should probably do something
# like this above... possible bug)
my $info = $flags{$flag}{f}[0];
foreach $key (keys %$info)
{
${$flags{$flag}}{$key} = $$info{$key};
}
}
}
foreach $flag (sort by_flag_order keys %flags)
{
&send_pyx("(flag\n");
&send_pyx("Aname $flag\n");
&send_pyx("Aargtag $flags{$flag}{tag}\n") if ($flags{$flag}{tag} ne "");
&send_pyx("Afixedstrings $flags{$flag}{fixedstrings}\n")
if (defined $flags{$flag}{fixedstrings}
&& $flags{$flag}{fixedstrings} ne "");
&send_pyx("Aexclusionlist $flags{$flag}{exclusionlist}\n")
if (defined $flags{$flag}{exclusionlist}
&& $flags{$flag}{exclusionlist} ne "");
&send_pyx("Amultiple true\n") if (defined $flags{$flag}{multiple}
&& $flags{$flag}{multiple} ne "");
&send_pyx("Asame_word true\n") if ($flags{$flag}{sameword}
&& $flags{$flag}{sameword} ne "");
&send_pyx("Ataghelp $flags{$flag}{taghelp}\n") if defined $flags{$flag}{taghelp};
&send_pyx("Aflaghelp $flags{$flag}{flaghelp}\n") if defined $flags{$flag}{flaghelp};
&send_pyx(")flag\n");
}
# Now handle commandline arguments...
my @cmd_args;
if (!$no_args && ($#args < 0))
{
@cmd_args = ("files");
}
elsif ($no_args)
{
@cmd_args=();
}
else
{
@cmd_args = (@args);
}
for(my $i=0;$i<= $#cmd_args;$i++)
{
my $arg=$cmd_args[$i];
my $pos=$i+1;
$pos = "any" if ($i== $#cmd_args);
&send_pyx("(arg\n");
&send_pyx("Aposition $pos\n");
&send_pyx("Aargtag $arg\n");
&send_pyx(")arg\n");
}
#Save information about how this file was generated.
&send_pyx("(generation\n");
&send_pyx("Acommand help2simple.pl $cmdline\n");
&send_pyx(")generation\n");
&send_pyx(")command\n");
#We're done.
&close_pyx();
exit 0;
################################################################################
sub usage
{
print < $flags{$b}{order};
}
# open_pyx, send_pyx, close_pyx functions are used to generate PYX or XML
# output. This script calls these functions to handle the generation
# of the data. The script hands PYX to send_pyx, which either spits that
# out, or generates XML.
sub open_pyx {
%Encode = (
'<' => '<',
'>' => '>',
'&' => '&',
'"' => '"',
);
$Encode = join('', keys(%Encode));
$Tag_open = 0;
}
sub close_pyx
{
return if ($pyx);
print '>' if $Tag_open;
return;
}
sub send_pyx
{
my $string = join('',@_);
if ($pyx)
{
print $string;
return;
}
$_ = $string;
my ($type, $value) = m/\A([A()?-])(.*)\Z/;
if ($type eq 'A') {
my ($att, $attval) = m/\AA([^\s]+)\s*(.*)\Z/;
print " $att=\"" , encode($attval) , '"';
return;
}
if ($Tag_open)
{
print "/" if ($type eq ")");
print ">\n";
undef $Tag_open;
return if ($type eq ")");
}
if ($type eq '(') {
print "<$value";
$Tag_open = 1;
}
elsif ($type eq ')') {
print "\n";
}
elsif ($type eq '-') {
$value =~ s/\\n/\n/g;
print encode($value);
}
elsif ($type eq '?') {
print "\n";
}
}
#Generate Entities for special characters.
sub encode {
my $text = shift;
$text =~ s/([$Encode])/$Encode{$1}/g;
return $text;
}
#Extract_flag is responsible for parsing a line from the help, and
#extract information about a flag.
# It returns a reference to a hash that contains information about the flag.
sub extract_flag
{
my $line = $_[0];
my %info;
$_ = $line;
my ($flag,$flag2,$taghelp, $argtag, $argtag2, $sameword, $helptype);
my ($equals, $equals2, $fixedstrings);
$sameword = 0;
$fixedstrings = "";
# The expected input look something like:
# -h lines Set the size of the scrollback history buffer.
# The line starts with a flag, ($1)
# The flag is followed by and optional argument ($2)
# The trailing content after 2 or more spaces is the help.($3)
# The following regex performs this parsing.
$helptype = "flaghelp";
if (m#^\s*(-[^\s]+)\s+(([^\s]+)\s+)?(or|,)\s+(-[^\s]+)\s([^\s]+)?\s+(.*)$#)
{
$flag = $1;
$flag2 = $5;
$taghelp = $7;
$argtag = $3;
$argtag2 = $6;
}
elsif (m#^\s*(-[^\s]+)( [^\s]+)*(\s\s+|\t)+(.*)$#)
{
$flag = $1;
$flag2 = $argtag2 = '';
$argtag = $2;
$taghelp = $4;
}
else { return \%info; }
#print STDERR "flag($flag) argtag($argtag) taghelp($taghelp) ($_)\n"; #lll
my $flagparts = &handle_prefix($flag);
if (@$flagparts == 2)
{
$flag = $$flagparts[0];
$argtag = $$flagparts[1];
$sameword = 1 if ($argtag !~ /^ +/);
}
if ($single_char_flags && $flag =~ /^(-[^-])(.+)$/)
{
$flag = $1;
$argtag = $2;
$sameword = 1;
$helptype = "taghelp";
}
elsif ( $flag =~ /^(-[^=]*)=(.*)$/)
{
$flag = $1;
$argtag = $2;
$helptype="taghelp";
$equals=1;
if ($flag2 =~ /^(-[^=]*)=(.*)$/)
{
$flag2 = $1;
$argtag2 = $2;
$equals2 = 1;
}
}
$argtag = "" if (!defined $argtag);
if ($argtag =~ /\|/)
{
$argtag =~ s/^\s*[[({<]//;
$argtag =~ s/[])}>]\s*$//;
my @f = split (/\|/,$argtag);
$fixedstrings = join(" ",@f);
$argtag = "";
}
if ($argtag ne "")
{
$helptype = "taghelp";
$argtag .= $flag if $unique_args; #Add flag name to arg if unique_args
}
$info{flag} = $flag;
$info{flag2} = $flag2;
$info{$helptype} = $taghelp;
$info{tag}= $argtag;
$info{tag2} = $argtag2;
$info{sameword} = $sameword if ($sameword);
$info{equals} = $equals if ($equals);
$info{equals2} = $equals2 if ($equals2);
$info{fixedstrings} = $fixedstrings if ($fixedstrings ne "");
return(\%info);
}
# Stub function. Is be overriden by function generated via create_handle_prefix
sub handle_prefix {}
#Creates new handle_prefix().
# The handle_prefix() is used to separate a flag from it's argument.
# This is use to handle the "-p" flag.
sub create_handle_prefix
{
my %prefix;
foreach my $flag_prefix (@p_array)
{
my @parts=split(/,/,$flag_prefix);
foreach my $p (@parts)
{
$prefix{$p} = 1;
}
}
$func = <<'EOF';
sub main::handle_prefix {
my ($flag, $str);
$_ = $_[0];
EOF
foreach my $k (sort keys %prefix)
{
$func .= < ( geocities.com/f_rosencrantz)