You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
85 lines
2.4 KiB
85 lines
2.4 KiB
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;
|