1#!/usr/bin/perl -w 2# $XTermId: nrcs.pl,v 1.10 2013/09/08 19:46:07 tom Exp $ 3# ----------------------------------------------------------------------------- 4# this file is part of xterm 5# 6# Copyright 2013 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# This is a more direct way of exercising character sets than vttest. 35 36use strict; 37use File::Temp qw/ tempdir /; 38 39our $prepare_GL = "\x1bo"; # Invoke the G3 Character Set as GL (LS3). 40our $prepare_GR = "\x1b|"; # Invoke the G3 Character Set as GR (LS3R). 41our $restore_GL = "\017"; # Invoke the G1 Character Set as GR (LS1R). 42our $restore_GR = "\x1b~"; # Invoke the G1 Character Set as GR (LS1R). 43our $enable_NRC = "\x1b[?42h"; 44 45our $dummy; 46our %level; 47our %suffix; 48our %short_name; 49our %long_name; 50 51sub select_G3() { 52 printf "\x1b+%s", shift; 53} 54 55sub show_charset($) { 56 my $alias = shift; 57 my $suffix = $suffix{$alias}; 58 return if not $suffix; 59 printf $enable_NRC; 60 61 &select_G3($suffix); 62 printf $prepare_GL; 63 printf $prepare_GR; 64 65 printf "GL:\n"; 66 for my $n ( 32 .. 126 ) { 67 print chr($n); 68 printf "\n" if ( ( ( $n + 1 ) % 32 ) == 0 ); 69 } 70 printf "\nGR:\n"; 71 for my $n ( 160 .. 255 ) { 72 print chr($n); 73 printf "\n" if ( ( ( $n + 1 ) % 32 ) == 0 ); 74 } 75 76 do { 77 $dummy = `sh -c 'read dummy; echo "\$dummy"'`; 78 chomp $dummy; 79 } until $dummy =~ /^\s*$/; 80 81 printf $restore_GL; 82 printf $restore_GR; 83} 84 85sub list_charset($$$$) { 86 my $level = shift; 87 my $suffix = shift; 88 my $short_name = shift; 89 my $long_name = shift; 90 my $alias = lc $short_name; 91 $level{$alias} = $level; 92 $suffix{$alias} = $suffix; 93 $short_name{$alias} = $short_name; 94 $long_name{$alias} = $long_name; 95} 96 97sub initialize() { 98 &list_charset( 1, '0', "graphic", "DEC Line Drawing Set" ); 99 &list_charset( 2, '<', "supp", "DEC Supplementary" ); 100 &list_charset( 3, '%5', "supp_graphic", "DEC Supplementary Graphics" ); 101 &list_charset( 3, '>', "technical", "DEC Technical" ); 102 &list_charset( 3, 'A', "latin_1", "United Kingdom (UK)" ); 103 &list_charset( 1, 'B', "ascii", "United States (USASCII)" ); 104 &list_charset( 2, '4', "dutch", "Dutch" ); 105 &list_charset( 2, '5', "finnish", "Finnish" ); 106 &list_charset( 2, 'C', "finnish2", "Finnish" ); 107 &list_charset( 2, 'R', "french", "French" ); 108 &list_charset( 2, 'f', "french2", "French" ); 109 &list_charset( 2, 'Q', "canadian", "French Canadian " ); 110 &list_charset( 2, '9', "canadian2", "French Canadian " ); 111 &list_charset( 2, 'K', "german", "German" ); 112 &list_charset( 2, 'Y', "italian", "Italian" ); 113 &list_charset( 3, '`', "danish", "Norwegian/Danish " ); 114 &list_charset( 2, 'E', "danish2", "Norwegian/Danish" ); 115 &list_charset( 2, '6', "danish3", "Norwegian/Danish" ); 116 &list_charset( 3, '%6', "portuguese", "Portuguese " ); 117 &list_charset( 2, 'Z', "spanish", "Spanish" ); 118 &list_charset( 2, '7', "swedish", "Swedish" ); 119 &list_charset( 2, 'H', "swedish2", "Swedish" ); 120 &list_charset( 2, '=', "swiss", "Swiss" ); 121} 122 123sub show_dialog() { 124 my $dir = tempdir( CLEANUP => 1 ); 125 my $in_file = "$dir/input"; 126 my $out_file = "$dir/output"; 127 my $exe_file = "$dir/script"; 128 my $rc_file = "$dir/status"; 129 my $output = ""; 130 my $status; 131 do { 132 open( FP, ">$in_file" ) || die("cannot create $in_file"); 133 print FP "#!/bin/sh\n"; 134 print FP "dialog"; 135 printf FP "\\\n\t--default-item \"%s\"", $output if ( $output ne "" ); 136 print FP "\\\n\t--menu \"Select a character set\" 0 0 0 "; 137 138 foreach my $key ( sort keys %short_name ) { 139 printf FP "\\\n\t%s \"VT%d00: %s\"", $short_name{$key}, 140 $level{$key}, 141 $long_name{$key}; 142 } 143 printf FP "\\\n 2>$out_file\n"; 144 printf FP "echo \$? >$rc_file\n"; 145 close FP; 146 chmod 0700, $in_file; 147 system("$in_file"); 148 $output = `cat $out_file`; 149 $status = `cat $rc_file`; 150 chomp $output; 151 chomp $status; 152 &show_charset($output) if ( $status == 0 ); 153 } while ( $status ne "" and $status == 0 ); 154} 155 156&initialize; 157if ( $#ARGV >= 0 ) { 158 while ( $#ARGV >= 0 ) { 159 &show_charset( shift @ARGV ); 160 } 161} 162else { 163 &show_dialog; 164} 165