Sweden-Number/tools/make_X11wrappers

#!/usr/bin/perl -w

# Create threads safe wrappers around X11 calls.
#
# Copyright 1998 Kristian Nielsen.
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# FIXME: This does not do full C prototype parsing, but relies on
# knowledge on how the X11 include files are formatted. It will
# probably need to be modified for new include files. It also fails
# for certain prototypes (notably those with function pointer
# arguments or results), so these must be added manually. And it
# relies on a fixed location of X11 includes (/usr/X11R6/include/).
#
# This program expects to be run from Wine's main directory.

$X11_include_dir = "/usr/X11/include";
$outdir = "tsx11";
$wantfile = "$outdir/X11_calls";
@dolist = ("Xlib");

# First read list of wanted function names.

open(WANT, $wantfile) || die "open";
while(<WANT>) {
    next if /^\s*\#/;		# Skip comment lines.
    next if /^\s*$/;		# Skip empty lines.
    if(/^\s*([a-zA-Z0-9_]+)\s*$/) {
	$want{$1} = 1;
    } else {
	die "syntax error in file '$wantfile', in line '$_'";
    }
}
close(WANT);

foreach $name (@dolist) {

    $ucname = uc $name;
    $lcname = lc $name;

    $outfile = "/ts_$lcname";
    open(OUTC, ">$outdir/$outfile.c") || die "open";
    open(OUTH, ">include/$outfile.h") || die "open";

    $x11_incl = "";
    $extensions_dir = "";
    $pre_file = "#ifdef HAVE_X11_XLIB_H\n";
    $post_file = "#endif /* defined(HAVE_X11_XLIB_H) */\n";
    $inc_name = $name;

    print OUTH <<END;
/*
 * Thread safe wrappers around $name calls.
 * Always include this file instead of <X11/$name.h>.
 * This file was generated automatically by tools/make_X11wrappers
 * DO NOT EDIT!
 */

#ifndef __WINE_TS_$ucname\_H
#define __WINE_TS_$ucname\_H

#ifndef __WINE_CONFIG_H
# error You must include config.h to use this header
#endif

$pre_file
$x11_incl#include <X11/$extensions_dir$inc_name.h>

extern void (*wine_tsx11_lock)(void);
extern void (*wine_tsx11_unlock)(void);

END

    print OUTC <<END;
/*
 * Thread safe wrappers around $name calls.
 * This file was generated automatically by tools/make_X11wrappers
 * DO NOT EDIT!
 */

#include "config.h"

$pre_file
$x11_incl#include <X11/$extensions_dir$inc_name.h>

#include "ts_$lcname.h"

END

	open(IN,
	     "echo \"$x11_incl#include <X11/$extensions_dir$name.h>\" | " .
	     "gcc -L$X11_include_dir -DNeedFunctionPrototypes -E - | " .
	     "grep -v '^[ \t]*\$)' |"
	     ) || die "open";

      PROTO: while(<IN>) {
	  if(m'extern\s+([^()]*)\b([a-zA-Z0-9_]+)\s*\(') {
	      $result_type = $1;
	      $fn_name = $2;
	      $result_type = "int" if $result_type =~ /^\s*$/;
	      @args = ();
	      while(<IN>) {
		  last if m'\)\s*;';
		  # Give up on vararg functions and function pointer args.
		  if(m'\.\.\.|\(\*\)') {
		      undef $fn_name;
		      last;
		  }
		  if(m'\s*([^,]*[^, \t])\s*(,?\n)') {
		      $args[$#args+1] = $1;
		      if ($1 =~ /char\s*\[/) { # small hack for XQueryKeymap
		      	$args[$#args] = "char*";
		      }
		  }
	      }
	      # Skip if vararg, function pointer arg, or not needed.
	      next unless $fn_name;
	      next unless $want{$fn_name} && $want{$fn_name} == 1;

	      # Special case for no arguments (which is specified as "void").
	      if($#args == 0 && $args[0] eq "void") {
		  @args = ();
	      }
	      $proto = "";
	      $formals = "";
	      $actuals = "";
	      for($i = 0; $i <= $#args; $i++) {
		  $comma = $i < $#args ? ", " : "";
		  $proto .= "$args[$i]$comma";
		  $formals .= "$args[$i] a$i$comma";
		  $actuals .= "a$i$comma";
	      }
	      $proto = $formals = "void" if $#args == -1;
	      output_fn($fn_name, $result_type, $proto, $formals, $actuals);
	  }
      }

    print OUTH <<END;

$post_file
#endif /* __WINE_TS_$ucname\_H */
END
    print OUTC <<END;

$post_file
END



}

foreach $i (keys %want) {
    if($want{$i} == 1) {
	print "Unresolved: $i\n";
    }
}


sub output_fn {
    # Example call:
    # output_fn("main", "int", "int, char **", "int a0, char **a1", "a0, a1")
    #

    my ($fn_name, $result_type, $protos, $formals, $actuals) = @_;

    return raw_output_fn($fn_name,
			 $result_type =~ /^\s*void\s*$/ ? "" : "$result_type r",
			 "$result_type TS$fn_name($protos)",
			 "$result_type TS$fn_name($formals)",
			 $actuals);
}

sub output_fn_short {
    # Example call:
    # output_fn_sort("Bool", "XDGAQueryExtension", "Display *", "int *", "int *");
    #
    my ($result_type, $fn_name, @args) = @_;

    my ($i, $proto, $formals, $actuals) = (0,
					   "$result_type TS$fn_name(",
					   "$result_type TS$fn_name(",
					   "");
    while ($val = shift @args) {
	$proto = $proto . $val;
	$formals = $formals . $val . " a$i";
	$actuals = $actuals . " a$i";
	$i++;
	if (@args) {
	    $proto = $proto . ", ";
	    $formals = $formals . ", ";
	    $actuals = $actuals . ", ";
	}
    }
    $proto = $proto . ")";
    $formals = $formals . ")";


    raw_output_fn($fn_name,
		  $result_type =~ /^\s*void\s*$/ ? "" : "$result_type r",
		  $proto,
		  $formals,
		  $actuals);
}

sub raw_output_fn {
    # Example call:
    # output_fn("main", "int r", "int main(int, char **)", "int main(int a0, char **a1)", "a0, a1")
    #

    my ($fn_name, $resultdecl, $protodecl, $defdecl, $actuals) = @_;

    return undef unless $want{$fn_name} && $want{$fn_name} == 1;

    print OUTC "\n$defdecl\n";
    print OUTH "extern $protodecl;\n";
#    print OUTH "#define $fn_name TS$fn_name\n";
    print OUTC "{\n";
    print OUTC "  $resultdecl;\n" if $resultdecl;
    print OUTC "  wine_tsx11_lock();\n";
    print OUTC "  ";
    print OUTC "r = " if $resultdecl;
    print OUTC "$fn_name($actuals);\n";
    print OUTC "  wine_tsx11_unlock();\n";
    print OUTC "  return r;\n" if $resultdecl;
    print OUTC "}\n";
    $want{$fn_name} = 2;
    return 1;
}