tools/mkkeyboard-xkb-symbols

   1 #!/usr/bin/env perl
   2 use 5.014;
   3 use warnings;
   4 use utf8;
   5 use re '/msx';
   6 use open IO => ':encoding(utf-8)', ':std';
   7 use JSON ();
   8 use Data::Dump 'pp';
   9
  10 our $VERSION = '1.01';
  11
  12 my $symname = eval {
  13         open my $keysymh, '<', 'data/keysymdef.json' or die $!;
  14         local $/;
  15         return JSON->new->decode(readline $keysymh);
  16 } or die "Could not read keysym definitions: $@\n";
  17
  18 my $geochar = do './keyspos.inc.pl'
  19         or die "Could not read keyboard position names: $@\n";
  20
  21 my %res;
  22 while (readline) {
  23         my ($pos, $def) = m/^\h* key \h+ <(\w+)> \h+ \{ (.+?) \};/ or next;
  24         my @mode = map { [split /,\h*/] } $def =~ m/\[ \h* (.*?) \h* \]/g;
  25         for my $shift (0, 1) {
  26                 defined(my $chr = $mode[0]->[$shift + 2])
  27                         or warn "missing $pos +$shift\n";
  28                 if ($chr =~ m/^U ([A-F0-9]+) $/) {
  29                         $chr = chr hex $1;
  30                 }
  31                 elsif (defined $symname->{$chr}) {
  32                         $chr = $symname->{$chr};
  33                 }
  34                 else {
  35                         warn "unknown symbol $chr at $pos\n";
  36                 }
  37                 $res{$geochar->{$pos}->[$shift] // $pos} = $chr;
  38                 #$res{$pos}[$shift] = $symname->{$chr} // $chr; # geochar
  39         }
  40 }
  41 say pp(\%res) =~ s/(?<=") \\x \{? ([0-9A-F]{2,6}) \}?/chr hex $1/reg;
  42
  43 __END__
  44
  45 =head1 NAME
  46
  47 mkkeyboard-xkb-symbols - Character map of an xkb symbols file
  48
  49 =head1 SYNOPSIS
  50
  51     cat /usr/share/X11/xkb/symbols/us |
  52     perl -ne 'print if /^xkb_symbols "intl"/../^\};/' |
  53     mkkeyboard-xkb-symbols >map-us-intl.inc.pl
  54
  55 =head1 DESCRIPTION
  56
  57 Parses C<key> declarations inside an C<xkb_symbols> section
  58 and returns a perl hash of normalised qwerty input to unicode output
  59 of 3rd and 4th levels (altgr and shift+altgr modes)
  60 to be manually cleaned and integrated in a keyboard page include.
  61
  62 =head1 AUTHOR
  63
  64 Mischa POSLAWSKY <perl@shiar.org>
  65
  66 =head1 LICENSE
  67
  68 Licensed under the GNU Affero General Public License version 3.
  69