#!/usr/bin/perl -w

use strict;

my (%OPS, %MAP, %DOC, $map);

my $xml = shift @ARGV;

open F, "cat @ARGV |" or die "OPS*: $!";
while (<F>) {
  if ( /^\s+_fmt\((\w+),\s+N_\("(.+)"\)\)/ ) {
    $OPS{$1} = $2;
  }
}
close F;

my $num_ops = scalar(keys(%OPS));
if ( $num_ops == 0 ) {
  die "No OPS found. Has the syntax changed?";
}

while (<STDIN>) {
  if (/^const struct Binding Op.*{ \/\* map: (.*) \*\//) {
    $map = $1;
    $DOC{$map} = "";
  }
  if ($map and /^\s*\*\*\s*(.*)/) {
    $DOC{$map} .= "$1\n";
  }
  if ($map and /{\s*"(.+)"\s*,\s*(\w+)\s*,\s*(?:"([^"]+)"|(\w+))\s*}/) {
    my ($function, $op, $binding) = ($1, $2, $3 || $4);
    $binding =~ s/&/&amp;/;
    # for <key>, try CamelCasing into <Key>
    $binding =~ s/<(.)(.+)>/&lt;\U$1\E$2&gt;/;
    $binding =~ s/</&lt;/;
    $binding =~ s/>/&gt;/;
    $binding =~ s/ /&lt;Space&gt;/;
    $binding =~ s/^\\033/Esc /;
    $binding =~ s/^\\010/&lt;Backspace&gt;/;
    $binding =~ s/^\\(0\d+)$/'^'.chr(64+oct($1))/e;
    $binding =~ s/^\\(0\d+)(.)/'^'.chr(64+oct($1)) ." $2"/e;
    $binding =~ s/\\t/&lt;Tab&gt;/;
    $binding =~ s/\\r/&lt;Return&gt;/;
    $binding =~ s/\\n/&lt;Enter&gt;/;
    $binding =~ s/NULL//;
    die "unknown key $binding" if $binding =~ /\\[^\\]|<|>/;
    die "unknown OP $op" unless $OPS{$op};
    $MAP{$map} .= "<row><entry><literal>&lt;$function&gt;</literal></entry><entry>$binding</entry><entry>$OPS{$op}</entry></row>\n";
  }
  if ($map and /^}/) {
    undef $map;
  }
}

open XML, $xml or die "$xml: $!";
while (<XML>) {
  if (/__print_map\((.*)\)/) {
    my $map = $1;
    my $mapid = $1;
    my $maptitle = $1;
    $mapid =~ s/\s+/-/g;
    $maptitle =~ s/\b(\w)/\u$1/g;
    unless ($MAP{$map}) {
      warn "map $map undefined";
      next;
    }
    print <<EOT;
<sect2 id="${mapid}-map">
<title>$maptitle Menu</title>
$DOC{$map}

<table id="tab-${mapid}-bindings">
<title>Default $maptitle Menu Bindings</title>
<tgroup cols="3">
<thead>
<row><entry>Function</entry><entry>Default key</entry><entry>Description</entry></row>
</thead>
<tbody>
$MAP{$map}
</tbody>
</tgroup>
</table>

</sect2>

EOT
    delete $MAP{$map};
  } else {
    print;
  }
}
close XML;

warn "unprinted maps: ". join(" ", keys %MAP) if %MAP;
