1 files changed, 145 insertions, 0 deletions
diff --git a/dselect/mkcurkeys.pl b/dselect/mkcurkeys.pl
new file mode 100755
index 0000000..603e901
--- /dev/null
+++ b/dselect/mkcurkeys.pl
@@ -0,0 +1,145 @@
+#!/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++;
+}
+
+my ($k, $v);
+
+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};
+    $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) {
+    $k= $i;
+    $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
+    $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 $!;
+}