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 'l4' ? '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         key   => \%table,
  56         flag  => {
  57                 'l5' => "matching RFC-1345",
  58                 'l4' => "matching proposal",
  59                 'l3' => "unique to Xorg",
  60                 'l1' => "conflict",
  61                 'l0 ex' => "duplicate",
  62         },
  63 });
  64
  65 __END__
  66
  67 =head1 NAME
  68
  69 mkdigraphs-xorg - Output Xorg compose sequences
  70
  71 =head1 SYNOPSIS
  72
  73
  74     mkdigraphs-xorg /usr/share/X11/locale/en_US.UTF-8/Compose |
  75     jq -r '.key."AT"[0]' | perl -nE 'say chr' # @
  76
  77 =head1 DESCRIPTION
  78
  79 Extracts Multi_key definitions from X11/Xorg Compose.pre include file.
  80 If successful, a JSON object is output containing a digraphs list in C<key>
  81 with Unicode code points keyed by mnemonics.
  82 Any errors and warnings are given at STDERR.
  83
  84 =head1 AUTHOR
  85
  86 Mischa POSLAWSKY <perl@shiar.org>
  87
  88 =head1 LICENSE
  89
  90 Licensed under the GNU Affero General Public License version 3.
  91