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 = (
  19         TLDE => ["`", "~"],
  20         AE01 => ['1', "!"],
  21         AE02 => ['2', "\@"],
  22         AE03 => ['3', "#"],
  23         AE04 => ['4', "\$"],
  24         AE05 => ['5', "%"],
  25         AE06 => ['6', "^"],
  26         AE07 => ['7', "&"],
  27         AE08 => ['8', "*"],
  28         AE09 => ['9', "("],
  29         AE10 => ['0', ")"],
  30         AE11 => ["-", "_"],
  31         AE12 => ["=", "+"],
  32
  33         AD01 => ["q", "Q"],
  34         AD02 => ["w", "W"],
  35         AD03 => ["e", "E"],
  36         AD04 => ["r", "R"],
  37         AD05 => ["t", "T"],
  38         AD06 => ["y", "Y"],
  39         AD07 => ["u", "U"],
  40         AD08 => ["i", "I"],
  41         AD09 => ["o", "O"],
  42         AD10 => ["p", "P"],
  43         AD11 => ["[", "{"],
  44         AD12 => ["]", "}"],
  45
  46         AC01 => ["a", "A"],
  47         AC02 => ["s", "S"],
  48         AC03 => ["d", "D"],
  49         AC04 => ["f", "F"],
  50         AC05 => ["g", "G"],
  51         AC06 => ["h", "H"],
  52         AC07 => ["j", "J"],
  53         AC08 => ["k", "K"],
  54         AC09 => ["l", "L"],
  55         AC10 => [";", ":"],
  56         AC11 => ["'", '"'],
  57
  58         LSGT => ["§", "±"], # mac
  59         AB01 => ["z", "Z"],
  60         AB02 => ["x", "X"],
  61         AB03 => ["c", "C"],
  62         AB04 => ["v", "V"],
  63         AB05 => ["b", "B"],
  64         AB06 => ["n", "N"],
  65         AB07 => ["m", "M"],
  66         AB08 => [",", "<"],
  67         AB09 => [".", ">"],
  68         AB10 => ["/", "?"],
  69         BKSL => ["\\","|"],
  70 );
  71
  72 my %res;
  73 while (readline) {
  74         my ($pos, $def) = m/^\h* key \h+ <(\w+)> \h+ \{ (.+?) \};/ or next;
  75         my @mode = map { [split /,\h*/] } $def =~ m/\[ \h* (.*?) \h* \]/g;
  76         for my $shift (0, 1) {
  77                 defined(my $chr = $mode[0]->[$shift + 2])
  78                         or warn "missing $pos +$shift\n";
  79                 if ($chr =~ m/^U ([A-F0-9]+) $/) {
  80                         $chr = chr hex $1;
  81                 }
  82                 elsif (defined $symname->{$chr}) {
  83                         $chr = $symname->{$chr};
  84                 }
  85                 else {
  86                         warn "unknown symbol $chr at $pos\n";
  87                 }
  88                 $res{$geochar{$pos}->[$shift] // $pos} = $chr;
  89                 #$res{$pos}[$shift] = $symname->{$chr} // $chr; # geochar
  90         }
  91 }
  92 say pp(\%res) =~ s/(?<=") \\x \{? ([0-9A-F]{2,6}) \}?/chr hex $1/reg;
  93
  94 __END__
  95
  96 =head1 NAME
  97
  98 mkkeyboard-xkb-symbols - Character map of an xkb symbols file
  99
 100 =head1 SYNOPSIS
 101
 102     cat /usr/share/X11/xkb/symbols/us |
 103     perl -ne 'print if /^xkb_symbols "intl"/../^\};/' |
 104     mkkeyboard-xkb-symbols >map-us-intl.inc.pl
 105
 106 =head1 DESCRIPTION
 107
 108 Parses C<key> declarations inside an C<xkb_symbols> section
 109 and returns a perl hash of normalised qwerty input to unicode output
 110 of 3rd and 4th levels (altgr and shift+altgr modes)
 111 to be manually cleaned and integrated in a keyboard page include.
 112
 113 =head1 AUTHOR
 114
 115 Mischa POSLAWSKY <perl@shiar.org>
 116
 117 =head1 LICENSE
 118
 119 Licensed under the GNU Affero General Public License version 3.
 120