xenocara/app/xterm/vttests/dynamic.pl

135 lines
3.5 KiB
Perl
Raw Normal View History

#!/usr/bin/env perl
2017-07-15 13:20:51 -06:00
# $XTermId: dynamic.pl,v 1.4 2017/01/22 18:34:06 tom Exp $
# -----------------------------------------------------------------------------
# this file is part of xterm
#
2017-07-15 13:20:51 -06:00
# Copyright 2011-2014,2017 by Thomas E. Dickey
#
# All Rights Reserved
2017-07-15 13:20:51 -06:00
#
# Permission is hereby granted, free of charge, to any person obtaining a
# copy of this software and associated documentation files (the
# "Software"), to deal in the Software without restriction, including
# without limitation the rights to use, copy, modify, merge, publish,
# distribute, sublicense, and/or sell copies of the Software, and to
# permit persons to whom the Software is furnished to do so, subject to
# the following conditions:
2017-07-15 13:20:51 -06:00
#
# The above copyright notice and this permission notice shall be included
# in all copies or substantial portions of the Software.
2017-07-15 13:20:51 -06:00
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
# IN NO EVENT SHALL THE ABOVE LISTED COPYRIGHT HOLDER(S) BE LIABLE FOR ANY
# CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
# TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
# SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
2017-07-15 13:20:51 -06:00
#
# Except as contained in this notice, the name(s) of the above copyright
# holders shall not be used in advertising or otherwise to promote the
# sale, use or other dealings in this Software without prior written
# authorization.
# -----------------------------------------------------------------------------
# Test the dynamic-color query option of xterm.
# The programs xtermcontrol and xtermset provide more options.
use strict;
use warnings;
use Getopt::Std;
use IO::Handle;
our @color_names = (
2017-07-15 13:20:51 -06:00
"VT100 text foreground",
"VT100 text background",
"text cursor",
"mouse foreground",
"mouse background",
"Tektronix foreground",
"Tektronix background",
"highlight background",
"Tektronix cursor",
"highlight foreground"
);
2017-07-15 13:20:51 -06:00
our ( $opt_c, $opt_r );
&getopts('c:r') || die(
"Usage: $0 [options]\n
Options:\n
-c XXX set cursor-color
-r reset colors
2017-07-15 13:20:51 -06:00
"
);
sub no_reply($) {
2017-07-15 13:20:51 -06:00
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 @_;
close TTY;
system "stty $old";
}
sub get_reply($) {
2017-07-15 13:20:51 -06:00
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";
if ( defined $reply ) {
die("^C received\n") if ( "$reply" eq "\003" );
}
return $reply;
}
sub query_color($) {
2017-07-15 13:20:51 -06:00
my $code = $_[0];
my $param1 = $code + 10;
my $reply;
2017-07-15 13:20:51 -06:00
$reply = get_reply("\x1b]$param1;?\007");
2017-07-15 13:20:51 -06:00
return unless defined $reply;
if ( $reply =~ /\x1b]$param1;.*\007/ ) {
my $value = $reply;
2017-07-15 13:20:51 -06:00
$value =~ s/^\x1b]$param1;//;
$value =~ s/\007//;
2017-07-15 13:20:51 -06:00
printf "%24s = %s\n", $color_names[$code], $value;
}
}
sub query_colors() {
2017-07-15 13:20:51 -06:00
my $n;
2017-07-15 13:20:51 -06:00
for ( $n = 0 ; $n <= 9 ; ++$n ) {
&query_color($n);
}
}
sub reset_colors() {
2017-07-15 13:20:51 -06:00
my $n;
2017-07-15 13:20:51 -06:00
for ( $n = 0 ; $n <= 9 ; ++$n ) {
my $code = 110 + $n;
&no_reply("\x1b]$code\007");
}
}
2017-07-15 13:20:51 -06:00
if ( defined($opt_c) ) {
&no_reply("\x1b]12;$opt_c\007");
}
2017-07-15 13:20:51 -06:00
if ( defined($opt_r) ) {
&reset_colors();
}
&query_colors();