diff options
Diffstat (limited to 'compose2html')
-rw-r--r-- | compose2html | 248 |
1 files changed, 248 insertions, 0 deletions
diff --git a/compose2html b/compose2html new file mode 100644 index 0000000..ea4c14b --- /dev/null +++ b/compose2html @@ -0,0 +1,248 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use 5.020; +use utf8; +use open ':std',':locale'; +use List::AllUtils qw(uniq 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] } @_ +} + +sub extract_collisions { + my %same_output; + my %same_input; + for my $mapping (@_) { + my ($input,$output) = @{$mapping}; + push @{$same_input{$input}},$output; + push @{$same_output{$output}},$input; + } + for my $h (\%same_input,\%same_output) { + for my $i (keys %$h) { + @{$h->{$i}} = uniq @{$h->{$i}}; + delete $h->{$i} if @{$h->{$i}} < 2; + } + } + return (\%same_input,\%same_output); +} + +my %glyph = ( + acute => '`', + ampersand => '&', + apostrophe => q{'}, + asciicircum => '^', + asciitilde => '~', + asterisk => '*', + at => '@', + backslash => '\\', + BackSpace => '␈', + bar => '|', + braceleft => '{', + braceright => '}', + bracketleft => '[', + bracketright => ']', + colon => ':', + comma => ',', + division => '/', + dollar => '$', + Down => '↓', + equal => '=', + exclam => '!', + grave => q{'}, + greater => '>', + Left => '←', + less => '<', + minus => '-', + Multi_key => '⌥', + numbersign => '#', + parenleft => '(', + parenright => ')', + percent => '%', + period => '.', + plus => '+', + question => '?', + quotedbl => '"', + Right => '→', + semicolon => ';', + slash => '/', + space => '␣', + tilde => '~', + underscore => '_', + Up => '↑', + KP_1 => '1⃣', + KP_2 => '2⃣', + KP_3 => '3⃣', + KP_4 => '4⃣', + KP_5 => '5⃣', + KP_6 => '6⃣', + KP_7 => '7⃣', + KP_8 => '8⃣', + KP_9 => '9⃣', + KP_0 => '0⃣', + #KP_Space => '␣⃣', # this seems to be used as equivalent to KP_2 + KP_Equal => '=⃣', + KP_Divide => '/⃣', + KP_Add => '+⃣', + KP_Multiply => '*⃣', +); + +sub to_presentation_form { + map { + my ($output, @keys) = @$_; + my $unmapped=0; + @keys = map { + length($_)==1 + ? $_ + : ($glyph{$_} // do { warn "What's a <$_>??";++$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, + ] ]; +} + +sub show_collisions { + my @kind = qw(input output); + my %same; @same{@kind} = @_; + map { + my $kind = $_; + [ \'div', [ + [ \'h2', "\u$kind collisions" ], + [ \'dl', [ + map { + [ \'dt', $_ ], + map { [ \'dd', $_ ] } sort @{$same{$kind}->{$_}} + } sort keys %{$same{$kind}} + ] ], + ] ]; + } @kind; +} + +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 + +my @data = to_presentation_form sort_it parse_compose_file; + +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 @data), + (show_collisions extract_collisions @data), + ] ], +]); |