#!../../perl -w
#  test.syms, see if curses(3) symbols exist
#
#  Copyright (c) 1994,1995  William Setzer
#
#  You may distribute under the terms of the Artistic License, as
#  specified in the README file.
#
#
#  This program is modelled after parts of the dist-3.0 distribution.
#  In many cases I just hand-converted the sh script to perl, so this
#  program probably falls under the Artistic license.  At the very least,
#  it has the "look and feel".  Will I be sued? :-)
#
#  Thanks to Raphael Manfredi and the other contributors of dist-3.0.
#
#  VMS patches thanks to Peter Prymmer <pvhp@lns62.lns.cornell.edu>

BEGIN { unshift(@INC, "../../lib"); }
use Config;
use Getopt::Std;
require 'flush.pl';

do_options();
do_speedups();
open_cursesh();
write_testfiles();
do_special_cases();
do_standard_cases();
do_cleanup();
exit;

sub do_options
{
    unless (getopts('vl:'))
    {
	die <<EOM;
Usage: find_syms [options]
where options include:

   -h         This message.   
   -v         Verbose.  Tell you more than you want to know about
              how the Curses symbols are being determined.
   -l <file>  Create file <file> and dump output into it.
EOM
    }

    if ($opt_l)
    {
	open(LOG, ">$opt_l")  || die "Can't open logfile '$opt_l': $!\n";
	open(STDERR, ">&LOG") || die "Can't redirect STDERR: $!\n";
    }
    else
    {
	open(LOG, ">&STDERR")|| die "Can't redirect to STDERR: $!\n";
    }
}

sub do_speedups
{
    # I'm going to this extra trouble in order to speed up the symbol
    # testing.  (I could do testing via a make and things would be
    # simpler, but they'd also be much slower.)
    #
    my $file;

    if ($Config{'osname'} =~ /VMS/) { $file = "Descrip.MMS" }
    else                            { $file = "Makefile"    }

    open(MF, "$file") || die "Can't open $file: $!\n";
    while (<MF>)
    {
	if (/^CC\s*=\s*(.*)/)        { $cc  = $1 }
	if (/^INC\s*=\s*(.*)/)       { $inc = $1 }
	if (/^EXTRALIBS\s*=\s*(.*)/) { $ex  = $1 }
    }
    close(MF);
}

sub open_cursesh
{
    open(OUTH, ">pCurses.h") || die "Can't open pCurses.h: $!\n";

    print OUTH <<'EOHDR';
/* This file is automatically generated, changes will be lost.  If you
 * need to edit this file because "test.syms" didn't do a good job, be
 * sure and save a copy of your changes.
 * 
 * Change each #undef below to #define if the answer to the question
 * beside it is "yes".  Change each #define to #undef if the answer
 * to the question is "no".
 */

EOHDR
}

sub write_testfiles
{
    # The parentheses around SYM below are intended to catch cases
    # like "#define gettmode()"
    #
    open(T, ">testsym.c") || die "Can't open test file testsym.c: $!\n";

    print T <<'EOTF';
#include "c-config.h"
main() { (SYM); }
EOTF
    close T;

    open(T, ">testinvd.c") || die "Can't open test file testinvd.c: $!\n";
    print T <<'EOTF';
#include "c-config.h"
main() { int ret; ret = SYM; }
EOTF
    close T;
}

