tools/mkdigraphs-xorg

   1 #!/usr/bin/env perl
   2 use 5.014;
   3 use warnings;
   4 use utf8;
   5 use open IO => ':encoding(utf-8)', ':std';
   6 use re '/msx';
   7 use JSON 'decode_json';
   8 use Data::Dump 'pp';
   9 use Shiar_Sheet::FormatChar;
  10
  11 our $VERSION = '1.01';
  12
  13 my $symname = eval {
  14         open my $keysymh, '<', 'data/keysymdef.json' or die $!;
  15         local $/;
  16         return decode_json(readline $keysymh);
  17 } or die "Could not read keysym definitions: $@\n";
  18
  19 my $vidi = eval {
  20         open my $jsfh, '<', 'data/digraphs.json' or die $!;
  21         local $/;
  22         return JSON->new->decode(readline $jsfh);
  23 } or warn "Could not read comparison digraphs: $@\n";
  24
  25 my %table;
  26 while ($_ = readline) {
  27         my ($mnem, $chr, $trail) = m/\A <Multi_key> \h (.*?) \h+ : \h "([^"]+)" \h* (.*)/
  28                 or next;
  29         $chr =~ s/\\(.)/$1/g;
  30         $mnem !~ m/<dead | <KP_ | <U[0-9A-Fa-f]{4}/ or next;  # skip non-standard keys
  31         eval {
  32                 $mnem =~ s{<([^>]+)> \h?}{$symname->{$1} // die "reference to unknown keysym $1\n"}eg;
  33                 1;
  34         } or warn($@), next;
  35         $mnem =~ m/\A [\x20-\x7F]{2} \z/ or next;  # only interested in two ascii
  36         my $alias = (state $seen = {})->{$chr}++;  # assume first is preferred
  37         my $cp = ord $chr;
  38         my $uninfo = Shiar_Sheet::FormatChar->glyph_info($cp);
  39         my $comparison = (
  40                 !$vidi->{key}->{$mnem} ? 'l3' :  # free
  41                 $vidi->{key}->{$mnem}->[0] != $cp ? 'l1' :  # conflict
  42                 $vidi->{key}->{$mnem}->[2] eq 'l5' ? 'l5' :  # rfc
  43                 'l4'  # any
  44         );
  45         $table{$mnem} = [
  46                 $cp,
  47                 $uninfo->[1] // '',  # name
  48                 $comparison,
  49                 $alias ? 'l0 ex' : $uninfo->[0] // '',  # class
  50                 $uninfo->[4] // (),  # string
  51         ];
  52 }
  53
  54 print JSON->new->canonical->indent->encode({
  55         title => 'X.Org',
  56         key   => \%table,
  57         intro => join("\n",
  58                 'Character mnemonics following compose key ⎄:',
  59                 'in the X Window System (Shift+AltGr by default).',
  60                 'Differences from <a href="/digraphs">RFC-1345</a> are indicated.',
  61                 'Also see <a href="/unicode">common Unicode</a>.',
  62         ),
  63         keywords => [qw( xorg x11 x )],
  64         flag  => {
  65                 'l5' => "matching RFC-1345",
  66                 'l4' => "matching proposal",
  67                 'l3' => "unique to Xorg",
  68                 'l1' => "conflict",
  69                 'l0 ex' => "duplicate",
  70         },
  71 });
  72
  73 __END__
  74
  75 =head1 NAME
  76
  77 mkdigraphs-xorg - Output Xorg compose sequences
  78
  79 =head1 SYNOPSIS
  80
  81
  82     mkdigraphs-xorg /usr/share/X11/locale/en_US.UTF-8/Compose |
  83     jq -r '.key."AT"[0]' | perl -nE 'say chr' # @
  84
  85 =head1 DESCRIPTION
  86
  87 Extracts Multi_key definitions from X11/Xorg Compose.pre include file.
  88 If successful, a JSON object is output containing a digraphs list in C<key>
  89 with Unicode code points keyed by mnemonics.
  90 Any errors and warnings are given at STDERR.
  91
  92 =head1 AUTHOR
  93
  94 Mischa POSLAWSKY <perl@shiar.org>
  95
  96 =head1 LICENSE
  97
  98 Licensed under the GNU Affero General Public License version 3.
  99