1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
|
#!/usr/bin/perl -pi.bak
use warnings;
use strict;
use Sys::Hostname;
use Cwd 'abs_path';
BEGIN
{
my $xset;
$xset = $ENV{"XSET"} or $xset = "xset";
my $xdpyinfo;
$xdpyinfo = $ENV{"XDPYINFO"} or $xdpyinfo = "xdpyinfo";
my $tet_root;
$tet_root = $ENV{"TET_ROOT"} or $tet_root = "%DEFAULT_TET_ROOT%";
$tet_root = abs_path($tet_root);
open(XSET, "$xset q |") or die "$xset q failed, giving up.\n";
while(<XSET>)
{
next unless /^Font Path:/;
<XSET> =~ /^\s*(.*)/;
$::vars{"XT_FONTPATH"} = $tet_root . '/xts5/fonts,' . $1;
$::vars{"XT_FONTPATH_GOOD"} = $1;
}
close(XSET);
die "$xset q failed, giving up.\n" if $?;
open(INFO, "$xdpyinfo |") or die "$xdpyinfo failed, giving up.\n";
my @xdpyinfopats = (
[qr/^name of display:\s*(.*)/, qw(DISPLAY)],
[qr/^version number:\s*(\d+)\.(\d+)/, qw(XT_PROTOCOL_VERSION XT_PROTOCOL_REVISION)],
[qr/^vendor string:\s*(.*)/, qw(XT_SERVER_VENDOR)],
[qr/^vendor release number:\s*(\d+)/, qw(XT_VENDOR_RELEASE)],
[qr/^motion buffer size:\s*(\d+)/, qw(XT_DISPLAYMOTIONBUFFERSIZE)],
[qr/^default screen number:\s*(\d+)/, qw(screen)],
[qr/^number of screens:\s*(\d+)/, qw(XT_SCREEN_COUNT)],
[qr/^ dimensions:\s*\d+x\d+ pixels \((\d+)x(\d+) millimeters\)/, qw(XT_WIDTH_MM XT_HEIGHT_MM)],
[qr/^ preallocated pixels:\s*black (\d+), white (\d+)/, qw(XT_BLACK_PIXEL XT_WHITE_PIXEL)],
[qr/^ options:\s*backing-store (.*), save-unders (.*)/, qw(XT_DOES_BACKING_STORE XT_DOES_SAVE_UNDERS)],
[qr/^ depths.*:\s*(.*)/, qw(XT_PIXMAP_DEPTHS)],
);
my $skip = 0;
my %visuals = ();
while(<INFO>)
{
if(/^screen #(\d+):$/)
{
$skip = ($1 != $::vars{"screen"});
}
elsif($skip)
{
next;
}
elsif(/^ class:\s*(.*)/)
{
my $class = $1;
<INFO> =~ /^ depth:\s*(\d+) planes/;
$visuals{"$class($1)"} = 1;
}
else
{
foreach my $pat (@xdpyinfopats)
{
my ($re, @vars) = @$pat;
my @match = /$re/;
next unless @match;
@::vars{@vars} = @match;
last;
}
}
}
close(INFO);
die "$xdpyinfo failed, giving up.\n" if $?;
$::vars{"XT_VISUAL_CLASSES"} = join ' ', keys %visuals;
if($::vars{"DISPLAY"} =~ /^:\d+(\.\d+)?$/)
{
$::vars{"XT_LOCAL"} = "Yes";
my $hostname = hostname();
# have xdpyinfo try connecting to the same display via TCP;
# just check its exit status.
$ENV{"DISPLAY"} = $hostname . $::vars{"DISPLAY"};
open(INFO, "$xset q 2>/dev/null |") or die "$xset q on TCP failed, giving up.\n";
<INFO>; # discard output
close(INFO);
if(not $?)
{
$::vars{"XT_TCP"} = "Yes";
$::vars{"XT_DISPLAYHOST"} = $hostname;
}
else
{
$::vars{"XT_TCP"} = "No";
$::vars{"XT_DISPLAYHOST"} = "";
}
}
else
{
$::vars{"XT_TCP"} = "Yes";
my $hostname = "";
my $offset = rindex($::vars{"DISPLAY"}, ':');
if ($offset >= 0) {
$hostname = substr($::vars{"DISPLAY"}, 0, $offset);
}
$::vars{"XT_DISPLAYHOST"} = $hostname;
# Not a local display; admin is responsible for placing
# xtest fonts on the font path before running xts-config.
$::vars{"XT_FONTPATH"} = $::vars{"XT_FONTPATH_GOOD"};
my @fp = split(/,/, $::vars{"XT_FONTPATH"});
# Remove xtest directory
my @fpg = grep(!/xtest/i, @fp);
# If xtest directory is not called "xtest", remove the
# last directory in the path (as it's less likely to
# be the path containing "default"/"cursor" than the
# first directory in the path).
pop @fpg if (scalar(@fp) == scalar(@fpg));
$::vars{"XT_FONTPATH_GOOD"} = join(',', @fpg);
}
if($::vars{"XT_SCREEN_COUNT"} > 1)
{
$::vars{"XT_ALT_SCREEN"} = ($::vars{"screen"} == 0) ? 1 : 0;
}
else
{
$::vars{"XT_ALT_SCREEN"} = "UNSUPPORTED";
}
$::vars{"XT_PIXMAP_DEPTHS"} =~ s/,?\s+/ /g;
foreach my $var (qw(TET_EXEC_IN_PLACE XT_EXTENSIONS
XT_DOES_BACKING_STORE XT_DOES_SAVE_UNDERS
XT_POSIX_SYSTEM XT_TCP XT_LOCAL
XT_SAVE_SERVER_IMAGE XT_OPTION_NO_CHECK XT_OPTION_NO_TRACE
XT_DEBUG_OVERRIDE_REDIRECT XT_DEBUG_PAUSE_AFTER
XT_DEBUG_PIXMAP_ONLY XT_DEBUG_WINDOW_ONLY
XT_DEBUG_DEFAULT_DEPTHS XT_DEBUG_NO_PIXCHECK))
{
$::vars{$var} = ucfirst (lc $::vars{$var}) if exists $::vars{$var};
}
delete $::vars{"screen"};
%::savedvars = %::vars;
}
if(/^[ \t]*([A-Za-z0-9_]*)=/ and exists $::vars{$1})
{
$_ = "$1=$::vars{$1}\n";
delete $::vars{$1};
}
if(eof)
{
if(keys %::vars)
{
$_ .= "\n# Undocumented variables:\n\n";
foreach my $var (keys %::vars)
{
$_ .= $var . "=" . $::vars{$var} . "\n";
}
}
%::vars = %::savedvars;
}
|
