From 34786a8e7bf9e861694717618521d23b8e9647a8 Mon Sep 17 00:00:00 2001
From: dakkar <dakkar@thenautilus.net>
Date: Tue, 2 Feb 2016 18:59:29 +0000
Subject: make printable compose tables

---
 compose2html | 194 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 194 insertions(+)
 create mode 100644 compose2html

(limited to 'compose2html')

diff --git a/compose2html b/compose2html
new file mode 100644
index 0000000..ac3e648
--- /dev/null
+++ b/compose2html
@@ -0,0 +1,194 @@
+#!/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;
+use Data::Visitor::Callback;
+
+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,
+    ] ],
+]);
-- 
cgit v1.2.3