view release on metacpan or  search on metacpan

examples/filter_kbd_tables.pl  view on Meta::CPAN

use subs qw(chr lc uc);

#BEGIN { *CORE::GLOGAL::chr = sub ($) { toU CORE::chr shift };
#        *CORE::GLOGAL::lc  = sub ($)  { CORE::lc  toU shift };
#}
# Remove ß ẞ :
my %fix = qw( ԥ Ԥ ԧ Ԧ ӏ Ӏ ɀ Ɀ ꙡ Ꙡ ꞑ Ꞑ  ꞧ Ꞧ  ɋ Ɋ  ꞩ Ꞩ  ȿ Ȿ  ꞓ Ꞓ  ꞥ Ꞥ );		# Perl 5.8.8 uc is wrong with palochka, 5.10 with z with swash tail
my %unfix = reverse %fix;

sub chr($)  { local $^W = 0; toU CORE::chr shift }	# Avoid illegal character 0xfffe etc warnings...
sub lc($)   { my $in = shift; $unfix{$in} || CORE::lc toU $in }
sub uc($)   { my $in = shift;   $fix{$in} || CORE::uc toU $in }

my %html_esc = qw( & &amp; < &lt; > &gt; );
sub h($)  { (my $c = shift) =~ s/([&<>])/$html_esc{$1}/g; $c }
sub tags_by_rx {
  my ($c, @o) = shift;
  die "Need odd number of arguments" if @_ & 1;
  while (@_) {
    my $tag = shift;
    push @o, $tag if $c =~ shift;
  }

examples/klc2c.pl  view on Meta::CPAN

my $prevVK;
my %compatTR = qw( 0008 '\b' 000a '\n' 000d '\r' 005c '\\\\' 0027 '\'' 0022 '\"' );
my $compatRx = qr/^00(0[8ad]|2[27]|5c)$/i;	# these frivolous conversions simplify comparison with kbdutool; may be removed!
sub s2c($;$) {my($i,$o) = shift; return $prevVK if $i eq '-1';
              $o = ($i =~ /^[''""\\]$/ ? "'\\$i'" : ($i =~ /^.$/ ? "'$i'" : ($i =~ /^0x[\da-z]+$/i ? $i : "VK_$i"))); $prevVK = $o if shift; $o}
sub hex2c($$) {my($i,$h) = (shift,shift); my $n = hex $i; return "0x\L$i" if !$h or $n<0x20 or $n > 0x7e; "L" . s2c chr $n }
sub ch2c($;$)  {my($i,$h) = (shift,shift); return $compatTR{lc $i} if $h and $i =~ $compatRx;
                $i =~ /^[\da-f]{2,}$/i ? hex2c($i,$h) : ($i =~ /^.$/ ? s2c($i) : ($i =~ /^-1$/ ? 'WCH_NONE'
			: ($i =~ /\@$/ ? 'WCH_DEAD' : ($i eq '%%' ? 'WCH_LGTR' : $i))))}

sub mx($$) {my($i,$j)=(shift, shift); $i<$j? $j : $i}
sub fmt_st($$$) {my($i,$j,$l) = (shift, shift, shift); "$i" . (' ' x mx(1, $l - 3 - length "$i$j")) . ",$j ,"}

my($sublayouts, @sublayouts) = '';
sub emit_layout_line ($$$$) {	# XXXX Need to take into account required length too ???
  my($vk, $caps, $bind, $x, @xx) = (shift, shift, shift, shift || []);
  (my $ss, $caps) = (hex($caps) & 0xF, hex($caps) & ~0xF);
  $caps ||= '';
  $caps .= '|' if $caps;
  $caps .= join ' | ', map {$ss&(1<<$_) ? $capsFl->[$_] : ()} 0..$#$capsFl; # [1,'CAPLOK'], [2,'SGCAPS'], [4,'CAPLOKALTGR'], [8,'KANALOK'];
  my @bind = map ch2c($_,'unhex'), @$bind;

lib/UI/KeyboardLayout.pm  view on Meta::CPAN

#BEGIN { *CORE::GLOGAL::chr = sub ($) { toU CORE::chr shift };
#        *CORE::GLOGAL::lc  = sub ($)  { CORE::lc  toU shift };
#}
### Remove ß ẞ :
## my %fix = qw( ԥ Ԥ ԧ Ԧ ӏ Ӏ ɀ Ɀ ꙡ Ꙡ ꞑ Ꞑ  ꞧ Ꞧ  ɋ Ɋ  ꞩ Ꞩ  ȿ Ȿ  ꞓ Ꞓ  ꞥ Ꞥ );		# Perl 5.8.8 uc is wrong with palochka, 5.10 with z with swash tail
my %fix = qw( ԥ Ԥ ԧ Ԧ ӏ Ӏ ɀ Ɀ ꙡ Ꙡ ꞑ Ꞑ  ꞧ Ꞧ  ɋ Ɋ  ß ẞ  ꞩ Ꞩ  ȿ Ȿ  ꞓ Ꞓ  ꞥ Ꞥ  ℊ Ɡ  ϳ Ϳ );		# Perl 5.8.8 uc is wrong with palochka, 5.10 with z with swash tail
my %unfix = reverse %fix;

sub chr($)  { local $^W = 0; toU CORE::chr shift }	# Avoid illegal character 0xfffe etc warnings...
sub lc($)   { my $in = shift; $unfix{$in} || CORE::lc toU $in }
sub uc($)   { my $in = shift;   $fix{$in} || CORE::uc toU $in }
sub ucfirst($)   { my $in = shift;   $fix{$in} || CORE::ucfirst toU $in }

# We use this for printing, not for reading (so we can use //o AFTER the UCD is read)
my $rxCombining = qr/\p{NonspacingMark}/;	# The initial version matches what Perl knows
my $rxZW = qr/\p{Line_Break: ZW}|[\xAD\x{200b}-\x{200f}\x{2060}-\x{2064}\x{fe00}-\x{fe0f}]/;

sub rxCombining { $rxCombining }

=pod