← Back to branch summary

~ubuntu-branches/ubuntu/natty/kdebindings/natty

« back to all changes in this revision

Viewing changes to perl/qtcore/lib/QtCore4.pm

  • Committer: Bazaar Package Importer
  • Author(s): Jonathan Riddell
  • Date: 2010-12-01 11:14:38 UTC
  • mfrom: (1.1.41 upstream)
  • Revision ID: james.westby@ubuntu.com-20101201111438-1q61cvs8zw118t3m
Tags: 4:4.5.80-0ubuntu1
* New upstream release
* Remove build-dep on libqimageblitz-dev, causes smoke to segfault

Show diffs side-by-side

added added

removed removed

Lines of Context:
perl/qtcore/lib/QtCore4.pm
35
35
    return Qt::qApp()->translate( $context, @_ );
36
36
}
37
37
 
 
38
sub getPointer {
 
39
    my ( $self ) = @_;
 
40
    $self = Qt::this() if !defined $self;
 
41
    return Qt::_internal::sv_to_ptr( $self );
 
42
}
 
43
 
38
44
package Qt::base::_overload;
39
45
use strict;
40
46
 
407
413
    '^'  => 'Qt::enum::_overload::op_xor',
408
414
    '|'  => 'Qt::enum::_overload::op_or',
409
415
    '&'  => 'Qt::enum::_overload::op_and',
 
416
    '~'  => 'Qt::enum::_overload::op_unarynegate',
410
417
    '--' => 'Qt::enum::_overload::op_decrement',
411
418
    '++' => 'Qt::enum::_overload::op_increment',
412
419
    'neg'=> 'Qt::enum::_overload::op_negate';
629
636
    }
630
637
}
631
638
 
 
639
sub op_unarynegate {
 
640
    return bless( \(~${$_[0]}), ref $_[0] );
 
641
}
 
642
 
632
643
sub op_decrement {
633
644
    return --${$_[0]};
634
645
}
648
659
 
649
660
our @EXPORT_OK;
650
661
 
651
 
