#!/usr/bin/env perl
use strict;
use warnings;
use 5.020;
use utf8;
use open ':std',':locale';
use List::AllUtils qw(natatime);
use HTML::Tiny;
use HTML::Entities;
use Unicode::UCD qw(charinfo);
use Unicode::Normalize;

my $COLUMNS = 5;

sub parse_compose_file {
    my ($fn) = @_;
    $fn //= $ENV{HOME}.'/.XCompose';

    open my $fh, '<:utf8', $fn;
    my @ret;
    while (my $line = <$fh>) {
        $line =~ s{#.*\z}{}sm;

        if ($line =~ m{^include \s* "(.+?)"}x) {
            my $file = $1;
            $file =~ s{%L}{/usr/share/X11/locale/$ENV{LC_ALL}/Compose}g;
            push @ret, parse_compose_file($file);
        }
        elsif ($line =~ m{<Multi_key>}) {
            my ($keys,$output) = split /:/,$line;
            unless ($keys && $output) {
                warn "<$line>";
                next;
            }
            my @keys = $keys =~ m{<(.+?)>}g;
            $output =~ s{\A \s* "(.+?)" .* \z}{$1}smx;
            $output = NFC($output);
            warn sprintf "%s %d <%s> [%s] %d %s\n",
                $fn, $.,
                join(' ',@keys),
                $output,length($output),
                join(' ',map { sprintf 'U+%04X', ord($_) } split //,$output);
            push @ret, [$output,@keys];
        }
    }
    return @ret;
}

sub sort_it {
    sort { $a->[0] cmp $b->[0] } @_
}

my %glyph = (
    acute => '`',
    ampersand => '&',
    apostrophe => q{'},
    asterisk => '*',
    'at' => '@',
    backslash => '\\',
    BackSpace => '␈',
    bar => '|',
    braceleft => '{',
    braceright => '}',
    bracketleft => '[',
    bracketright => ']',
    colon => ':',
    comma => ',',
    dollar => '$',
    Down => '↓',
    equal => '=',
    exclam => '!',
    # grave => '???',
    greater => '>',
    Left => '←',
    less => '<',
    minus => '-',
    Multi_key => '⌥',
    numbersign => '#',
    parenleft => '(',
    parenright => ')',
    percent => '%',
    period => '.',
    plus => '+',
    question => '?',
    quotedbl => '"',
    Right => '→',
    semicolon => ';',
    slash => '/',
    space => '␣',
    tilde => '~',
    underscore => '_',
    Up => '↑',
);

sub to_presentation_form {
    map {
        my ($output, @keys) = @$_;
        my $unmapped=0;
        @keys = map {
            length($_)==1
                ? $_
                : ($glyph{$_} // ++$unmapped);
        } @keys;
        if ($unmapped) {
            ();
        }
        else {
            [(join '',@keys),$output];
        }
    } @_;
}

sub fill_table {
    my @rows;
    my $it = natatime $COLUMNS,@_;
    while (my @row_data = $it->()) {
        push @rows,[ \'tr', [
            map {
                my ($sequence, $output) = @{$_};
                my @infos;
                if ($output =~ /\s|\P{Print}/) {
                    my @points = split //,$output;
                    for my $p (@points) {
                        my $info = charinfo(ord($p));
                        if ($info) {
                            push @infos, lc($info->{name});
                        }
                        else {
                            warn sprintf 'no charinfo for %s (%04X)',
                                $p,ord($p);
                        }
                    }
                }

                (
                    [ \'th', {class=>'key'}, encode_entities($sequence), ],
                    [ \'td', {class=>'out'}, [
                        [\'span', {class=>'out'}, encode_entities($output), ],
                        (@infos
                             ? [ \'span',{class=>'info'}, encode_entities("(@infos)") ]
                             : ()
                         ),
                    ] ],
                );
            } @row_data
        ] ];
    }

    return [ \'table', [
        @rows,
    ] ];
}

my $css = <<'CSS';
table {
 width: 100%;
 border-collapse: collapse;
 font-size: x-large;
}
td, th {
 text-align: left;
 border-top: solid thin black;
 vertical-align: baseline;
}
td {
 border-right: solid thin black;
 padding: 0.2em;
}
th {
 font-weight: normal;
 font-family: monospace;
 white-space: pre-line;
}
span.out {
 border: dotted thin black;
 padding: 0.1em;
}
span.info {
  margin-left: 0.5em;
  font-size: 50%;
}
CSS

print HTML::Tiny->new->html([
    [\'head',[
        [\'meta', {'http-equiv'=>'Content-Type',content=>'text/html;charset=utf-8'}],
        [\'style',$css],
        [\'title','Compose mappings']
    ] ],
    [ \'body', [
        fill_table to_presentation_form sort_it parse_compose_file,
    ] ],
]);