"Fossies" - the Fresh Open Source Software Archive

Member "xterm-379/vttests/nrcs.pl" (8 Sep 2013, 5859 Bytes) of package /linux/misc/xterm-379.tgz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "nrcs.pl" see the Fossies "Dox" file reference documentation.

    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 
   36 use strict;
   37 use File::Temp qw/ tempdir /;
   38 
   39 our $prepare_GL = "\x1bo";       # Invoke the G3 Character Set as GL (LS3).
   40 our $prepare_GR = "\x1b|";       # Invoke the G3 Character Set as GR (LS3R).
   41 our $restore_GL = "\017";        # Invoke the G1 Character Set as GR (LS1R).
   42 our $restore_GR = "\x1b~";       # Invoke the G1 Character Set as GR (LS1R).
   43 our $enable_NRC = "\x1b[?42h";
   44 
   45 our $dummy;
   46 our %level;
   47 our %suffix;
   48 our %short_name;
   49 our %long_name;
   50 
   51 sub select_G3() {
   52     printf "\x1b+%s", shift;
   53 }
   54 
   55 sub 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 
   85 sub 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 
   97 sub 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 
  123 sub 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;
  157 if ( $#ARGV >= 0 ) {
  158     while ( $#ARGV >= 0 ) {
  159         &show_charset( shift @ARGV );
  160     }
  161 }
  162 else {
  163     &show_dialog;
  164 }