path: root/tools/gmmproc.in

#! @PERL@
#
# @configure_input@
#
######################################################################
# gmmproc (version 4)
######################################################################
#
# *** WARNING: Only modify gmmproc.in. gmmproc is built. ***
#
# Copyright 2001, Karl Einar Nelson, Murray Cumming
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or 
# (at your option) any later version.
#
# This program 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 General Public License for more details. 
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#
#
# 'classes':
# WrapParser: steps through .hg and .ccg files, outputting appropriate m4 code with Outputter.
# Outputter: Used by WrapParser to output wrapper code. Outputs *.g1 temp file
#            and uses m4 to generate *.g2 from it. Then outputs .h and .cc files.
# Function: Contains information about C and C++ functions and signals.
#
######################################################################

########################## 'main()' ##################################

$main::procdir;
$main::m4path;
$main::glibmm_version;

BEGIN {
  # get prefix info from configure
  my $prefix = "@prefix@";
  my $exec_prefix = "@exec_prefix@";
  my $libdir = "@libdir@";

  # This line must match the install directory
  $main::procdir = $libdir . '/@GLIBMM_MODULE_NAME@/proc';
  $main::m4path = "@M4@";
  $main::glibmm_version = "@PACKAGE_VERSION@";

  push(@INC, $main::procdir . '/pm');
}

use strict;
use warnings;

use Output;
use WrapParser;

# initialize globals 
@main::macrodirs         = ();
$main::srcdir            = '.';
$main::defsdir           = '.';
$main::source            = '';
$main::unwrapped         = 1;
$main::return_mismatches = (exists $ENV{'GMMPROC_RETURN_MISMATCHES'}) ? $ENV{'GMMPROC_RETURN_MISMATCHES'} : 0;
$main::debug             = (exists $ENV{'GMMPROC_DEBUG'}) ? $ENV{'GMMPROC_DEBUG'} : '';

# prototypes
sub parse_command_line_args();

#main()
parse_command_line_args();

# Don't remove the space between \ and @. When glibmm is built with Meson,
# the \ would be removed in gmmproc.
my $objOutputter = &Output::new($main::m4path, \ @main::macrodirs);
my $objWrapParser = &WrapParser::new($objOutputter);

$$objWrapParser{srcdir} = $main::srcdir;
$$objWrapParser{defsdir} = $main::defsdir;
$$objWrapParser{source} = $main::source;
$$objOutputter{source} = $main::source;
$$objOutputter{destdir} = $ARGV[1];

# Merge the C docs, e.g. gtk_docs.xml

# Suck the whole file into one big string, breaking it into tokens:
$objWrapParser->read_file($main::srcdir, $main::source);

# Parse output 
$objWrapParser->parse_and_build_output();

# Write out *.g1 temporary file:
$objOutputter->output_temp_g1($$objWrapParser{module}, $main::glibmm_version); # e.g. gtkmm, 2.38.0

# Execute m4 to get *.g2 file:
{
  my $exitcode = $objOutputter->make_g2_from_g1();
  if ($exitcode)
  {
    $objOutputter->remove_temp_files() unless ($main::debug);

    print STDERR "m4 failed with exit code $exitcode.  Aborting...\n";
    exit($exitcode);
  }
}

# Section out the resulting output
$objOutputter->write_sections_to_files();
$objOutputter->remove_temp_files() unless ($main::debug);

#Warn about any unwrapped function/signals:
if ($main::unwrapped)
{ 
  my @unwrapped = GtkDefs::get_unwrapped();
  @unwrapped = grep { exists $$_{entity_type} } @unwrapped;

  if (@unwrapped)
  {
    my @methods = grep { $$_{entity_type} eq 'method' and $$_{c_name} !~ m/^_/s } @unwrapped;
    my @signals = grep { $$_{entity_type} eq 'signal' } @unwrapped;
    # Don't take non-readable construct-only properties into account.
    my @properties = grep { $$_{entity_type} eq 'property' and ( $$_{readable} or not $$_{construct_only} ) } @unwrapped;

    # Don't print a name of any kind between the first and second colon on a line,
    # if there is any chance that "error" is (part of) the name.
    # MS Visual Studio will misunderstand.
    # See https://mail.gnome.org/archives/gtkmm-list/2014-November/msg00044.html

    local $, = "\ngmmproc:   ";
    local $\ = "\n";

    if (@methods)
    {
      print STDERR ("gmmproc, $main::source: Unwrapped functions:",
                    map($$_{c_name}, @methods));
    }
    if (@properties)
    {
      print STDERR ("gmmproc, $main::source: Unwrapped properties:",
                    map($$_{class} . '::' . $$_{name}, @properties));
    }
    if (@signals)
    { 
      print STDERR ("gmmproc, $main::source: Unwrapped signals:",
                    map($$_{class} . '::' . $$_{name}, @signals));
    }
  }
}

# end of program
exit;


####################################################################


sub print_usage()
{
  print
'Usage: gmmproc [options] name srcdir destdir
  -h 
  --help               This usage message.

  --doc                Produces a header file for documentation.  (FIXME)

  --debug              Leave intermediate output arround for analysis.
                       Alternatively, set GMMPROC_DEBUG=1 in the environment.

  --unwrapped          Warn about possible unwrapped functions.

  --return-mismatches  Warn about possible method return mismatches.

  --defs dir           Change the directory to seach for defs.

  -I dir               Specify the directory with m4 files.


Note: This will read srcdir/name.{hg,ccg} file and generates destdir/name.cc
';
  exit(1);
}

# void parse_command_line_args()
sub parse_command_line_args()
{
  print_usage() if ($#ARGV == -1);

  while ($#ARGV != -1)
  {
    $_ = shift @ARGV;

    if (/^-/)
    {
      print_usage() if ( /^--help/);
      print_usage() if ( /^-h/);
      if (/^-I/)
      {
        push @main::macrodirs, shift @ARGV;
      }
      elsif (/^--unwrapped/)
      {
        $main::unwrapped = 1;
      }
      elsif (/^--return-mismatches/)
      {
        $main::return_mismatches = 1;
      }
      elsif (/^--defs/)
      {
        $main::defsdir = shift @ARGV;
      }
      elsif (/^--debug/)
      {
        $main::debug = 1;
      }
      else
      {
        print "unknown parameter $_\n";
      }
      next;
    }

    last;
  }

  # we already have one argument

  if ($#ARGV != 1)
  {
    print STDERR ('Invalid number of arguments (', $#ARGV + 2, ")\n");
    print_usage();
  }

  $main::srcdir = $ARGV[0];
  $main::source = $_;

  push @main::macrodirs, $main::procdir . '/m4';
}