query-fonts.pl revision e0a2b6df 
1#!/usr/bin/env perl
2# $XTermId: query-fonts.pl,v 1.6 2014/02/26 20:14:50 tom Exp $
3# -----------------------------------------------------------------------------
4# this file is part of xterm
5#
6# Copyright 2010,2014 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# Test the font-query features of xterm.
35
36# TODO:
37# test relative vs absolute font numbering
38# test all font-slots
39# test selection
40# test bold / wide / widebold
41# test actual fontname vs nominal
42# extend "CSI > Ps; Ps T" to query fontname in hex
43
44use strict;
45use warnings;
46
47use Getopt::Std;
48use IO::Handle;
49
50our ( $opt_a, $opt_r, $opt_s );
51&getopts('ars') || die(
52    "Usage: $0 [options]\n
53Options:\n
54  -a      test using absolute numbers
55  -r      test using relative numbers
56  -s      use ^G rather than ST
57"
58);
59
60our $ST = $opt_s ? "\007" : "\x1b\\";
61
62sub no_reply($) {
63    open TTY, "+</dev/tty" or die("Cannot open /dev/tty\n");
64    autoflush TTY 1;
65    my $old = `stty -g`;
66    system "stty raw -echo min 0 time 5";
67
68    print TTY @_;
69    close TTY;
70    system "stty $old";
71}
72
73sub get_reply($) {
74    open TTY, "+</dev/tty" or die("Cannot open /dev/tty\n");
75    autoflush TTY 1;
76    my $old = `stty -g`;
77    system "stty raw -echo min 0 time 5";
78
79    print TTY @_;
80    my $reply = <TTY>;
81    close TTY;
82    system "stty $old";
83    if ( defined $reply ) {
84        die("^C received\n") if ( "$reply" eq "\003" );
85    }
86    return $reply;
87}
88
89sub query_font($) {
90    my $param = $_[0];
91    my $reply;
92    my $n;
93    my $st    = $opt_s ? qr/\007/ : qr/\x1b\\/;
94    my $osc   = qr/\x1b]50/;
95    my $match = qr/${osc}.*${st}/;
96
97    $reply = get_reply( "\x1b]50;?" . $param . $ST );
98
99    printf "query{%s}%*s", $param, 3 - length($param), " ";
100
101    if ( defined $reply ) {
102        printf "%2d ", length($reply);
103        if ( $reply =~ /${match}/ ) {
104
105            $reply =~ s/^${osc}//;
106            $reply =~ s/^;//;
107            $reply =~ s/${st}$//;
108        }
109        else {
110            printf "? ";
111        }
112
113        my $result = "";
114        for ( $n = 0 ; $n < length($reply) ; ) {
115            my $c = substr( $reply, $n, 1 );
116            if ( $c =~ /[[:print:]]/ ) {
117                $result .= $c;
118            }
119            else {
120                my $k = ord substr( $reply, $n, 1 );
121                if ( ord $k == 0x1b ) {
122                    $result .= "\\E";
123                }
124                elsif ( $k == 0x7f ) {
125                    $result .= "^?";
126                }
127                elsif ( $k == 32 ) {
128                    $result .= "\\s";
129                }
130                elsif ( $k < 32 ) {
131                    $result .= sprintf( "^%c", $k + 64 );
132                }
133                elsif ( $k > 128 ) {
134                    $result .= sprintf( "\\%03o", $k );
135                }
136                else {
137                    $result .= chr($k);
138                }
139            }
140            $n += 1;
141        }
142
143        printf "{%s}", $result;
144    }
145    printf "\n";
146}
147
148if ($opt_r) {
149    my $n;
150    query_font("-");
151    foreach $n ( 0 .. 5 ) {
152        query_font( sprintf "-%d", $n );
153    }
154    query_font("+");
155    foreach $n ( 0 .. 5 ) {
156        query_font( sprintf "+%d", $n );
157    }
158}
159if ($opt_a) {
160    my $n;
161    foreach $n ( 0 .. 5 ) {
162        query_font( sprintf "%d", $n );
163    }
164}
165if ( not $opt_a and not $opt_r ) {
166    query_font("");
167}
168