sub do_special_cases
{
    print OUTH <<'EOHDR';
/* This section contains special cases.  The script "test.syms" is
 * quite simply making an educated guess.  If you are having problems
 * compiling, check these #define's first for any inaccuracies.
 */

EOHDR

    # These functions return either int or void, depending on what
    # compiler and libcurses.a you are using.  If the compiler
    # doesn't complain about assigning the sym to an int variable,
    # we assume the function returns int.  Otherwise, we assume
    # it returns void.
    #
    my(@prob) = qw{
	cbreak() echo() idlok(stdscr,0) nl() nocbreak() noecho()
	nonl() noraw() raw()
    };
    
    for (@prob)
    {
	my($sym) = $_;
	my($there) = test_symbol($_);

	s/\(.*//;
	print LOG  "$_() ", $there ? "" : "NOT ", "found\n";
	write_symbol($_, $there);
	if ($there)
	{
	    my($int)  = test_intvoid($sym);

#	    print LOG  " and returns ", $int ? "int" : "void";
	    write_ivsymbol($_, "int",  $int);
	    write_ivsymbol($_, "void", ! $int);
	}
#	print LOG "\n";
    }
}

sub do_standard_cases
{
    print OUTH <<'EOHDR';

/* This section should contain better guesses.  You may still find
 * that "test.syms" made a mistake.
 */

EOHDR

    while (<DATA>)
    {
	chop;
	my($there) = test_symbol($_);

	s/\(.*\s*//;
	print LOG  "$_() ", $there ? "" : "NOT ", "found\n";
	write_symbol($_, $there);
    }
}

sub do_cleanup
{
    unlink "testsym",  "testsym.c",  "testsym.o";
    unlink "testinvd", "testinvd.c", "testinvd.o";

    1 while unlink "testsym.obj";  # Possibly pointless VMSism
    1 while unlink "testinvd.obj"; # Possibly pointless VMSism

    close OUTH;
    close LOG if $opt_v;
}

sub test_symbol
{
    my $cmd;

    if ($Config{'osname'} =~ /VMS/) {
	$cmd = "$cc /DEFINE=SYM=\"$_[0]\" $inc testsym.c $ex";
#	$cmd .= " /nowarnings" unless $opt_v;
    } elsif ($^O eq 'MSWin32') {
	$cmd = "$cc -DSYM=\"$_[0]\" $inc testsym.c $ex";
	$cmd .= " >nul 2>&1" unless $opt_v;
    } else {
	$cmd = "$cc -DSYM=\"$_[0]\" $inc -o testsym testsym.c $ex";
	$cmd .= " >/dev/null 2>&1" unless $opt_v;
    }

    print LOG $cmd, "\n" if $opt_v;
    flush(LOG);
    if ($Config{'osname'} =~ /VMS/) {
#	return (system ($cmd));
	my @result;
	@result = `$cmd`;
	if ($#result >= 0) {
	    print LOG @result if $opt_v; 
	    return 0;
	} else { 
	    print LOG "post: ", $cmd, "\n" if $opt_v; 
	    print LOG @result if $opt_v; 
	    return 1; 
	}
    } else {
	return ! system $cmd;
    }
}

sub test_intvoid
{
    my $cmd;
    if ($Config{'osname'} =~ /VMS/) {
	$cmd = "$cc /DEFINE=SYM=\"$_[0]\" $inc testinvd.c $ex";
#	$cmd .= " /nowarnings" unless $opt_v;
    } elsif ($^O eq 'MSWin32') {
	$cmd = "$cc -DSYM=\"$_[0]\" $inc testinvd.c $ex";
	$cmd .= " >nul 2>&1" unless $opt_v;
    } else {
	$cmd = "$cc -DSYM=\"$_[0]\" $inc -o testinvd testinvd.c $ex";
	$cmd .= " >/dev/null 2>&1" unless $opt_v;
    }

    print LOG $cmd, "\n" if $opt_v;
    flush(LOG);

    if ($Config{'osname'} =~ /VMS/) {
#	return (system ($cmd));
	my @result;
	@result = `$cmd`;
	if ($#result >= 0) {
	    print LOG @result if $opt_v; 
	    return 0;
	} else { 
	    print LOG "post: ", $cmd, "\n" if $opt_v; 
	    print LOG @result if $opt_v; 
	    return 1; 
	}
    } else {
	return ! system $cmd;
    }
}

sub write_symbol
{
    my($sym, $there)  = @_;
    my($rsym) = $sym;

    $sym =~ s/^w//;
    print OUTH "#", $there ? "define" : "undef ", " \UC_$sym\E";
    print OUTH "\t" x (3 - int +(2 + length $sym)/8);
    print OUTH "/* Does $rsym() exist?";
    print OUTH "\t" x (3 - int +(1 + length $rsym)/8);
    print OUTH "*/\n";
}

sub write_ivsymbol
{
    my($sym, $type, $there)  = @_;
    my($rsym) = $sym;

    $sym =~ s/^w//;
    print OUTH "#", $there ? "define" : "undef ", " \UC_$type$sym\E";
    print OUTH "\t" x (3 - int +(2 + length($type) + length($sym))/8);
    print OUTH "/* Does $rsym() return $type?";
    print OUTH "\t" x (3 - int +(3 + length($rsym) + length($type))/8);
    print OUTH "*/\n";
}

__END__
waddch(stdscr,0)
waddchstr(stdscr,0)
waddchnstr(stdscr,0,0)
waddstr(stdscr,0)
waddnstr(stdscr,0,0)
wattroff(stdscr,0)
wattron(stdscr,0)
wattrset(stdscr,0)
baudrate()
beep()
wbkgd(stdscr,0)
wbkgdset(stdscr,0)
wborder(stdscr,0,0,0,0,0,0,0,0)
box(stdscr,0,0)
can_change_color()
wclear(stdscr)
clearok(stdscr,0)
wclrtobot(stdscr)
wclrtoeol(stdscr)
color_content(0,0,0,0)
COLOR_PAIR(0)
copywin(stdscr,stdscr,0,0,0,0,0,0,0)
wdelch(stdscr)
wdeleteln(stdscr)
delwin(stdscr)
derwin(stdscr,0,0,0,0)
doupdate()
wechochar(stdscr,0)
endwin()
werase(stdscr)
erasechar()
flash()
flushinp()
flusok(stdscr,0)
getattrs(stdscr)
getbegyx(stdscr,LINES,COLS)
getbkgd(stdscr)
getcap(0)
wgetch(stdscr)
getmaxyx(stdscr,LINES,COLS)
wgetnstr(stdscr,0,0)
getparyx(stdscr,LINES,COLS)
wgetstr(stdscr,0)
gettmode()
getyx(stdscr,LINES,COLS)
halfdelay(0)
has_colors()
has_ic()
has_il()
whline(stdscr,0,0)
idcok(stdscr,0)
immedok(stdscr,0)
winch(stdscr)
winchnstr(stdscr,0,0)
winchstr(stdscr,0)
initscr()
init_color(0,0,0,0)
init_pair(0,0,0)
winnstr(stdscr,0,0)
winsch(stdscr,0)
winsdelln(stdscr,0)
winsertln(stdscr)
winsnstr(stdscr,0,0)
winsstr(stdscr,0)
winstr(stdscr,0)
intrflush(stdscr,0)
isendwin()
is_linetouched(stdscr)
is_wintouched(stdscr)
keyname(0)
keypad(stdscr,0)
killchar()
leaveok(stdscr,0)
meta(stdscr,0)
wmove(stdscr,0,0)
mvcur(0,0,0,0)
mvwin(stdscr,0,0)
newpad(0,0)
newwin(0,0,0,0)
nodelay(stdscr,0)
noqiflush()
notimeout(stdscr,0)
wnoutrefresh(stdscr)
overlay(stdscr,stdscr)
overwrite(stdscr,stdscr)
pair_content(0,0,0)
PAIR_NUMBER(0)
pechochar(stdscr,0)
pnoutrefresh(stdscr,0,0,0,0,0,0)
prefresh(stdscr,0,0,0,0,0,0)
qiflush()
wrefresh(stdscr)
resetty()
savetty()
wscrl(stdscr,0)
scroll(stdscr)
scrollok(stdscr,0)
wsetscrreg(stdscr,0,0)
setterm(0)
slk_clear()
slk_init(0)
slk_label(0)
slk_noutrefresh()
slk_refresh()
slk_restore()
slk_set(0,0,0)
slk_touch()
wstandend(stdscr)
wstandout(stdscr)
start_color()
subpad(stdscr,0,0,0,0)
subwin(stdscr,0,0,0,0)
syncok(stdscr,0)
wtimeout(stdscr,0)
wtouchln(stdscr,0,0,0)
touchoverlap(stdscr,stdscr)
touchwin(stdscr)
typeahead(0)
wvline(stdscr,0,0)
unctrl(0)
ungetch(0)
newterm(0,0,0)
set_term(0)