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).
38use strict;
39
40my($max_modifier, $terminfo);
41my(@old_fkeys, $opt_fkeys, $min_fkeys, $max_fkeys);
42my(%old_ckeys, $opt_ckeys, $min_ckeys, $max_ckeys);
43my(%old_ekeys, $opt_ekeys, $min_ekeys, $max_ekeys);
44
45my(@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	);
51my %ckey_names;
52my(@ckey_known);
53@ckey_known = (
54	'kind',  'kLFT',  'kRIT',  'kri',	# 2 = shift (standard)
55	);
56
57my(@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);
63my %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
81sub 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.
111sub 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
129sub 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
146sub 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.
165sub 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.
199sub read_part($) {
200	my $part = $_[0];
201
202	%old_ckeys = ();
203	@old_fkeys = ();
204	readterm($terminfo);
205	readterm($part);
206}
207
208sub nameof_ckeys($) {
209	my $opts = $_[0];
210	my $optname = "xterm+pcc" . ($opts >= 0 ? $opts : "n");
211	return $optname;
212}
213
214sub 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
257sub nameof_ekeys($) {
258	my $opts = $_[0];
259	my $optname = "xterm+pce" . ($opts >= 0 ? $opts : "n");
260	return $optname;
261}
262
263sub 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
288sub nameof_fkeys($) {
289	my $opts = $_[0];
290	my $optname = "xterm+pcf" . ($opts >= 0 ? $opts : "n");
291	return $optname;
292}
293
294sub 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
319sub 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
332sub 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
358make_ckey_names();
359make_ekey_names();
360
361printf "# gen-pc-fkeys.pl\n";
362printf "# %s:timode\n", "vile";
363show_default();
364show_nondefault();
365