xenocara/app/xterm/vttests/tcapquery.pl
2006-11-26 11:11:12 +00:00

186 lines
4.2 KiB
Perl

#!/usr/bin/perl -w
# $XTermId: tcapquery.pl,v 1.10 2006/07/20 00:37:00 tom Exp $
# $XFree86: xc/programs/xterm/vttests/tcapquery.pl,v 1.3 2006/03/13 01:28:02 dickey Exp $
#
# -- Thomas Dickey (2004/3/3)
# Test the tcap-query option of xterm.
use strict;
use IO::Handle;
sub get_reply($) {
open TTY, "+</dev/tty" or die("Cannot open /dev/tty\n");
autoflush TTY 1;
my $old=`stty -g`;
system "stty raw -echo min 0 time 5";
print TTY @_;
my $reply=<TTY>;
close TTY;
system "stty $old";
return $reply;
}
sub hexified($) {
my $value = $_[0];
my $result = "";
my $n;
for ( $n = 0; $n < length($value); ++$n) {
$result .= sprintf("%02X", ord substr($value,$n,1));
}
return $result;
}
sub query_tcap($$) {
my $tcap = $_[0];
my $tinfo = $_[1];
my $param1 = hexified($tcap);
my $param2 = hexified($tinfo);
# uncomment one of the following lines
my $reply=get_reply("\x1bP+q" . $param1 . ";" . $param2 . "\x1b\\");
#my $reply=get_reply("\x1bP+q" . $param2 . "\x1b\\");
return unless defined $reply;
if ( $reply =~ /\x1bP1\+r[[:xdigit:]]+=[[:xdigit:]]*.*/ ) {
my $value = $reply;
my $n;
$value =~ s/^\x1bP1\+r//;
$value =~ s/\x1b\\//;
my $result = "";
for ( $n = 0; $n < length($value); ) {
my $c = substr($value,$n,1);
# handle semicolon and equals
if ( $c =~ /[[:punct:]]/ ) {
$n += 1;
$result .= $c;
} else {
# handle hex-data
my $k = hex substr($value,$n,2);
if ( $k == 0x1b ) {
$result .= "\\E";
} elsif ( $k == 0x7f ) {
$result .= "^?";
} elsif ( $k == 32 ) {
$result .= "\\s";
} elsif ( $k < 32 ) {
$result .= sprintf("^%c", $k + 64);
} elsif ( $k > 128 ) {
$result .= sprintf("\\%03o", $k);
} else {
$result .= chr($k);
}
$n += 2;
}
}
printf "%s\n", $result;
}
}
# See xtermcapKeycode()
query_tcap( "#2", "kHOM");
query_tcap( "*7", "kEND");
query_tcap( "#4", "kLFT");
query_tcap( "%c", "kNXT");
query_tcap( "%e", "kPRV");
query_tcap( "%i", "kRIT");
query_tcap( "kh", "khome");
query_tcap( "\@7", "kend");
query_tcap( "kl", "kcub1");
query_tcap( "kd", "kcud1");
query_tcap( "ku", "kcuu1");
query_tcap( "kr", "kcuf1");
query_tcap( "%1", "khlp");
query_tcap( "#1", "kHLP");
query_tcap( "*6", "kslt");
query_tcap( "#6", "kSLT");
query_tcap( "\@0", "kfnd");
query_tcap( "*0", "kFND");
query_tcap( "k1", "kf1");
query_tcap( "k2", "kf2");
query_tcap( "k3", "kf3");
query_tcap( "k4", "kf4");
query_tcap( "k5", "kf5");
query_tcap( "k6", "kf6");
query_tcap( "k7", "kf7");
query_tcap( "k8", "kf8");
query_tcap( "k9", "kf9");
query_tcap( "k;", "kf10");
query_tcap( "F1", "kf11");
query_tcap( "F2", "kf12");
query_tcap( "F3", "kf13");
query_tcap( "F4", "kf14");
query_tcap( "F5", "kf15");
query_tcap( "F6", "kf16");
query_tcap( "F7", "kf17");
query_tcap( "F8", "kf18");
query_tcap( "F9", "kf19");
query_tcap( "FA", "kf20");
query_tcap( "FB", "kf21");
query_tcap( "FC", "kf22");
query_tcap( "FD", "kf23");
query_tcap( "FE", "kf24");
query_tcap( "FF", "kf25");
query_tcap( "FG", "kf26");
query_tcap( "FH", "kf27");
query_tcap( "FI", "kf28");
query_tcap( "FJ", "kf29");
query_tcap( "FK", "kf30");
query_tcap( "FL", "kf31");
query_tcap( "FM", "kf32");
query_tcap( "FN", "kf33");
query_tcap( "FO", "kf34");
query_tcap( "FP", "kf35");
query_tcap( "FQ", "kf36");
query_tcap( "FR", "kf37");
query_tcap( "FS", "kf38");
query_tcap( "FT", "kf39");
query_tcap( "FU", "kf40");
query_tcap( "FV", "kf41");
query_tcap( "FW", "kf42");
query_tcap( "FX", "kf43");
query_tcap( "FY", "kf44");
query_tcap( "FZ", "kf45");
query_tcap( "Fa", "kf46");
query_tcap( "Fb", "kf47");
query_tcap( "Fc", "kf48");
query_tcap( "Fd", "kf49");
query_tcap( "Fe", "kf50");
query_tcap( "Ff", "kf51");
query_tcap( "Fg", "kf52");
query_tcap( "Fh", "kf53");
query_tcap( "Fi", "kf54");
query_tcap( "Fj", "kf55");
query_tcap( "Fk", "kf56");
query_tcap( "Fl", "kf57");
query_tcap( "Fm", "kf58");
query_tcap( "Fn", "kf59");
query_tcap( "Fo", "kf60");
query_tcap( "Fp", "kf61");
query_tcap( "Fq", "kf62");
query_tcap( "Fr", "kf63");
query_tcap( "K1", "ka1");
query_tcap( "K4", "kc1");
query_tcap( "kB", "kcbt");
query_tcap( "kC", "kclr");
query_tcap( "kD", "kdch1");
query_tcap( "kI", "kich1");
query_tcap( "kN", "knp");
query_tcap( "kP", "kpp");
query_tcap( "kb", "kbs");
query_tcap( "Co", "colors");