view release on metacpan or  search on metacpan

tools/gendefs.pl  view on Meta::CPAN

#!/usr/bin/perl -w

package gendefs;

sub gendefs {
	local(@ARGV) = @_;

# Minimal LISP lexer/parser. No quote escapes currently handled.
sub parse_lisp
{
	local($_) = @_;
	my(@result) = ();
	my($node) = \@result;
	my(@parent) = ();
	while ( m/(\()|(\))|("(.*?)")|(;.*?$)|([^\(\)\s]+)/gm) {
		if (defined($1)) {
			my($new) = [];
			push @$node, $new;
			push @parent, $node;
			$node = $new;
		} elsif (defined($2)) {
			$node = pop @parent;
		} elsif (defined($3)) {
			push @$node, $4;
		} elsif (defined($6)) {
			push @$node, $6;
		}
	}
	@result;
}

sub perlize {
	local($_) = $_[0];
#	if (!/^(Gtk|Gdk)/) {
#		s/^([A-Z][a-z]*)/Gtk$1::/;
#	}
#	s/^Gtk/Gtk::/;
#	s/^Gtk::Gdk/Gtk::Gdk::/;
#	s/^Gdk/Gtk::Gdk::/;
	foreach $p (@prefix) {
		my($f, $t) = @{$p};
		next if /^${t}::/;
		s/^$f/${t}::/;
	}
	$_;
}

sub xsize {
	local($_) = @_;
	s/::/__/g;
	$_;
}

sub typeize {
	local($_) = @_;
	#my ($old) = $_;
	#s/([A-Z])/_$1/g;
	s/([A-Z][a-z])/_$1/g;
	s/([a-z])([A-Z])/$1_$2/g;
	$_ = uc $_;
	s/_([A-Z])_/_$1/g;
	s/^_GTK//;
	# exceptions
	#s/GNOME_MD_I/GNOME_MDI_/;
	#warn "BOO: $_\n" if "GTK_TYPE$_" ne oldtypeize($old);
	return "GTK_TYPE".$_;