aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--README.md3
-rw-r--r--compose2html248
2 files changed, 251 insertions, 0 deletions
diff --git a/README.md b/README.md
index a994339..9e928e8 100644
--- a/README.md
+++ b/README.md
@@ -1,3 +1,6 @@
+NOTE: this is my (dakkar's) fork; the original is still at
+http://github.org/kragen/xcompose
+
.XCompose
=========
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),
+ ] ],
+]);