"Fossies" - the Fresh Open Source Software Archive

Member "xterm-379/gen-pc-fkeys.pl" (30 Nov 2007, 10620 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 "gen-pc-fkeys.pl" see the Fossies "Dox" file reference documentation.

    1 #! /usr/bin/perl -w
    2 # $XTermId: gen-pc-fkeys.pl,v 1.22 2007/11/30 23:03:55 tom Exp $
    3 # -----------------------------------------------------------------------------
    4 # this file is part of xterm
    5 #
    6 # Copyright 2004-2005,2007 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 #
   35 # Construct a list of function-key definitions corresponding to xterm's
   36 # Sun/PC keyboard.  This uses ncurses' infocmp to obtain the strings (including
   37 # extensions) to modify (and verify).
   38 use strict;
   39 
   40 my($max_modifier, $terminfo);
   41 my(@old_fkeys, $opt_fkeys, $min_fkeys, $max_fkeys);
   42 my(%old_ckeys, $opt_ckeys, $min_ckeys, $max_ckeys);
   43 my(%old_ekeys, $opt_ekeys, $min_ekeys, $max_ekeys);
   44 
   45 my(@ckey_names);
   46 @ckey_names = (
   47     'kcud1', 'kcub1', 'kcuf1', 'kcuu1', # 1 = no modifiers
   48     'kDN',   'kLFT',  'kRIT',  'kUP',   # 2 = shift
   49     # make_ckey_names() repeats this row, appending the modifier code
   50     );
   51 my %ckey_names;
   52 my(@ckey_known);
   53 @ckey_known = (
   54     'kind',  'kLFT',  'kRIT',  'kri',   # 2 = shift (standard)
   55     );
   56 
   57 my(@ekey_names);
   58 @ekey_names = (
   59     'khome', 'kend',  'knp',   'kpp',   'kdch1', 'kich1', # 1 = no modifiers
   60     'kHOM',  'kEND',  'kNXT',  'kPRV',  'kDC',   'kIC',   # 2 = shift
   61     # make_ekey_names() repeats this row, appending the modifier code
   62 );
   63 my %ekey_names;
   64 
   65 $min_fkeys=12;      # the number of "real" function keys on your keyboard
   66 $max_fkeys=64;      # the number of function-keys terminfo can support
   67 $max_modifier=8;    # modifier 1 + (1=shift, 2=alt, 4=control 8=meta)
   68 
   69 $min_ckeys=4;       # the number of "real" cursor keys on your keyboard
   70 $max_ckeys=($min_ckeys * ($max_modifier - 1));
   71 
   72 $min_ekeys=6;       # the number of "real" editing keys on your keyboard
   73 $max_ekeys=($min_ekeys * ($max_modifier - 1));
   74 
   75 $opt_ckeys=2;       # xterm's modifyCursorKeys resource
   76 $opt_ekeys=2;       # xterm's modifyCursorKeys resource
   77 $opt_fkeys=2;       # xterm's modifyFunctionKeys resource
   78 $terminfo="xterm-new";  # the terminfo entry to use
   79 
   80 # apply the given modifier to the terminfo string, return the result
   81 sub modify_fkey($$$) {
   82     my $code = $_[0];
   83     my $text = $_[1];
   84     my $opts = $_[2];
   85     if (not defined($text)) {
   86         $text = "";
   87     } elsif ($code != 1) {
   88         $text =~ s/\\EO/\\E\[/ if ($opts >= 1);
   89 
   90         my $piece = substr $text, 0, length ($text) - 1;
   91         my $final = substr $text, length ($text) - 1;
   92         my $check = substr $piece, length ($piece) - 1;
   93         if ($check =~ /[0-9]/) {
   94             $code = ";" . $code;
   95         } elsif ( $check =~ /\[/ and $opts >= 2) {
   96             $code = "1;" . $code;
   97         }
   98         if ( $opts >= 3 ) {
   99             $code = ">" . $code;
  100         }
  101         $text = $piece . $code . $final;
  102         $text =~ s/([\d;]+)>/>$1/;
  103     }
  104     return $text;
  105 }
  106 
  107 # compute the next modifier value -
  108 # Cycling through the modifiers is not just like counting.  Users prefer
  109 # pressing one modifier (even if using Emacs).  So first we cycle through
  110 # the individual modifiers, then for completeness two, three, etc.
  111 sub next_modifier {
  112     my $code = $_[0];
  113     my $mask = $code - 1;
  114     if ($mask == 0) {
  115         $mask = 1;  # shift
  116     } elsif ($mask == 1) {
  117         $mask = 4;  # control
  118     } elsif ($mask == 2) {
  119         $mask = 3;  # shift+alt
  120     } elsif ($mask == 4) {
  121         $mask = 5;  # shift+control
  122     } elsif ($mask == 5) {
  123         $mask = 2;  # alt
  124     }
  125     # printf ("# next_modifier(%d) = %d\n", $code, $mask + 1);
  126     return $mask + 1;
  127 }
  128 
  129 sub make_ckey_names() {
  130     my ($j, $k);
  131     my $min = $min_ckeys * 2;
  132     my $max = $max_ckeys - 1;
  133 
  134     # printf "# make_ckey_names\n";
  135     for $j ($min..$max) {
  136         $k = 1 + substr($j / $min_ckeys, 0, 1);
  137         $ckey_names[$j] = $ckey_names[$min_ckeys + ($j % $min_ckeys)] . $k;
  138         # printf "# make %d:%s\n", $j, $ckey_names[$j];
  139     }
  140     for $j (0..$#ckey_names) {
  141         # printf "# %d:%s\n", $j, $ckey_names[$j];
  142         $ckey_names{$ckey_names[$j]} = $j;
  143     }
  144 }
  145 
  146 sub make_ekey_names() {
  147     my ($j, $k);
  148     my $min = $min_ekeys * 2;
  149     my $max = $max_ekeys - 1;
  150 
  151     # printf "# make_ekey_names\n";
  152     for $j ($min..$max) {
  153         $k = 1 + substr($j / $min_ekeys, 0, 1);
  154         $ekey_names[$j] = $ekey_names[$min_ekeys + ($j % $min_ekeys)] . $k;
  155         # printf "# make %d:%s\n", $j, $ekey_names[$j];
  156     }
  157     for $j (0..$#ekey_names) {
  158         # printf "# %d:%s\n", $j, $ekey_names[$j];
  159         $ekey_names{$ekey_names[$j]} = $j;
  160     }
  161 }
  162 
  163 # Read the terminfo entry's list of function keys $old_fkeys[].
  164 # We could handle $old_fkeys[0], but choose to start numbering from 1.
  165 sub readterm($) {
  166     my $term = $_[0];
  167     my($key, $n, $str);
  168     my(@list) = `infocmp -x -1 $term`;
  169 
  170     for $n (0..$#list) {
  171         chop $list[$n];
  172         $list[$n] =~ s/^[[:space:]]//;
  173 
  174         $key = $list[$n];
  175         $key =~ s/=.*//;
  176 
  177         $str = $list[$n];
  178         $str =~ s/^[^=]+=//;
  179         $str =~ s/,$//;
  180 
  181         if ( $list[$n] =~ /^kf[[:digit:]]+=/ ) {
  182             $key =~ s/^kf//;
  183             # printf "# $n:%s(%d)(%s)\n", $list[$n], $key, $str;
  184             $old_fkeys[$key] = $str;
  185         } elsif ( $key =~ /^kc[[:alpha:]]+1/
  186             or $key =~ /^k(LFT|RIT|UP|DN)\d?/) {
  187             # printf "# $n:%s(%d)(%s)\n", $list[$n], $key, $str;
  188             $old_ckeys{$key} = $str;
  189         } elsif ( defined $ekey_names{$key} ) {
  190             # printf "# $n:%s(%s)(%s)\n", $list[$n], $key, $str;
  191             $old_ekeys{$key} = $str;
  192         }
  193     }
  194     # printf ("last index:%d\n", $#old_fkeys);
  195 }
  196 
  197 # read the whole terminfo to ensure we get the non-modified stuff, then read
  198 # the part that contains modifiers.
  199 sub read_part($) {
  200     my $part = $_[0];
  201 
  202     %old_ckeys = ();
  203     @old_fkeys = ();
  204     readterm($terminfo);
  205     readterm($part);
  206 }
  207 
  208 sub nameof_ckeys($) {
  209     my $opts = $_[0];
  210     my $optname = "xterm+pcc" . ($opts >= 0 ? $opts : "n");
  211     return $optname;
  212 }
  213 
  214 sub generate_ckeys($) {
  215     my $opts = $_[0];
  216     my($modifier, $cur_ckey, $index);
  217 
  218     printf "%s|fragment with modifyCursorKeys:%s,\n",
  219         nameof_ckeys($opts), $opts;
  220 
  221     # show the standard cursor definitions
  222     $modifier = 1;
  223     for ($index = 0; $index < $min_ckeys; ++$index) {
  224         $cur_ckey = $index + ($modifier * $min_ckeys);
  225         my $name = $ckey_known[$index];
  226         my $input = $old_ckeys{$ckey_names[$index]};
  227         my $result = modify_fkey($modifier + 1, $input, $opts);
  228         printf "\t%s=%s,\n", $name, $result;
  229         if (defined $old_ckeys{$name}) {
  230             if ($old_ckeys{$name} ne $result) {
  231                 printf "# found %s=%s\n", $name, $old_ckeys{$name};
  232             }
  233         }
  234     }
  235 
  236     # show the extended cursor definitions
  237     for ($index = 0; $index < $min_ckeys; ++$index) {
  238         for ($modifier = 1; $modifier < $max_modifier; ++$modifier) {
  239             $cur_ckey = $index + ($modifier * $min_ckeys);
  240             if (defined $ckey_names[$cur_ckey] and
  241                 $ckey_names[$cur_ckey] ne "kLFT" and
  242                 $ckey_names[$cur_ckey] ne "kRIT" ) {
  243                 my $name = $ckey_names[$cur_ckey];
  244                 my $input = $old_ckeys{$ckey_names[$index]};
  245                 my $result = modify_fkey($modifier + 1, $input, $opts);
  246                 printf "\t%s=%s,\n", $name, $result;
  247                 if (defined $old_ckeys{$name}) {
  248                     if ($old_ckeys{$name} ne $result) {
  249                         printf "# found %s=%s\n", $name, $old_ckeys{$name};
  250                     }
  251                 }
  252             }
  253         }
  254     }
  255 }
  256 
  257 sub nameof_ekeys($) {
  258     my $opts = $_[0];
  259     my $optname = "xterm+pce" . ($opts >= 0 ? $opts : "n");
  260     return $optname;
  261 }
  262 
  263 sub generate_ekeys($) {
  264     my $opts = $_[0];
  265     my($modifier, $cur_ekey, $index);
  266 
  267     printf "%s|fragment with modifyCursorKeys:%s,\n",
  268         nameof_ekeys($opts), $opts;
  269 
  270     for ($index = 0; $index < $min_ekeys; ++$index) {
  271         for ($modifier = 1; $modifier < $max_modifier; ++$modifier) {
  272             $cur_ekey = $index + ($modifier * $min_ekeys);
  273             if (defined $ekey_names[$cur_ekey] ) {
  274                 my $name = $ekey_names[$cur_ekey];
  275                 my $input = $old_ekeys{$ekey_names[$index]};
  276                 my $result = modify_fkey($modifier + 1, $input, $opts);
  277                 printf "\t%s=%s,\n", $name, $result;
  278                 if (defined $old_ekeys{$name}) {
  279                     if ($old_ekeys{$name} ne $result) {
  280                         printf "# found %s=%s\n", $name, $old_ekeys{$name};
  281                     }
  282                 }
  283             }
  284         }
  285     }
  286 }
  287 
  288 sub nameof_fkeys($) {
  289     my $opts = $_[0];
  290     my $optname = "xterm+pcf" . ($opts >= 0 ? $opts : "n");
  291     return $optname;
  292 }
  293 
  294 sub generate_fkeys($) {
  295     my $opts = $_[0];
  296     my($modifier, $cur_fkey);
  297 
  298     printf "%s|fragment with modifyFunctionKeys:%s and ctrlFKeys:10,\n",
  299         nameof_fkeys($opts), $opts;
  300 
  301     for ($cur_fkey = 1, $modifier = 1; $cur_fkey < $max_fkeys; ++$cur_fkey) {
  302         my $index = (($cur_fkey - 1) % $min_fkeys);
  303         if ($index == 0 && $cur_fkey != 1) {
  304             $modifier = next_modifier($modifier);
  305         }
  306         if (defined $old_fkeys[$index + 1]) {
  307             my $input = $old_fkeys[$index + 1];
  308             my $result = modify_fkey($modifier, $input, $opts);
  309             printf "\tkf%d=%s,\n", $cur_fkey, $result;
  310             if (defined $old_fkeys[$cur_fkey]) {
  311                 if ($old_fkeys[$cur_fkey] ne $result) {
  312                     printf "# found kf%d=%s\n", $cur_fkey, $old_fkeys[$cur_fkey];
  313                 }
  314             }
  315         }
  316     }
  317 }
  318 
  319 sub show_default() {
  320     readterm($terminfo);
  321 
  322     printf "xterm+pcfkeys|fragment for PC-style keys,\n";
  323     printf "\tuse=%s,\n", nameof_ckeys($opt_ckeys);
  324     printf "\tuse=%s,\n", nameof_ekeys($opt_ekeys);
  325     printf "\tuse=%s,\n", nameof_fkeys($opt_fkeys);
  326 
  327     generate_ckeys($opt_ckeys);
  328     generate_ekeys($opt_ekeys);
  329     generate_fkeys($opt_fkeys);
  330 }
  331 
  332 sub show_nondefault()
  333 {
  334     my $opts;
  335 
  336     for ($opts = 0; $opts <= 3; ++$opts) {
  337         if ($opts != $opt_ckeys) {
  338             read_part(nameof_ckeys($opts));
  339             generate_ckeys($opts);
  340         }
  341     }
  342 
  343     for ($opts = 0; $opts <= 3; ++$opts) {
  344         if ($opts != $opt_ekeys) {
  345             read_part(nameof_ekeys($opts));
  346             generate_ekeys($opts);
  347         }
  348     }
  349 
  350     for ($opts = 0; $opts <= 3; ++$opts) {
  351         if ($opts != $opt_fkeys) {
  352             read_part(nameof_fkeys($opts));
  353             generate_fkeys($opts);
  354         }
  355     }
  356 }
  357 
  358 make_ckey_names();
  359 make_ekey_names();
  360 
  361 printf "# gen-pc-fkeys.pl\n";
  362 printf "# %s:timode\n", "vile";
  363 show_default();
  364 show_nondefault();