unless(exists $::INC{'QtCore4/GlobalSpace.pm'}) {
652
 
    $::INC{'QtCore4/GlobalSpace.pm'} = $::INC{'QtCore4.pm'};
 
662
push @EXPORT_OK, qw(
 
663
LicensedActiveQt
 
664
LicensedCore
 
665
LicensedDBus
 
666
LicensedDeclarative
 
667
LicensedGui
 
668
LicensedHelp
 
669
LicensedMultimedia
 
670
LicensedNetwork
 
671
LicensedOpenGL
 
672
LicensedOpenVG
 
673
LicensedQt3Support
 
674
LicensedQt3SupportLight
 
675
LicensedScript
 
676
LicensedScriptTools
 
677
LicensedSql
 
678
LicensedSvg
 
679
LicensedTest
 
680
LicensedXml
 
681
LicensedXmlPatterns
 
682
qAcos
 
683
qAddPostRoutine
 
684
qAppName
 
685
qAsin
 
686
qAtan
 
687
qAtan2
 
688
qbswap_helper
 
689
qCeil
 
690
qChecksum
 
691
Q_COMPLEX_TYPE
 
692
qCompress
 
693
qCos
 
694
qCritical
 
695
qDebug
 
696
Q_DUMMY_TYPE
 
697
qExp
 
698
qFabs
 
699
qFastCos
 
700
qFastSin
 
701
qFlagLocation
 
702
qFloor
 
703
qFree
 
704
qFreeAligned
 
705
qFuzzyCompare
 
706
qFuzzyIsNull
 
707
qgetenv
 
708
qHash
 
709
qInf
 
710
qInstallMsgHandler
 
711
qIntCast
 
712
qIsFinite
 
713
qIsInf
 
714
qIsNaN
 
715
qIsNull
 
716
qLn
 
717
qMalloc
 
718
qMallocAligned
 
719
qMemCopy
 
720
qMemSet
 
721
Q_MOVABLE_TYPE
 
722
qPow
 
723
Q_PRIMITIVE_TYPE
 
724
qputenv
 
725
qQNaN
 
726
qrand
 
727
qRealloc
 
728
qReallocAligned
 
729
qRegisterStaticPluginInstanceFunction
 
730
qRemovePostRoutine
 
731
qRound
 
732
qRound64
 
733
qSetFieldWidth
 
734
qSetPadChar
 
735
qSetRealNumberPrecision
 
736
qSharedBuild
 
737
qSin
 
738
qSNaN
 
739
qSqrt
 
740
qsrand
 
741
Q_STATIC_TYPE
 
742
qstrcmp
 
743
qstrcpy
 
744
qstrdup
 
745
qstricmp
 
746
qStringComparisonHelper
 
747
qstrlen
 
748
qstrncmp
 
749
qstrncpy
 
750
qstrnicmp
 
751
qstrnlen
 
752
qTan
 
753
qt_assert
 
754
qt_assert_x
 
755
qt_check_pointer
 
756
QtCriticalMsg
 
757
QtDebugMsg
 
758
qt_error_string
 
759
QtFatalMsg
 
760
qt_message_output
 
761
qt_noop
 
762
qt_qFindChild_helper
 
763
qt_qFindChildren_helper
 
764
QtSystemMsg
 
765
qtTrId
 
766
QtWarningMsg
 
767
qUncompress
 
768
qvariant_cast_helper
 
769
qVersion
 
770
qvsnprintf
 
771
qWarning
 
772
);
 
773
 
 
774
unless(exists $::INC{'Qt/GlobalSpace.pm'}) {
 
775
    $::INC{'Qt/GlobalSpace.pm'} = $::INC{'QtCore4.pm'};
653
776
}
654
777
 
655
778
sub import {
673
796
use strict;
674
797
use warnings;
675
798
use Scalar::Util qw( blessed );
 
799
use List::MoreUtils qw( any );
676
800
 
677
801
# These 2 hashes provide lookups from a perl package name to a smoke
678
802
# classid, and vice versa
687
811
 
688
812
our %customClasses;
689
813
 
 
814
our %vectorTypes;
 
815
 
690
816
my %arrayTypes = (
691
817
    'const QList<QVariant>&' => {
692
818
        value => [ 'QVariant' ]
747
873
        my $typeName = getTypeNameOfArg( $smokeId, $methodId, $argNum );
748
874
        #ints and bools
749
875
        if ( $argType eq 'i' ) {
750
 
            if( $typeName =~ m/^(?:bool|(?:(?:un)?signed )?(?:int|long)|uint)[*&]?$/ ) {
 
876
            if( $typeName =~ m/^(?:bool|(?:(?:un)?signed )?(?:int|(?:long )?long)|uint)[*&]?$/ ) {
751
877
                $match{$methodIdIdx} = [0,[$smokeId,$methodId]];
752
878
            }
753
879
        }
760
886
        # enums
761
887
        elsif ( $argType eq 'e' ) {
762
888
            my $refName = ref $args->[$argNum];
763
 
            if( $typeName =~ m/^$refName[s]?$/ ) {
 
889
            if( $typeName =~ m/^(?:QFlags<)?$refName[s]?[>]?$/ ) {
764
890
                $match{$methodIdIdx} = [0,[$smokeId,$methodId]];
765
891
            }
766
892
        }
880
1006
        else {
881
1007
            # Optional const, some words, optional & or *.  Note ?: does not
882
1008
            # make a backreference, (\w*) is the only thing actually captured.
 
1009
            my $isConst = ($typeName =~ m/const/);
883
1010
            $typeName =~ s/^(?:const\s+)?(\w*)[&*]?$/$1/g;
884
1011
            my $isa = classIsa( $argType, $typeName );
885
1012
            if ( $isa != -1 ) {
 
1013
                ++$isa if $isConst;
886
1014
                $match{$methodIdIdx} = [-$isa, [$smokeId,$methodId]];
887
1015
            }
888
1016
        }
926
1054
    return @methods;
927
1055
}
928
1056
 
 
1057
sub uniqMethods {
 
1058
    my ($methodIds, $numArgs) = @_;
 
1059
    my %hash;
 
1060
    foreach my $moduleId ( reverse @{$methodIds} ) {
 
1061
        my $smokeId = $moduleId->[0];
 
1062
        my $methodId = $moduleId->[1];
 
1063
        my $sig = join ',', map{
 
1064
            my $str = getTypeNameOfArg( $smokeId, $methodId, $_ );
 
1065
            $str =~ s/^const //;
 
1066
            $str =~ s/[*&]$//;
 
1067
            $str} ( 0..$numArgs-1 );
 
1068
        $hash{$sig} = $moduleId;
 
1069
    }
 
1070
    return values %hash;
 
1071
}
929
1072
 
930
1073
# Args: @_: the args to the method being called
931
1074
#       $classname: the c++ class being called
974
1117
            }
975
1118
        }
976
1119
 
 
1120
        @methodIds = uniqMethods( \@methodIds, scalar @_ );
 
1121
 
977
1122
        # If we still have more than 1 match, use the first one.
978
1123
        if ( @methodIds > 1 ) {
979
1124
            # Keep in sync with debug.pm's $channel{ambiguous} value
986
1131
                    ++$stackDepth;
987
1132
                    @caller = caller($stackDepth);
988
1133
                }
989
 
                my $msg = "--- Ambiguous method ${classname}::$methodname" .
990
 
                    ' called at ' . $caller[1] .
991
 
                    ' line ' . $caller[2] . "\n";
 
1134
                my $msg = "--- Ambiguous method ${classname}::$methodname\n";
992
1135
                $msg .= "Candidates are:\n\t";
993
1136
                $msg .= join "\n\t", dumpCandidates( $classname, $methodname, \@methodIds );
994
 
                $msg .= "\nChoosing first one...\n";
 
1137
                $msg .= "\nChoosing first one... " .
 
1138
                    ' at ' . $caller[1] .
 
1139
                    ' line ' . $caller[2] . "\n";
995
1140
                warn $msg;
996
1141
            }
997
1142
            @methodIds = $methodIds[0];
1014
1159
            }
1015
1160
            my $errStr = '--- Arguments for method call ' .
1016
1161
                "$classname\::$methodname did not match C++ method ".
1017
 
                "signature," .
1018
 
                ' called at ' . $caller[1] .
1019
 
                ' line ' . $caller[2] . "\n";
 
1162
                "signature\n";
1020
1163
            $errStr .= "Method call was:\n\t";
1021
1164
            $errStr .= "$classname\::$methodname( " . dumpArgs(@_) . " )\n";
1022
1165
            $errStr .= "C++ signature is:\n\t";
1023
 
            $errStr .= (dumpCandidates( $classname, $methodname, \@methodIds ))[0] . "\n";
 
1166
            $errStr .= (dumpCandidates( $classname, $methodname, \@methodIds ))[0] . "\n" .
 
1167
                ' at ' . $caller[1] .
 
1168
                ' line ' . $caller[2] . "\n";
1024
1169
            @methodIds = ();
1025
1170
            print STDERR $errStr and die;
1026
1171
        }
