package TQt::slots;
use Carp;
#
# Proposed usage:
#
# use TQt::slots changeSomething => ['int'];
#
# use TQt::slots 'changeSomething(int)' => {
#     args => ['int'],
#     call => 'changeSomething'
# };
#

sub import {
    no strict 'refs';
    my $self = shift;
    my $caller = $self eq "TQt::slots" ? (caller)[0] : $self;
    my $parent = ${ $caller . '::ISA' }[0];
    my $parent_qt_invoke = $parent . '::tqt_invoke';

    TQt::_internal::installqt_invoke($caller . '::tqt_invoke') unless defined &{ $caller. '::tqt_invoke' };

#    *{ $caller . '::tqt_invoke' } = sub {
#	my $meta = \%{ $caller . '::META' };
#	die unless $meta->{object};
#	my $offset = $_[0] - $meta->{object}->slotOffset;
#	if($offset >= 0) {
#	    TQt::_internal::invoke(TQt::this(), $meta->{slots}[$offset], $_[1]);
#	    return 1;
#	} else {
#	    TQt::this()->$parent_qt_invoke(@_);
#	}
#    } unless defined &{ $caller . '::tqt_invoke' };

    my $meta = \%{ $caller . '::META' };
    croak "Odd number of arguments in slot declaration" if @_%2;
    my(%slots) = @_;
    for my $slotname (keys %slots) {
	my $slot = { name => $slotname };
	my $args = $slots{$slotname};
	$slot->{arguments} = [map { s/\s(?=[*&])//; { type => $_, name => "" } } @$args];
	my $arglist = join ',', @$args;

	$slot->{prototype} = $slotname . "($arglist)";
        if ( exists $meta->{slot}{$slotname} ) {
           (my $s1 = $slot->{prototype}) =~ s/\s+//g;
           (my $s2 = $meta->{slot}{$slotname}{prototype})  =~ s/\s+//g; 
           if( $s1 ne $s2 ) {
               warn( "Slot declaration:\n\t$slot->{prototype}\nwill override ".
                     "previous declaration:\n\t$meta->{slot}{$slotname}{prototype}");
           } else {
               next;
           }      
        }        
	$slot->{returns} = 'void';
	$slot->{method} = $slotname;
	push @{$meta->{slots}}, $slot;
	my $slot_index = $#{ $meta->{slots} };

	my $argcnt = scalar @$args;
	my $mocargs = TQt::_internal::allocateMocArguments($argcnt);
	my $i = 0;
	for my $arg (@$args) {
	    my $a = $arg;
	    $a =~ s/^const\s+//;
	    if($a =~ /^(bool|int|double|char\*|TQString)&?$/) {
		$a = $1;
	    } else {
		$a = 'ptr';
	    }
	    my $valid = TQt::_internal::setMocType($mocargs, $i, $arg, $a);
	    die "Invalid type for slot argument ($arg)\n" unless $valid;
	    $i++;
	}

	$meta->{slot}{$slotname} = $slot;
	$slot->{index} = $slot_index;
	$slot->{mocargs} = $mocargs;
	$slot->{argcnt} = $argcnt;
    }
    @_ and $meta->{changed} = 1;
}

1;