use MDK::Common;

BEGIN {
    @ARGV or warn(<<EOF), exit 1;
usage: unused/migrate-ugtk2-to-mygtk2.pl -pi <file.pm>

- an emacs is launched with a script fixing the closing "children => [ ...",
  simply save the file and exit this emacs
- you can replace -pi with -n to see the diff of changes without modifying the file
EOF
    @args = @ARGV;
    $re = qr/(?:[^()\[\]]*(?:\([^()]*\))?(?:\[[^\[\]]*\])?)*/;
    $assign = qr/(?:(?:my\s+)?\$\w+\s*=\s*)/;

    %pack = (gtkadd => 'children_loose', gtkpack_ => 'children', gtkpack => 'children_loose', gtkpack__ => 'children_tight');
}

$z = $_;

$once = 0;
$b = 1;

while ($b) {
    $b = 0;

    if (my ($before, $class, undef, $new, $arg, $after, $after2) = /(.*?)Gtk2::(\w+(::\w+)*)->(new\w*)(?:\(($re)\)(.*)|([^(].*))/s) {
	$after ||= $after2;
	my $s;

	my $class_ = $class eq 'WrappedLabel' ? 'Label' : $class;
	
	if ($class_ eq 'Window') {
	    if ($new eq 'new') {
		$s = $arg && $arg !~ /^['"]toplevel['"]$/ ?
		  "gtknew('$class', type => $arg)" :
		    "gtknew('$class')";
	    }
	} elsif ($class_ eq 'Dialog') {
	    if ($new eq 'new' && !$arg) {
		$s = "gtknew('$class')";
	    }
	} elsif ($class_ eq 'Image') {
	    if ($new eq 'new_from_file' && $arg) {
		$s = "gtknew('$class', file => $arg)";
	    }
	} elsif ($class_ eq 'Gdk::Pixbuf') {
	    if ($new eq 'new_from_file' && $arg) {
		$s = "gtknew('Pixbuf', file => $arg)";
	    }
	} elsif ($class_ eq 'Frame' || $class_ eq 'Label') {
	    if ($new eq 'new') {
		$s = $arg ? "gtknew('$class', text => $arg)" : "gtknew('$class')";
	    }
	} elsif ($class_ eq 'WrappedLabel') {
	    if ($new eq 'new') {
		if ($arg =~ /($re),\s*($re)/) {
		    $s = "gtknew('$class', alignment => [ $2, 0.5 ], text => $1)";
		} elsif ($arg) {
		    $s = "gtknew('$class', text => $arg)";
		} else {
		    $s = "gtknew('$class')";
		}
	    }
	} elsif ($class_ eq 'HBox' || $class_ eq 'VBox') {
	    if ($new eq 'new') {
		if ($arg =~ /($re),\s*($re)/) {
		    $s = "gtknew('$class'" . ($1 ? ", homogenous => $1" : '') . ($2 ? ", spacing => $2" : '') . ')';
		} else {
		    $s = "gtknew('$class')";
		}
		
	    }
	} elsif ($class_ eq 'ComboBox') {
	    if ($new eq 'new_text') {
		$s = "gtknew('$class')";
	    } elsif ($new eq 'new_with_strings' && $arg) {
		if (my ($l, $t) = $arg =~ /($re),\s*($re)/) {
		    if ($t !~ /\]/) {
			$s = "gtknew('$class', text => $t, list => $l)";
		    }
		} else {
		    $s = "gtknew('$class', list => $arg)";
		}
	    }
	} elsif ($class_ eq 'Button' || $class_ eq 'ToggleButton' || $class_ eq 'CheckButton') {
	    if ($new eq 'new') {
		$s = $arg ? "gtknew('$class', text => $arg)" : "gtknew('$class')";
	    } elsif ($new eq 'new_with_mnemonic' && $arg) {
		$s = "gtknew('$class', text => $arg)";
	    } elsif ($new eq 'new_with_label' && $arg) {
		$s = "gtknew('$class', mnemonic => 0, text => $arg)";
	    }
	} elsif ($class =~ /^(HSeparator|VSeparator|Notebook|HButtonBox|VButtonBox|TextView|Entry|Calendar)$/) {
	    if ($new eq 'new') {
		$s = "gtknew('$class')";
	    }
	}

	if ($s) {
	    $_ = "$before$s$after";
	    $b = 1;
	}
    }

    $b = 1 if s/create_hbox\((['"].*?['"])\)/gtknew('HButtonBox', layout => $1)/ ||
              s/create_hbox\(\)/gtknew('HButtonBox')/;

    if (my ($arg) = /create_scrolled_window\(($re)\)/) {
	my $val;
	if (my ($child, $policy) = $arg =~ /^($re)\s*,\s*($re)$/) {
	    if (my ($h, $v) = $policy =~ /^\[\s*($re)\s*,\s*($re)\s*\]$/) {
		foreach ($h, $v) {
		    $_ = /never/i ? 'never' : /always/ ? 'always' : '';
		}
		$val = join(', ', if_($h, "h_policy => '$h'"), if_($v, "v_policy => '$v'"), "child => $child");
	    } else {
		#- ???
	    }
	} else {
	    $val = "child => $arg";
	}
	$b = 1 if $val && s/create_scrolled_window\($re\)/gtknew('ScrolledWindow', $val)/;
    }

    $b = 1 if s/create_packtable\(\{($re)\},/my $s = prepost_chomp($1); "gtknew('Table', " . ($s ? "$s, " : '') . "children => ["/e;

    $b = 1 if s/gtkcreate_img\(($re)\)/gtknew('Image', file => $1)/;
    $b = 1 if s/gtkcreate_pixbuf\(($re)\)/gtknew('Pixbuf', file => $1)/;

    $b = 1 if s/(gtkadd|gtkpack_{0,2})\(($assign?gtknew\('[HV](?:Button)?Box'$re)\),/"$2, " . $pack{$1} . " => ["/e;

    $b = 1 if s/(\$\w+)->set_label\(($re)\)/gtkset($1, text => $2)/;

    while (dorepl_new()) {
	$b = 1;
    }
    while (dorepl()) {
	$b = 1;
    }
    $once ||= $b;
}

sub dorepl_new {
    if (my ($before, $f, $gtk, $arg, $after) = /(.*?)(gtk\w+)\(($assign?gtk(?:new|set))\(($re)\)\s*,[ \t]*(.*)/s) {
	my $s;
	my $class;
	if ($gtk =~ /gtknew$/) {
	    ($class) = $arg =~ /^'(.*?)'/ or return;
	}
	my $class_ = $class eq 'WrappedLabel' ? 'Label' : $class;
	my $pre = "$gtk($arg";

	if ($f eq 'gtksignal_connect') {
	    if ($class_ eq 'Button' || !$class) {
		$s = "$pre, ";
	    }
	} elsif ($f eq 'gtkadd') {
	    if ($class_ eq 'Frame' || !$class) {
		$s = "$pre, child => ";
	    }
	} elsif ($f eq 'gtkset_justify') {
	    if ($class_ eq 'Label' || !$class) {
		$s = "$pre, justify => ";
	    }
	} elsif ($f eq 'gtkset_markup') {
	    if ($class_ eq 'Label' || !$class) {
		$s = "$pre, text_markup => ";
	    }
	} elsif ($f eq 'gtkmodify_font') {
	    if ($class_ eq 'Label' || !$class) {
		$s = "$pre, font => ";
	    }
	} elsif ($f eq 'gtktext_insert') {
	    if ($class_ eq 'TextView' || !$class) {
		$s = "$pre, text => ";
	    }
	}

	if (!$s) {
	    if ($f =~ /^gtkset_(relief|sensitive|shadow_type|modal|border_width|layout|editable)$/) {
		$s = "$pre, $1 => ";
	    } elsif ($f eq 'gtkset_name') {
		$s = "$pre, widget_name => ";
	    } elsif ($f eq 'gtkset_size_request') {
		if ($after =~ /($re)\s*,\s*($re)\)(.*)/s) {
		    $s = $pre . ($1 && $1 ne '-1' ? ", width => $1" : '') . ($2 && $2 ne '-1' ? ", height => $2" : '') . ')';
		    $after = $3;
		}
	    }
	}
	if ($s) {
	    $_ = "$before$s$after";
	}
	$s;
    }
}

sub dorepl {
    s/gtkdestroy\(/mygtk2::may_destroy(/ ||
    s/gtkset_background\(/mygtk2::set_root_window_background(/ ||
    s/gtkset_tip\($re,\s*($re),\s*($re)\)/gtkset($1, tip => $2)/ ||
    s/gtkset_size_request\(($re),\s*($re), ($re)\)/"gtkset($1" . ($2 && $2 ne '-1' ? ", width => $2" : '') . ($3 && $3 ne '-1'  ? ", height => $3" : '') . ')'/e ||
    s/gtkset_(modal)\(($re),\s*($re)\)/gtkset($2, $1 => $3)/ ||
      0;
}

sub prepost_chomp {
    my ($s) = @_;
    $s =~ s/^\s*//;
    $s =~ s/\s*$//;
    $s;
}

print STDERR "-$z+$_" if $once;

END {
    if (defined $^I) {
	foreach (@args) {
	    warn "$_: closing children using emacs\n";
	    system('emacs', '-q', '-l', 'unused/migrate-ugtk2-to-mygtk2.el', $_, '-f', 'my-close-children') 
	}
    }
}
'>11</a>
<a id='n12' href='#n12'>12</a>
<a id='n13' href='#n13'>13</a>
<a id='n14' href='#n14'>14</a>
<a id='n15' href='#n15'>15</a>
<a id='n16' href='#n16'>16</a>
<a id='n17' href='#n17'>17</a>
<a id='n18' href='#n18'>18</a>
<a id='n19' href='#n19'>19</a>
<a id='n20' href='#n20'>20</a>
<a id='n21' href='#n21'>21</a>
<a id='n22' href='#n22'>22</a>
<a id='n23' href='#n23'>23</a>
<a id='n24' href='#n24'>24</a>
<a id='n25' href='#n25'>25</a>
<a id='n26' href='#n26'>26</a>
<a id='n27' href='#n27'>27</a>
<a id='n28' href='#n28'>28</a>
<a id='n29' href='#n29'>29</a>
<a id='n30' href='#n30'>30</a>
<a id='n31' href='#n31'>31</a>
<a id='n32' href='#n32'>32</a>
<a id='n33' href='#n33'>33</a>
<a id='n34' href='#n34'>34</a>
<a id='n35' href='#n35'>35</a>
<a id='n36' href='#n36'>36</a>
<a id='n37' href='#n37'>37</a>
<a id='n38' href='#n38'>38</a>
<a id='n39' href='#n39'>39</a>
<a id='n40' href='#n40'>40</a>
<a id='n41' href='#n41'>41</a>
<a id='n42' href='#n42'>42</a>
<a id='n43' href='#n43'>43</a>
<a id='n44' href='#n44'>44</a>
<a id='n45' href='#n45'>45</a>
<a id='n46' href='#n46'>46</a>
<a id='n47' href='#n47'>47</a>
<a id='n48' href='#n48'>48</a>
<a id='n49' href='#n49'>49</a>
<a id='n50' href='#n50'>50</a>
<a id='n51' href='#n51'>51</a>
<a id='n52' href='#n52'>52</a>
<a id='n53' href='#n53'>53</a>
<a id='n54' href='#n54'>54</a>
<a id='n55' href='#n55'>55</a>
<a id='n56' href='#n56'>56</a>
<a id='n57' href='#n57'>57</a>
<a id='n58' href='#n58'>58</a>
</pre></td>
<td class='lines'><pre><code>