1040
1185
        }
1041
1186
        else {
1042
1187
            my $noMethodFound = reportNoMethodFound( $classname, $methodname, @_ );
1043
 
            $noMethodFound .= "'use QtCore4::debug qw(ambiguous)' for more information.";
 
1188
            $noMethodFound .= "'use QtCore4::debug qw(ambiguous)' for more information.\n";
1044
1189
            die $noMethodFound;
1045
1190
        }
1046
1191
    }
1148
1293
    @{arrayByName($perlClassName.'::ISA')} = @isa;
1149
1294
 
1150
1295
    # Define overloaded operators
1151
 
    @{arrayByName(" $perlClassName\::ISA")} = ('Qt::base::_overload');
 
1296
    if ( exists $vectorTypes{$perlClassName} ) {
 
1297
        push @{arrayByName(" $perlClassName\::ISA")}, "$perlClassName\::_overload";
 
1298
        setIsArrayType( " $perlClassName" );
 
1299
    }
 
1300
    push @{arrayByName(" $perlClassName\::ISA")}, 'Qt::base::_overload';
1152
1301
 
1153
1302
    foreach my $sp ('', ' ') {
1154
1303
        my $where = $sp . $perlClassName;
1177
1326
        # Adds $perlClassName to the front of @_
1178
1327
        $perlClassName->new(@_);
1179
1328
    }) unless(defined &{$perlClassName});
 
1329
 
 
1330
    Qt::_internal::installSub( " ${perlClassName}::isa", \&Qt::_internal::isa );
1180
1331
}
1181
1332
 
