blob: d0c3275b226cdc39c220d7fc3eadfb3717e9428e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
package TQt::signals;
use Carp;
#
# Proposed usage:
#
# use TQt::signals fooActivated => ['int'];
#
# use TQt::signals fooActivated => {
# name => 'fooActivated(int)',
# args => ['int']
# };
#
# sub whatever { emit fooActivated(10); }
#
sub import {
no strict 'refs';
my $self = shift;
my $caller = $self eq "TQt::signals" ? (caller)[0] : $self;
my $parent = ${ $caller . '::ISA' }[0];
my $parent_qt_emit = $parent . '::tqt_emit';
TQt::_internal::installqt_invoke($caller . '::tqt_emit') unless defined &{ $caller. '::tqt_emit' };
# *{ $caller . '::tqt_emit' } = sub {
# my $meta = \%{ $caller . '::META' };
# die unless $meta->{object};
# my $offset = $_[0] - $meta->{object}->signalOffset;
# if($offset >= 0) {
# TQt::_internal::invoke(TQt::this(), $meta->{signals}[$offset], $_[1]);
# return 1;
# } else {
# TQt::this()->$parent_qt_emit(@_);
# }
# } unless defined &{ $caller . '::tqt_emit' };
my $meta = \%{ $caller . '::META' };
croak "Odd number of arguments in signal declaration" if @_%2;
my(%signals) = @_;
for my $signalname (keys %signals) {
my $signal = { name => $signalname };
my $args = $signals{$signalname};
$signal->{arguments} = [map { s/\s(?=[*&])//; { type => $_, name => "" } } @$args];
my $arglist = join ',', @$args;
$signal->{prototype} = $signalname . "($arglist)";
$signal->{returns} = 'void';
$signal->{method} = $signalname;
push @{$meta->{signals}}, $signal;
my $signal_index = $#{ $meta->{signals} };
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 signal argument ($arg)\n" unless $valid;
$i++;
}
$meta->{signal}{$signalname} = $signal;
$signal->{index} = $signal_index;
$signal->{mocargs} = $mocargs;
$signal->{argcnt} = $argcnt;
TQt::_internal::installsignal("$caller\::$signalname");
}
@_ and $meta->{changed} = 1;
}
1;
|
