$version="1.97";
use Config;
use Configure;
open(CCHARS,">cchars.h") || die "Fatal error, Unable to write to cchars.h!";
%possible = ( VINTR => "INTERRUPT",
VQUIT => "QUIT",
VERASE => "ERASE",
VKILL => "KILL",
VEOF => "EOF",
VTIME => "TIME",
VMIN => "MIN",
VSWTC => "SWITCH",
VSWTCH => "SWITCH",
VSTART => "START",
VSTOP => "STOP",
VSUSP => "SUSPEND",
VDSUSP => "DSUSPEND",
VEOL => "EOL",
VREPRINT => "REPRINT",
VDISCARD => "DISCARD",
VFLUSH => "DISCARD",
VWERASE => "ERASEWORD",
VLNEXT => "QUOTENEXT",
VQUOTE => "QUOTENEXT",
VEOL2 => "EOL2",
VSTATUS => "STATUS",
);
%possible2 = ( "intrc" => "INTERRUPT",
"quitc" => "QUIT",
"eofc" => "EOF",
"startc"=> "START",
"stopc" => "STOP",
"brkc" => "EOL",
"eolc" => "EOL",
"suspc" => "SUSPEND",
"dsuspc"=> "DSUSPEND",
"rprntc"=> "REPRINT",
"flushc"=> "DISCARD",
"lnextc"=> "QUOTENEXT",
"werasc"=> "ERASEWORD",
);
print CCHARS "
/* Written by genchars.pl version $version */
";
print CCHARS "#define HAVE_POLL_H\n" if CheckHeader("poll.h");
print CCHARS "#define HAVE_SYS_POLL_H\n" if CheckHeader("sys/poll.h");
print "\n";
if(1) {
@values = sort { $possible{$a} cmp $possible{$b} } keys %possible;
print "Writing termio/termios section of cchars.h... ";
print CCHARS "
#ifdef CC_TERMIOS
# define TermStructure struct termios
# ifdef NCCS
# define LEGALMAXCC NCCS
# else
# ifdef NCC
# define LEGALMAXCC NCC
# endif
# endif
#else
# ifdef CC_TERMIO
# define TermStructure struct termio
# ifdef NCC
# define LEGALMAXCC NCC
# else
# ifdef NCCS
# define LEGALMAXCC NCCS
# endif
# endif
# endif
#endif
#if !defined(LEGALMAXCC)
# define LEGALMAXCC 126
#endif
#if defined(CC_TERMIO) || defined(CC_TERMIOS)
char * cc_names[] = { ".join('',map("
#if defined($_) && ($_ < LEGALMAXCC)
\"$possible{$_}\", "."
#else "."
\"\", "."
#endif ", @values ))."
};
const int MAXCC = 0 ",join('',map("
#if defined($_) && ($_ < LEGALMAXCC)
+1 /* $possible{$_} */
#endif ", @values ))."
;
XS(XS_Term__ReadKey_GetControlChars)
{
dXSARGS;
if (items < 0 || items > 1) {
croak(\"Usage: Term::ReadKey::GetControlChars()\");
}
SP -= items;
{
PerlIO * file;
TermStructure s;
if (items < 1)
file = STDIN;
else {
file = IoIFP(sv_2io(ST(0)));
}
#ifdef CC_TERMIOS
if(tcgetattr(PerlIO_fileno(file),&s))
#else
# ifdef CC_TERMIO
if(ioctl(PerlIO_fileno(file),TCGETA,&s))
# endif
#endif
croak(\"Unable to read terminal settings in GetControlChars\");
else {
int i;
EXTEND(sp,MAXCC*2); ".join('',map("
#if defined($values[$_]) && ($values[$_] < LEGALMAXCC) "."
PUSHs(sv_2mortal(newSVpv(cc_names[$_],strlen(cc_names[$_])))); /* $possible{$values[$_]} */
PUSHs(sv_2mortal(newSVpv((char*)&s.c_cc[$values[$_]],1))); "."
#endif " ,0..$
}
PUTBACK;
return;
}
}
XS(XS_Term__ReadKey_SetControlChars)
{
dXSARGS;
/*if ((items % 2) != 0) {
croak(\"Usage: Term::ReadKey::SetControlChars(%charpairs,file=STDIN)\");
}*/
SP -= items;
{
TermStructure s;
PerlIO * file;
if ((items % 2) == 1)
file = IoIFP(sv_2io(ST(items-1)));
else {
file = STDIN;
}
if(tcgetattr(PerlIO_fileno(file),&s))
if(ioctl(PerlIO_fileno(file),TCGETA,&s))
croak(\"Unable to read terminal settings in SetControlChars\");
else {
int i;
char * name, value;
for(i=0;i+1<items;i+=2) {
name = SvPV(ST(i),PL_na);
if( SvIOKp(ST(i+1)) || SvNOKp(ST(i+1)) )/* If Int or Float */
value = (char)SvIV(ST(i+1)); /* Store int value */
else /* Otherwise */
value = SvPV(ST(i+1),PL_na)[0]; /* Use first char of PV */
if (0) ; ".join('',map("
else if(strcmp(name,cc_names[$_])==0) /* $possible{$values[$_]} */
s.c_cc[$values[$_]] = value; "."
else
croak(\"Invalid control character passed to SetControlChars\");
}
if(tcsetattr(PerlIO_fileno(file),TCSANOW,&s))
if(ioctl(PerlIO_fileno(file),TCSETA,&s))
croak(\"Unable to write terminal settings in SetControlChars\");
}
}
XSRETURN(1);
}
";
print "Done.\n";
}
undef %billy;
if(@ARGV) { # If any argument is supplied on the command-line don't check sgtty
$SGTTY=0; #skip tests
} else {
print "Checking for sgtty...\n";
$SGTTY = CheckStructure "sgttyb","sgtty.h";
# $SGTTY = !Compile("
print " Sgtty ",($SGTTY?"":"NOT "),"found.\n";
}
$billy{"ERASE"} = "s1.sg_erase";
$billy{"KILL"} = "s1.sg_kill";
$tchars=$ltchars=0;
if($SGTTY) {
print "Checking sgtty...\n";
$tchars = CheckStructure "tchars","sgtty.h";
print " tchars structure found.\n" if $tchars;
$ltchars = CheckStructure "ltchars","sgtty.h";
print " ltchars structure found.\n" if $ltchars;
print "Checking symbols\n";
for $c (keys %possible2) {
if($tchars and CheckField("tchars","t_$c","sgtty.h")) {
print " t_$c ($possible2{$c}) found in tchars\n";
$billy{$possible2{$c}} = "s2.t_$c";
}
elsif($ltchars and CheckField("ltchars","t_$c","sgtty.h")) {
print " t_$c ($possible2{$c}) found in ltchars\n";
$billy{$possible2{$c}} = "s3.t_$c";
}
}
}
@values = sort keys %billy;
$struct = "
struct termstruct {
struct sgttyb s1;
";
$struct .= "
struct tchars s2;
" if $tchars;
$struct .= "
struct ltchars s3;
" if $ltchars;
$struct .= "
};";
print "Writing sgtty section of cchars.h... ";
print CCHARS "
#ifdef CC_SGTTY
$struct
#define TermStructure struct termstruct
char * cc_names[] = { ".join('',map("
\"$_\", ", @values ))."
};
#define MAXCC ". ($
XS(XS_Term__ReadKey_GetControlChars)
{
dXSARGS;
if (items < 0 || items > 1) {
croak(\"Usage: Term::ReadKey::GetControlChars()\");
}
SP -= items;
{
PerlIO * file;
TermStructure s;
if (items < 1)
file = STDIN;
else {
file = IoIFP(sv_2io(ST(0)));
}
if(ioctl(fileno(PerlIO_file),TIOCGETP,&s.s1) ".($tchars?"
||ioctl(fileno(PerlIO_file),TIOCGETC,&s.s2) ":'').($ltchars?"
||ioctl(fileno(PerlIO_file),TIOCGLTC,&s.s3) ":'')."
)
croak(\"Unable to read terminal settings in GetControlChars\");
else {
int i;
EXTEND(sp,MAXCC*2); ".join('',map("
PUSHs(sv_2mortal(newSVpv(cc_names[$_],strlen(cc_names[$_])))); /* $values[$_] */
PUSHs(sv_2mortal(newSVpv(&s.$billy{$values[$_]},1))); ",0..$#values))."
}
PUTBACK;
return;
}
}
XS(XS_Term__ReadKey_SetControlChars)
{
dXSARGS;
/*if ((items % 2) != 0) {
croak(\"Usage: Term::ReadKey::SetControlChars(%charpairs,file=STDIN)\");
}*/
SP -= items;
{
PerlIO * file;
TermStructure s;
if ((items%2)==0)
file = STDIN;
else {
file = IoIFP(sv_2io(ST(items-1)));
}
if(ioctl(PerlIO_fileno(file),TIOCGETP,&s.s1) ".($tchars?"
||ioctl(fileno(PerlIO_file),TIOCGETC,&s.s2) ":'').($ltchars?"
||ioctl(fileno(PerlIO_file),TIOCGLTC,&s.s3) ":'')."
)
croak(\"Unable to read terminal settings in SetControlChars\");
else {
int i;
char * name, value;
for(i=0;i+1<items;i+=2) {
name = SvPV(ST(i),PL_na);
if( SvIOKp(ST(i+1)) || SvNOKp(ST(i+1)) )/* If Int or Float */
value = (char)SvIV(ST(i+1)); /* Store int value */
else /* Otherwise */
value = SvPV(ST(i+1),PL_na)[0]; /* Use first char of PV */
if (0) ; ".join('',map("
else if(strcmp(name,cc_names[$_])==0) /* $values[$_] */
s.$billy{$values[$_]} = value; ",0..$#values))."
else
croak(\"Invalid control character passed to SetControlChars\");
}
if(ioctl(fileno(PerlIO_file),TIOCSETN,&s.s1) ".($tchars?"
||ioctl(fileno(PerlIO_file),TIOCSETC,&s.s2) ":'').($ltchars?"
||ioctl(fileno(PerlIO_file),TIOCSLTC,&s.s3) ":'')."
) croak(\"Unable to write terminal settings in SetControlChars\");
}
}
XSRETURN(1);
}
XS(XS_Term__ReadKey_GetControlChars)
{
dXSARGS;
if (items <0 || items>1) {
croak(\"Usage: Term::ReadKey::GetControlChars([FileHandle])\");
}
SP -= items;
{
ST(0) = sv_newmortal();
PUTBACK;
return;
}
}
XS(XS_Term__ReadKey_SetControlChars)
{
dXSARGS;
if (items < 0 || items > 1) {
croak(\"Invalid control character passed to SetControlChars\");
}
SP -= items;
XSRETURN(1);
}
";
print "Done.\n";