1182
1333
sub permateMungedMethods {
1194
1345
    my $methodIds = shift;
1195
1346
    # @_ now equals the original argument array of the method call
1196
1347
    my $stackDepth = ( $methodname eq $classname ) ? 5 : 3;
 
1348
    my @caller = caller($stackDepth);
 
1349
    while ( $caller[1] =~ m/QtCore4\.pm$/ || $caller[1] =~ m/QtCore4\/isa\.pm/ ) {
 
1350
        ++$stackDepth;
 
1351
        @caller = caller($stackDepth);
 
1352
    }
1197
1353
    my $errStr = '--- Arguments for method call ' .
1198
1354
        "$classname\::$methodname did not match any known C++ method ".
1199
1355
        "signature," .
1200
 
        ' called at ' . (caller($stackDepth))[1] .
1201
 
        ' line ' . (caller($stackDepth))[2] . "\n";
 
1356
        ' called at ' . $caller[1] .
 
1357
        ' line ' . $caller[2] . "\n";
1202
1358
    $errStr .= "Method call was:\n\t";
1203
1359
    $errStr .= "$classname\::$methodname( " . dumpArgs(@_) . " )\n";
1204
1360
    $errStr .= "Possible candidates:\n\t";
1244
1400
# Returns: none
1245
1401
# Desc: sets up each class
1246
1402
sub init {
 
1403
    $Qt::_internal::vectorTypes{'Qt::XmlStreamAttributes'} = undef;
1247
1404
    my $classes = getClassList();
1248
1405
    Qt::_internal->init_class($_) for(@$classes);
1249
1406
 
1322
1479
            push @$data, $MethodScriptable | $MethodSignal | $AccessPublic; # flags
1323
1480
        }
1324
1481
        else {
1325
 
            push @$data, $MethodSignal | $AccessProtected; # flags
 
1482
            push @$data, $MethodSignal | $AccessPrivate; # flags
1326
1483
        }
1327
1484
    }
1328
1485
 
1344
1501
            push @$data, $nullposition; #return type, void
1345
1502
        }
1346
1503
        push @$data, $nullposition; #tag
1347
 
        push @$data, $MethodSlot | $AccessPublic; # flags
 
1504
        push @$data, $MethodSlot | $AccessPrivate; # flags
1348
1505
    }
1349
1506
 
1350
1507
    push @$data, 0; #eod
1700
1857
 
1701
1858
1;
1702
1859
 
 
1860
package Qt::String;
 
1861
 
 
1862
use strict;
 
1863
use warnings;
 
1864
 
 
1865
use overload
 
1866
    '""' => 'Qt::String::toString';
 
1867
 
 
1868
sub arg {
 
1869
    my $string = shift;
 
1870
    my @fields = @_;
 
1871
 
 
1872
    my $stringRef = ${$string};
 
1873
 
 
1874
    my $escapeNum = 1;
 
1875
    while ( $escapeNum < 99 && $stringRef !~ m/%$escapeNum/ ) {
 
1876
        ++$escapeNum;
 
1877
    }
 
1878
    while ( @fields ) {
 
1879
        my $field = shift @fields;
 
1880
        ${$string} =~ s/%$escapeNum/$field/;
 
1881
        ++$escapeNum;
 
1882
    }
 
1883
    return $string;
 
1884
}
 
1885
 
 
1886
sub toString {
 
1887
    return ${$_[0]};
 
1888
}
 
1889
 
 
1890
package Qt::XmlStreamAttributes;
 
1891
 
 
1892
sub EXTEND {
 
1893
}
 
1894
 
 
1895
package Qt::XmlStreamAttributes::_overload;
 
1896
 
 
1897
use overload
 
1898
    '==' => \&op_equality;
 
1899
 
1703
1900
=pod
1704
1901
 
1705
1902
=head1 NAME
1709
1906
=head1 SYNOPSIS
1710
1907
 
1711
1908
  use QtCore4;
 
1909
  use QtGui4;
1712
1910
  my $app = Qt::Application(\@ARGV);
1713
1911
  my $button = Qt::PushButton( 'Hello, World!', undef);
1714
1912
  $button->show();
1832
2030
 
1833
2031
=over
1834
2032
 
 
2033
=item Global methods to all classes
 
2034
 
 
2035
=item getPointer
 
2036
 
 
2037
This method is used to retrieve an object's numeric memory location.  It is
 
2038
defined in the Qt::base class, which all Qt objects inherit.
 
2039
 
 
2040
Currently, none of the classes that provided by this binding implement a method
 
2041
called getPointer().  But if one did, calling $object->getPointer() would not
 
2042
end up calling this method.  To force this method to be called, you can call
 
2043
$object->Qt::base::getPointer().
 
2044
 
 
2045
=back
 
2046
 
1835
2047
=item Qt::Object
1836
2048
 
1837
2049
=over