1#!/usr/bin/env perl
2# $XTermId: query-xres.pl,v 1.6 2019/10/06 23:56:18 tom Exp $
3# -----------------------------------------------------------------------------
4# this file is part of xterm
5#
6# Copyright 2019 by Thomas E. Dickey
7#
8#                         All Rights Reserved
9#
10# Permission is hereby granted, free of charge, to any person obtaining a
11# copy of this software and associated documentation files (the
12# "Software"), to deal in the Software without restriction, including
13# without limitation the rights to use, copy, modify, merge, publish,
14# distribute, sublicense, and/or sell copies of the Software, and to
15# permit persons to whom the Software is furnished to do so, subject to
16# the following conditions:
17#
18# The above copyright notice and this permission notice shall be included
19# in all copies or substantial portions of the Software.
20#
21# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
22# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
23# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
24# IN NO EVENT SHALL THE ABOVE LISTED COPYRIGHT HOLDER(S) BE LIABLE FOR ANY
25# CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
26# TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
27# SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
28#
29# Except as contained in this notice, the name(s) of the above copyright
30# holders shall not be used in advertising or otherwise to promote the
31# sale, use or other dealings in this Software without prior written
32# authorization.
33# -----------------------------------------------------------------------------
34# Report features enabled/disabled via resource-settings
35
36# TODO: handle 8-bit controls
37
38use strict;
39use warnings;
40
41use Getopt::Std;
42use IO::Handle;
43
44our ( $opt_a, $opt_d, $opt_e, $opt_m, $opt_q );
45
46our @query_params;
47our @query_result;
48
49$Getopt::Std::STANDARD_HELP_VERSION = 1;
50&getopts('acdemq') || die(
51    "Usage: $0 [options]\n
52Options:\n
53  -a      (same as -d -e -m)
54  -d      query disabled/disallowed features
55  -e      query enabled/allowed features
56  -m      query modified keys
57  -q      quicker results by merging queries
58"
59);
60
61if (
62    $#ARGV < 0
63    and not( defined($opt_d)
64        or defined($opt_e)
65        or defined($opt_m) )
66  )
67{
68    $opt_a = 1;
69}
70
71sub get_reply($) {
72    open TTY, "+</dev/tty" or die("Cannot open /dev/tty\n");
73    autoflush TTY 1;
74    my $old = `stty -g`;
75    system "stty raw -echo min 0 time 5";
76
77    print TTY @_;
78    my $reply = <TTY>;
79    close TTY;
80    system "stty $old";
81    if ( defined $reply ) {
82        die("^C received\n") if ( "$reply" eq "\003" );
83    }
84    return $reply;
85}
86
87sub hexified($) {
88    my $value  = $_[0];
89    my $result = "";
90    my $n;
91
92    for ( $n = 0 ; $n < length($value) ; ++$n ) {
93        $result .= sprintf( "%02X", ord substr( $value, $n, 1 ) );
94    }
95    return $result;
96}
97
98sub begin_query() {
99    @query_params = ();
100}
101
102sub add_param($) {
103    $query_params[ $#query_params + 1 ] = &hexified( $_[0] );
104}
105
106sub finish_query() {
107    my $reply = &get_reply( "\x1bP+Q" . join( ';', @query_params ) . "\x1b\\" );
108
109    return unless defined $reply;
110    while ( $reply =~ /\x1bP1\+R[[:xdigit:]]+[=;][[:xdigit:]]*.*\x1b\\/ ) {
111        my $n;
112        my $parse;
113
114        $reply =~ s/^\x1bP1\+R//;
115        $parse = $reply;
116        $reply =~ s/\x1b\\.*$//;
117        $parse = substr( $parse, length($reply) );
118        $parse =~ s/^\x1b\\//;
119
120        my $result = "";
121        my $count  = 0;
122        my $state  = 0;
123        my $error  = "?";
124        for ( $n = 0 ; $n < length($reply) ; ) {
125            my $c = substr( $reply, $n, 1 );
126
127            if ( $c eq ';' ) {
128                $n += 1;
129                printf "%d%s\t%s\n", $count, $error, $result
130                  if ( $result ne "" );
131                $result = "";
132                $state  = 0;
133                $error  = "?";
134                $count++;
135            }
136            elsif ( $c eq '=' ) {
137                $error = ""
138                  if (  $count <= $#query_params
139                    and &hexified($result) eq $query_params[$count] );
140                $n += 1;
141                $result .= $c;
142                $state = 1;
143            }
144            elsif ( $c =~ /[[:punct:]]/ ) {
145                $n += 1;
146                $result .= $c;
147            }
148            else {
149                my $k = hex substr( $reply, $n, 2 );
150                if ( $k == 0x1b ) {
151                    $result .= "\\E";
152                }
153                elsif ( $k == 0x7f ) {
154                    $result .= "^?";
155                }
156                elsif ( $k == 32 ) {
157                    $result .= "\\s";
158                }
159                elsif ( $k < 32 ) {
160                    $result .= sprintf( "^%c", $k + 64 );
161                }
162                elsif ( $k > 128 ) {
163                    $result .= sprintf( "\\%03o", $k );
164                }
165                else {
166                    $result .= chr($k);
167                }
168                $n += 2;
169            }
170        }
171        printf "%d%s\t%s\n", $count, $error, $result if ( $result ne "" );
172        $reply = $parse;
173    }
174}
175
176sub do_query($) {
177    my $name = shift;
178
179    &begin_query unless ($opt_q);
180    &add_param($name);
181    &finish_query unless ($opt_q);
182}
183
184&begin_query if ($opt_q);
185
186while ( $#ARGV >= 0 ) {
187    &do_query( shift @ARGV );
188}
189
190if ( defined($opt_a) || defined($opt_d) ) {
191    &do_query("disallowedColorOps");
192    &do_query("disallowedFontOps");
193    &do_query("disallowedMouseOps");
194    &do_query("disallowedPasteControls");
195    &do_query("disallowedTcapOps");
196    &do_query("disallowedWindowOps");
197}
198
199if ( defined($opt_a) ) {
200    &do_query("allowSendEvents");
201    &do_query("allowPasteControls");
202    &do_query("allowC1Printable");
203    &do_query("saveLines");
204}
205
206if ( defined($opt_a) || defined($opt_e) ) {
207    &do_query("allowColorOps");
208    &do_query("allowFontOps");
209    &do_query("allowMouseOps");
210    &do_query("allowPasteControls");
211    &do_query("allowTcapOps");
212    &do_query("allowTitleOps");
213    &do_query("allowWindowOps");
214}
215
216if ( defined($opt_a) || defined($opt_m) ) {
217    &do_query("formatOtherKeys");
218    &do_query("modifyCursorKeys");
219    &do_query("modifyFunctionKeys");
220    &do_query("modifyKeyboard");
221    &do_query("modifyOtherKeys");
222}
223
224&finish_query if ($opt_q);
225
2261;
227