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