144 lines
3.3 KiB
Perl
Executable file
144 lines
3.3 KiB
Perl
Executable file
#!/usr/bin/perl
|
|
#
|
|
# dselect - Debian package maintenance user interface
|
|
# mkcurkeys.pl - generate strings mapping key names to ncurses numbers
|
|
#
|
|
# Copyright © 1995 Ian Jackson <ijackson@chiark.greenend.org.uk>
|
|
#
|
|
# This is free software; you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 2 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# This is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Scalar::Util qw(looks_like_number);
|
|
|
|
die 'usage: mkcurkeys.pl <filename> <curses.h>' if @ARGV != 2;
|
|
|
|
my (%over, %base, %name);
|
|
|
|
open(my $override_fh, '<', $ARGV[0]) or die $!;
|
|
while (<$override_fh>) {
|
|
chomp;
|
|
/^#/ && next; # skip comments
|
|
/\S/ || next; # ignore blank lines
|
|
if (/^(\w+)\s+(\S.*\S)\s*$/) {
|
|
$over{$1} = $2;
|
|
$base{$1} = '';
|
|
} else {
|
|
die "cannot parse line:\n$_\n";
|
|
}
|
|
}
|
|
close($override_fh);
|
|
|
|
my $let = 'A';
|
|
for my $i (1 .. 26) {
|
|
$name{$i} = "^$let";
|
|
$base{$i} = '';
|
|
$let++;
|
|
}
|
|
|
|
open(my $header_fh, '<', $ARGV[1]) or die $!;
|
|
while (<$header_fh>) {
|
|
s/\s+$//;
|
|
m/#define KEY_(\w+)\s+\d+\s+/p || next;
|
|
my $rhs = ${^POSTMATCH};
|
|
my $k = "KEY_$1";
|
|
$base{$k} = capit($1);
|
|
$rhs =~ s/(\w)[\(\)]/$1/g;
|
|
$rhs =~ s/\w+ \((\w+)\)/$1/;
|
|
next unless $rhs =~ m{^/\* (\w[\w ]+\w) \*/$};
|
|
my $name = $1;
|
|
$name =~ s/ key$//;
|
|
if ($name =~ s/^shifted /shift /) {
|
|
next if $name =~ m/ .* .* /;
|
|
} else {
|
|
next if $name =~ m/ .* /;
|
|
}
|
|
$name{$k} = capit($name);
|
|
}
|
|
close($header_fh);
|
|
|
|
printf(<<'END') or die $!;
|
|
/*
|
|
* WARNING - THIS FILE IS GENERATED AUTOMATICALLY - DO NOT EDIT
|
|
* It is generated by mkcurkeys.pl from <curses.h>
|
|
* and keyoverride. If you want to override things try adding
|
|
* them to keyoverride.
|
|
*/
|
|
|
|
END
|
|
|
|
my ($comma);
|
|
|
|
for my $i (33 .. 126) {
|
|
my $k = $i;
|
|
my $v = pack('C', $i);
|
|
if ($v eq ',') { $comma = $k; next; }
|
|
p($k, $v);
|
|
}
|
|
|
|
## no critic (BuiltinFunctions::ProhibitReverseSortBlock)
|
|
for my $k (sort {
|
|
looks_like_number($a) ?
|
|
looks_like_number($b) ? $a <=> $b : -1
|
|
: looks_like_number($b) ? 1 :
|
|
$a cmp $b
|
|
} keys %base) {
|
|
## use critic
|
|
my $v;
|
|
$v = $base{$k};
|
|
$v = $name{$k} if defined($name{$k});
|
|
$v = $over{$k} if defined($over{$k});
|
|
next if $v eq '[elide]';
|
|
p($k, $v);
|
|
}
|
|
|
|
for my $i (1 .. 63) {
|
|
p("KEY_F($i)", "F$i");
|
|
}
|
|
|
|
p($comma, ',');
|
|
|
|
print(<<'END') or die $!;
|
|
{ -1, nullptr }
|
|
END
|
|
|
|
close(STDOUT) or die $!;
|
|
exit(0);
|
|
|
|
sub capit {
|
|
my $str = shift;
|
|
my $o = '';
|
|
|
|
$str =~ y/A-Z/a-z/;
|
|
$str = " $str";
|
|
while ($str =~ m/ (\w)/p) {
|
|
$o .= ${^PREMATCH} . ' ';
|
|
$str = $1;
|
|
$str =~ y/a-z/A-Z/;
|
|
$o .= $str;
|
|
$str = ${^POSTMATCH};
|
|
}
|
|
$str = $o . $str;
|
|
$str =~ s/^ //;
|
|
|
|
return $str;
|
|
}
|
|
|
|
sub p {
|
|
my ($k, $v) = @_;
|
|
|
|
$v =~ s/(["\\])/\\$1/g;
|
|
printf(" { %-15s \"%-20s },\n", $k . ',', $v . '"') or die $!;
|
|
}
|