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