xref: /openbsd-src/gnu/usr.bin/perl/cpan/Term-ReadKey/genchars.pl (revision f2da64fbbbf1b03f09f390ab01267c93dfd77c4c) 
1#!/usr/bin/perl
2
3#
4# $Id: genchars.pl,v 1.2 2016/07/03 01:07:58 afresh1 Exp $
5#
6##############################
7$version="1.97";
8##############################
9use Config;
10
11use Configure;
12
13#sub report {
14#	my($prog)=join(" ",@_);
15#
16#  my($ccflags, $ldflags, $cc, $rm) = @Config{'ccflags', 'ldflags', 'cc', 'rm'};
17#  my($command, $ret);
18#
19#  $command = $prog;
20#  open(F, ">temp$$.c") || die "Can't make temp file temp$$.c! $!\n";
21#  print F $command;
22#  close F;
23#
24#  $command  = "$cc $ccflags -o temp$$ temp$$.c $ldfcrs $libcrs $ldflags -lbsd";
25#  $command .= " >/dev/null 2>&1";
26#  $ret = system $command;
27#  #if(!$ret) { system "temp$$" }
28#  unlink "temp$$", "temp$$.o", "temp$$.c";
29#
30#  return $ret;
31#}
32
33open(CCHARS,">cchars.h") || die "Fatal error, Unable to write to cchars.h!";
34
35#print "Checking for termio...\n";
36#$TERMIO = !report(	"#include <termio.h>\n	struct termios s; main(){}");
37#print "	Termio ",($TERMIO?"":"NOT "),"found.\n";
38
39#print "Checking for termios...\n";
40#$TERMIOS = !report(	"#include <termios.h>\n	struct termio s;  main(){}");
41#print "	Termios ",($TERMIOS?"":"NOT "),"found.\n";
42
43#print "Checking for sgtty...\n";
44#$SGTTY = !report(	"#include <sgtty.h>\n	struct sgttyb s;  main(){}");
45#print "	Sgtty ",($SGTTY?"":"NOT "),"found.\n";
46
47#print "Termio=$TERMIO, Termios=$TERMIOS, Sgtty=$SGTTY\n";
48
49# Control characters used for termio and termios
50%possible = (	VINTR	=>	"INTERRUPT",
51		VQUIT	=>	"QUIT",
52		VERASE	=>	"ERASE",
53		VKILL	=>	"KILL",
54		VEOF	=> 	"EOF",
55		VTIME	=>	"TIME",
56		VMIN	=>	"MIN",
57		VSWTC	=>	"SWITCH",
58		VSWTCH	=>	"SWITCH",
59		VSTART	=>	"START",
60		VSTOP	=>	"STOP",
61		VSUSP	=>	"SUSPEND",
62		VDSUSP	=>	"DSUSPEND",
63		VEOL	=>	"EOL",
64		VREPRINT =>	"REPRINT",
65		VDISCARD =>	"DISCARD",
66		VFLUSH	=>	"DISCARD",
67		VWERASE	=>	"ERASEWORD",
68		VLNEXT	=>	"QUOTENEXT",
69		VQUOTE  => 	"QUOTENEXT",
70		VEOL2	=>	"EOL2",
71		VSTATUS	=>	"STATUS",
72);
73
74# Control characters for sgtty
75%possible2 = (	"intrc"	=>	"INTERRUPT",
76		"quitc"	=>	"QUIT",
77		"eofc"	=> 	"EOF",
78		"startc"=>	"START",
79		"stopc"	=>	"STOP",
80		"brkc"	=>	"EOL",
81		"eolc"	=>	"EOL",
82		"suspc"	=>	"SUSPEND",
83		"dsuspc"=>	"DSUSPEND",
84		"rprntc"=>	"REPRINT",
85		"flushc"=>	"DISCARD",
86		"lnextc"=>	"QUOTENEXT",
87		"werasc"=>	"ERASEWORD",
88);
89
90print CCHARS "
91
92/* Written by genchars.pl version $version */
93
94";
95
96print CCHARS "#define HAVE_POLL_H\n" if CheckHeader("poll.h");
97print CCHARS "#define HAVE_SYS_POLL_H\n" if CheckHeader("sys/poll.h");
98
99print "\n";
100if(1) {
101	@values = sort { $possible{$a} cmp $possible{$b} or $a cmp $b } keys %possible;
102
103	print "Writing termio/termios section of cchars.h... ";
104	print CCHARS "
105
106#ifdef CC_TERMIOS
107# define TermStructure struct termios
108# ifdef NCCS
109#  define LEGALMAXCC NCCS
110# else
111#  ifdef NCC
112#   define LEGALMAXCC NCC
113#  endif
114# endif
115#else
116# ifdef CC_TERMIO
117#  define TermStructure struct termio
118#  ifdef NCC
119#   define LEGALMAXCC NCC
120#  else
121#   ifdef NCCS
122#    define LEGALMAXCC NCCS
123#   endif
124#  endif
125# endif
126#endif
127
128#if !defined(LEGALMAXCC)
129# define LEGALMAXCC 126
130#endif
131
132#if defined(CC_TERMIO) || defined(CC_TERMIOS)
133
134char	* cc_names[] = {	".join('',map("
135#if defined($_) && ($_ < LEGALMAXCC)
136	\"$possible{$_}\",	"."
137#else				"."
138	\"\",			"."
139#endif				", @values ))."
140};
141
142const int MAXCC = 0	",join('',map("
143#if defined($_)  && ($_ < LEGALMAXCC)
144	+1		/* $possible{$_} */
145#endif			", @values ))."
146	;
147
148XS(XS_Term__ReadKey_GetControlChars)
149{
150	dXSARGS;
151	if (items < 0 || items > 1) {
152		croak(\"Usage: Term::ReadKey::GetControlChars()\");
153	}
154	SP -= items;
155	{
156                PerlIO * file;
157		TermStructure s;
158	        if (items < 1)
159	            file = STDIN;
160	        else {
161	            file = IoIFP(sv_2io(ST(0)));
162	        }
163
164#ifdef CC_TERMIOS
165		if(tcgetattr(PerlIO_fileno(file),&s))
166#else
167# ifdef CC_TERMIO
168		if(ioctl(PerlIO_fileno(file),TCGETA,&s))
169# endif
170#endif
171			croak(\"Unable to read terminal settings in GetControlChars\");
172		else {
173			EXTEND(sp,MAXCC*2);		".join('',map("
174#if defined($values[$_]) && ($values[$_] < LEGALMAXCC)	"."
175PUSHs(sv_2mortal(newSVpv(cc_names[$_],strlen(cc_names[$_])))); /* $possible{$values[$_]} */
176PUSHs(sv_2mortal(newSVpv((char*)&s.c_cc[$values[$_]],1))); 	"."
177#endif			"				,0..$#values))."
178
179		}
180		PUTBACK;
181		return;
182	}
183}
184
185XS(XS_Term__ReadKey_SetControlChars)
186{
187	dXSARGS;
188	/*if ((items % 2) != 0) {
189		croak(\"Usage: Term::ReadKey::SetControlChars(%charpairs,file=STDIN)\");
190	}*/
191	SP -= items;
192	{
193		TermStructure s;
194		PerlIO * file;
195	        if ((items % 2) == 1)
196	            file = IoIFP(sv_2io(ST(items-1)));
197	        else {
198	            file = STDIN;
199	        }
200
201#ifdef CC_TERMIOS
202		if(tcgetattr(PerlIO_fileno(file),&s))
203#else
204# ifdef CC_TERMIO
205		if(ioctl(PerlIO_fileno(file),TCGETA,&s))
206# endif
207#endif
208			croak(\"Unable to read terminal settings in SetControlChars\");
209		else {
210			int i;
211			char * name, value;
212			for(i=0;i+1<items;i+=2) {
213				name = SvPV(ST(i),PL_na);
214				if( SvIOKp(ST(i+1)) || SvNOKp(ST(i+1)) )/* If Int or Float */
215					value = (char)SvIV(ST(i+1));         /* Store int value */
216				else                                    /* Otherwise */
217					value = SvPV(ST(i+1),PL_na)[0];          /* Use first char of PV */
218
219	if (0) ;					".join('',map("
220#if defined($values[$_]) && ($values[$_] < LEGALMAXCC)	"."
221	else if(strcmp(name,cc_names[$_])==0) /* $possible{$values[$_]} */
222		s.c_cc[$values[$_]] = value;		"."
223#endif							",0..$#values))."
224	else
225		croak(\"Invalid control character passed to SetControlChars\");
226
227			}
228#ifdef CC_TERMIOS
229		if(tcsetattr(PerlIO_fileno(file),TCSANOW,&s))
230#else
231# ifdef CC_TERMIO
232		if(ioctl(PerlIO_fileno(file),TCSETA,&s))
233# endif
234#endif
235			croak(\"Unable to write terminal settings in SetControlChars\");
236		}
237	}
238	XSRETURN(1);
239}
240
241
242#endif
243
244";
245
246	print "Done.\n";
247
248}
249
250undef %billy;
251
252if(@ARGV) { # If any argument is supplied on the command-line don't check sgtty
253	$SGTTY=0; #skip tests
254}  else {
255	print "Checking for sgtty...\n";
256
257	$SGTTY = CheckStructure "sgttyb","sgtty.h";
258#	$SGTTY = !Compile("
259##include <sgtty.h>
260#struct sgttyb s;
261#main(){
262#ioctl(0,TIOCGETP,&s);
263#}");
264
265#}
266
267#	$SGTTY = !report("
268##include <sgtty.h>
269#struct sgttyb s;
270#main(){
271#ioctl(0,TIOCGETP,&s);
272#}");
273
274	print "	Sgtty ",($SGTTY?"":"NOT "),"found.\n";
275}
276
277$billy{"ERASE"} = "s1.sg_erase";
278$billy{"KILL"} = "s1.sg_kill";
279$tchars=$ltchars=0;
280
281if($SGTTY) {
282
283	print "Checking sgtty...\n";
284
285	$tchars = CheckStructure "tchars","sgtty.h";
286#	$tchars = !report(	'
287##include <sgtty.h>
288#struct tchars t;
289#main() { ioctl(0,TIOCGETC,&t); }
290#');
291	print "	tchars structure found.\n" if $tchars;
292
293	$ltchars = CheckStructure "ltchars","sgtty.h";
294#	$ltchars = !report(	'
295##include <sgtty.h>
296#struct ltchars t;
297#main() { ioctl(0,TIOCGLTC,&t); }
298#');
299
300	print "	ltchars structure found.\n" if $ltchars;
301
302
303	print "Checking symbols\n";
304
305
306	for $c (sort keys %possible2) {
307
308#		if($tchars and !report("
309##include <sgtty.h>
310#struct tchars s2;
311#main () { char c = s2.t_$c; }
312#")) {
313		if($tchars and CheckField("tchars","t_$c","sgtty.h")) {
314
315			print "	t_$c ($possible2{$c}) found in tchars\n";
316			$billy{$possible2{$c}} = "s2.t_$c";
317		}
318
319#		elsif($ltchars and !report("
320##include <sgtty.h>
321#struct ltchars s3;
322#main () { char c = s3.t_$c; }
323#")) {
324		elsif($ltchars and CheckField("ltchars","t_$c","sgtty.h")) {
325			print "	t_$c ($possible2{$c}) found in ltchars\n";
326			$billy{$possible2{$c}} = "s3.t_$c";
327		}
328
329	}
330
331
332	#undef @names;
333	#undef @values;
334	#for $v (sort keys %billy) {
335	#	push(@names,$billy{$v});
336	#	push(@values,$v);
337	#}
338
339	#$numchars = keys %billy;
340
341}
342
343@values = sort keys %billy;
344
345	$struct = "
346struct termstruct {
347	struct sgttyb s1;
348";
349	$struct .= "
350	struct tchars s2;
351"	if $tchars;
352	$struct .= "
353	struct ltchars s3;
354"	if $ltchars;
355	$struct .= "
356};";
357
358print "Writing sgtty section of cchars.h... ";
359
360	print CCHARS "
361
362#ifdef CC_SGTTY
363$struct
364#define TermStructure struct termstruct
365
366char	* cc_names[] = {	".join('',map("
367	\"$_\",			", @values ))."
368};
369
370#define MAXCC	". ($#values+1)."
371
372XS(XS_Term__ReadKey_GetControlChars)
373{
374	dXSARGS;
375	if (items < 0 || items > 1) {
376		croak(\"Usage: Term::ReadKey::GetControlChars()\");
377	}
378	SP -= items;
379	{
380		PerlIO * file;
381		TermStructure s;
382	        if (items < 1)
383	            file = STDIN;
384	        else {
385	            file = IoIFP(sv_2io(ST(0)));
386	        }
387        if(ioctl(fileno(PerlIO_file),TIOCGETP,&s.s1) ".($tchars?"
388 	||ioctl(fileno(PerlIO_file),TIOCGETC,&s.s2)  ":'').($ltchars?"
389        ||ioctl(fileno(PerlIO_file),TIOCGLTC,&s.s3)  ":'')."
390			)
391			croak(\"Unable to read terminal settings in GetControlChars\");
392		else {
393			int i;
394			EXTEND(sp,MAXCC*2);		".join('',map("
395PUSHs(sv_2mortal(newSVpv(cc_names[$_],strlen(cc_names[$_])))); /* $values[$_] */
396PUSHs(sv_2mortal(newSVpv(&s.$billy{$values[$_]},1))); 	",0..$#values))."
397
398		}
399		PUTBACK;
400		return;
401	}
402}
403
404XS(XS_Term__ReadKey_SetControlChars)
405{
406	dXSARGS;
407	/*if ((items % 2) != 0) {
408		croak(\"Usage: Term::ReadKey::SetControlChars(%charpairs,file=STDIN)\");
409	}*/
410	SP -= items;
411	{
412		PerlIO * file;
413		TermStructure s;
414	        if ((items%2)==0)
415	            file = STDIN;
416	        else {
417	            file = IoIFP(sv_2io(ST(items-1)));
418	        }
419
420	        if(ioctl(PerlIO_fileno(file),TIOCGETP,&s.s1) ".($tchars?"
421	 	||ioctl(fileno(PerlIO_file),TIOCGETC,&s.s2)  ":'').($ltchars?"
422	        ||ioctl(fileno(PerlIO_file),TIOCGLTC,&s.s3)  ":'')."
423			)
424			croak(\"Unable to read terminal settings in SetControlChars\");
425		else {
426			int i;
427			char * name, value;
428			for(i=0;i+1<items;i+=2) {
429				name = SvPV(ST(i),PL_na);
430				if( SvIOKp(ST(i+1)) || SvNOKp(ST(i+1)) )/* If Int or Float */
431					value = (char)SvIV(ST(i+1));         /* Store int value */
432				else                                    /* Otherwise */
433					value = SvPV(ST(i+1),PL_na)[0];          /* Use first char of PV */
434
435	if (0) ;					".join('',map("
436	else if(strcmp(name,cc_names[$_])==0) /* $values[$_] */
437		s.$billy{$values[$_]} = value;		",0..$#values))."
438	else
439		croak(\"Invalid control character passed to SetControlChars\");
440
441			}
442	        if(ioctl(fileno(PerlIO_file),TIOCSETN,&s.s1) ".($tchars?"
443	        ||ioctl(fileno(PerlIO_file),TIOCSETC,&s.s2) ":'').($ltchars?"
444	        ||ioctl(fileno(PerlIO_file),TIOCSLTC,&s.s3) ":'')."
445			) croak(\"Unable to write terminal settings in SetControlChars\");
446		}
447	}
448	XSRETURN(1);
449}
450
451#endif
452
453#if !defined(CC_TERMIO) && !defined(CC_TERMIOS) && !defined(CC_SGTTY)
454#define TermStructure int
455XS(XS_Term__ReadKey_GetControlChars)
456{
457	dXSARGS;
458	if (items <0 || items>1) {
459		croak(\"Usage: Term::ReadKey::GetControlChars([FileHandle])\");
460	}
461	SP -= items;
462	{
463		ST(0) = sv_newmortal();
464		PUTBACK;
465		return;
466	}
467}
468
469XS(XS_Term__ReadKey_SetControlChars)
470{
471	dXSARGS;
472	if (items < 0 || items > 1) {
473		croak(\"Invalid control character passed to SetControlChars\");
474	}
475	SP -= items;
476	XSRETURN(1);
477}
478
479#endif
480
481";
482
483print "Done.\n";
484
485
486
487
488
489