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