[glibmm] Tools: Added a defs fixer tool.

[Krzesimir Nowak <krnowak src gnome org>]

commit f23cecd5a7a242688abf36b433ae8c4c099f06c5
Author: Krzesimir Nowak <qdlacz gmail com>
Date:   Sat Jan 8 14:15:22 2011 +0100

    Tools: Added a defs fixer tool.
    
    tools/defs_fixer.pl: Helper tool to fix the generated defs. I hope
    that for most cases it will be just better than using diff and patch.

 ChangeLog           |    7 ++
 tools/defs_fixer.pl |  196 +++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 203 insertions(+), 0 deletions(-)
---
diff --git a/ChangeLog b/ChangeLog
index b6b2c34..9d2fe10 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2011-01-08  Krzesimir Nowak  <qdlacz gmail com>
+
+	Tools: Added a defs fixer tool.
+
+	tools/defs_fixer.pl: Helper tool to fix the generated defs. I hope
+	that for most cases it will be just better than using diff and patch.
+
 2011-01-07  José Alburquerque  <jaalburqu svn gnome org>
 
 	DBusConnection: Callbacks: Check for NULL GError** parameters.
diff --git a/tools/defs_fixer.pl b/tools/defs_fixer.pl
new file mode 100644
index 0000000..e59c13c
--- /dev/null
+++ b/tools/defs_fixer.pl
@@ -0,0 +1,196 @@
+#!/usr/bin/perl
+#
+# Copyright (C) 2010 The gtkmm Development Team
+#
+# 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., 675 Mass Ave, Cambridge, MA 02139, USA.
+#
+#
+#
+# This script just fixes automatically generated defs files. It does not
+# override single line defs. To override a def a first two lines of the def
+# and its override must match. See gtk_signals.defs and gtk_defs.overrides
+# in gtkmm's gtk/src/gtk directory.
+#
+# Usage: defs_fixer.pl defs overrides
+#
+use strict;
+use warnings;
+use IO::File;
+
+sub main ();
+sub read_file ($);
+sub override ($$);
+sub get_header($);
+sub get_quoted_text ($);
+sub write_file ($$);
+sub get_end_token_index ($$);
+
+main ();
+
+sub main ()
+{
+  if (@ARGV != 2)
+  {
+    print STDERR "usage: defs_fixer.pl defs_file override_file\n";
+    exit 1;
+  }
+
+  my $defs_a_r = read_file ($ARGV[0]);
+  my $overrides_a_r = read_file ($ARGV[1]);
+
+  unless (@{$defs_a_r})
+  {
+    print STDERR join ('', $ARGV[0], 'holds no tokens.', "\n");
+    exit 1;
+  }
+
+  unless (@{$overrides_a_r})
+  {
+    print STDERR join ('', $ARGV[1], 'holds no tokens.', "\n");
+    exit 1;
+  }
+
+  if (override ($defs_a_r, $overrides_a_r))
+  {
+    write_file ($ARGV[0], $defs_a_r);
+  }
+  else
+  {
+    print STDOUT "Nothing to fix.\n";
+  }
+  exit 0;
+}
+
+sub read_file($)
+{
+  my $buf_a_r = [];
+  my $path = shift;
+  my $file = IO::File->new ($path, 'r');
+
+  unless (defined ($file))
+  {
+    print STDERR join ('', 'Failed to open file: ', $path, "\n");
+    exit 1;
+  }
+
+  @{$buf_a_r} = <$file>;
+  $file->close ();
+  return $buf_a_r;
+}
+
+sub override($$)
+{
+  my $defs_a_r = shift;
+  my $overrides_a_r = shift;
+  my $defs_index = 0;
+  my $anything_changed = 0;
+
+  for (my $defs_index = 0; $defs_index < @{$defs_a_r}; ++$defs_index)
+  {
+    my $def = $defs_a_r->[$defs_index];
+    my $def_header = get_header ($def);
+
+    if ($def_header ne '<!>')
+    {
+      my $overrides_index = 0;
+
+      for (my $overrides_index = 0; $overrides_index < @{$overrides_a_r}; ++$overrides_index)
+      {
+        my $override = $overrides_a_r->[$overrides_index];
+        my $override_header = get_header ($override);
+
+        if ($override_header ne '<!>')
+        {
+          if ($def_header eq $override_header
+              and $defs_index + 1 < @{$defs_a_r}
+              and $overrides_index + 1 < @{$overrides_a_r}
+              and $defs_a_r->[$defs_index + 1] eq $overrides_a_r->[$overrides_index + 1]
+             )
+          {
+            my $defs_end_index = get_end_token_index ($defs_a_r, $defs_index);
+            my $overrides_end_index = get_end_token_index ($overrides_a_r, $overrides_index);
+            # replace a def with override
+            splice (@{$defs_a_r}, $defs_index, $defs_end_index - $defs_index, @{$overrides_a_r}[$overrides_index .. $overrides_end_index - 1]);
+            # remove an override from overrides
+            splice (@{$overrides_a_r}, $overrides_index, $overrides_end_index - $overrides_index);
+            print join ('', 'Fixed \'', $def_header, '\' (', get_quoted_text ($defs_a_r->[$defs_index + 1]), ").\n");
+            $anything_changed = 1;
+            last;
+          }
+        }
+      }
+    }
+  }
+  return $anything_changed;
+}
+
+sub get_header ($)
+{
+  my $token = shift;
+  # we do not care about single line defs - they do not happen in generated
+  # defs, so we mark them as <!>.
+  if ($token =~ /^\((\S+\s+\S+[^)])\n$/)
+  {
+    my $header = $1;
+    $header =~ s/\s+/ /g;
+    return $header;
+  }
+  return '<!>';
+}
+
+sub get_quoted_text ($)
+{
+  my $line = shift;
+
+  if ($line =~ /"([^"]*)"/)
+  {
+    return $1;
+  }
+  return "null";
+}
+
+sub write_file ($$)
+{
+  my $path = shift;
+  my $defs_a_r = shift;
+  my $file = IO::File->new ($path, 'w');
+
+  unless (defined ($file))
+  {
+    print STDERR join ('', 'Failed to open file for writing: ', $path, "\n");
+    exit 1;
+  }
+
+  for my $def (@{$defs_a_r})
+  {
+    print $file $def;
+  }
+}
+
+# returns an index that is one past the def.
+sub get_end_token_index ($$)
+{
+  my $lines_a_r = shift;
+  my $start_index = shift;
+
+  for (my $iter = $start_index; $iter < @{$lines_a_r}; ++$iter)
+  {
+    if ($lines_a_r->[$iter] eq ")\n")
+    {
+      return $iter + 1;
+    }
+  }
+  return 0 + @{$lines_a_r};
+}