From 795a0355a40293affc7164507e918440d4a828d6 Mon Sep 17 00:00:00 2001 From: Timothy Pearson Date: Sun, 1 Jan 2012 18:43:39 -0600 Subject: Move Qt --- PerlTQt/lib/Qt/GlobalSpace.pm | 25 ------------ PerlTQt/lib/Qt/attributes.pm | 51 ------------------------- PerlTQt/lib/Qt/constants.pm | 62 ------------------------------ PerlTQt/lib/Qt/debug.pm | 36 ------------------ PerlTQt/lib/Qt/enumerations.pm | 15 -------- PerlTQt/lib/Qt/isa.pm | 81 --------------------------------------- PerlTQt/lib/Qt/properties.pm | 14 ------- PerlTQt/lib/Qt/signals.pm | 77 ------------------------------------- PerlTQt/lib/Qt/slots.pm | 84 ----------------------------------------- PerlTQt/lib/TQt/GlobalSpace.pm | 25 ++++++++++++ PerlTQt/lib/TQt/attributes.pm | 51 +++++++++++++++++++++++++ PerlTQt/lib/TQt/constants.pm | 62 ++++++++++++++++++++++++++++++ PerlTQt/lib/TQt/debug.pm | 36 ++++++++++++++++++ PerlTQt/lib/TQt/enumerations.pm | 15 ++++++++ PerlTQt/lib/TQt/isa.pm | 81 +++++++++++++++++++++++++++++++++++++++ PerlTQt/lib/TQt/properties.pm | 14 +++++++ PerlTQt/lib/TQt/signals.pm | 77 +++++++++++++++++++++++++++++++++++++ PerlTQt/lib/TQt/slots.pm | 84 +++++++++++++++++++++++++++++++++++++++++ 18 files changed, 445 insertions(+), 445 deletions(-) delete mode 100644 PerlTQt/lib/Qt/GlobalSpace.pm delete mode 100644 PerlTQt/lib/Qt/attributes.pm delete mode 100644 PerlTQt/lib/Qt/constants.pm delete mode 100644 PerlTQt/lib/Qt/debug.pm delete mode 100644 PerlTQt/lib/Qt/enumerations.pm delete mode 100644 PerlTQt/lib/Qt/isa.pm delete mode 100644 PerlTQt/lib/Qt/properties.pm delete mode 100644 PerlTQt/lib/Qt/signals.pm delete mode 100644 PerlTQt/lib/Qt/slots.pm create mode 100644 PerlTQt/lib/TQt/GlobalSpace.pm create mode 100644 PerlTQt/lib/TQt/attributes.pm create mode 100644 PerlTQt/lib/TQt/constants.pm create mode 100644 PerlTQt/lib/TQt/debug.pm create mode 100644 PerlTQt/lib/TQt/enumerations.pm create mode 100644 PerlTQt/lib/TQt/isa.pm create mode 100644 PerlTQt/lib/TQt/properties.pm create mode 100644 PerlTQt/lib/TQt/signals.pm create mode 100644 PerlTQt/lib/TQt/slots.pm (limited to 'PerlTQt') diff --git a/PerlTQt/lib/Qt/GlobalSpace.pm b/PerlTQt/lib/Qt/GlobalSpace.pm deleted file mode 100644 index 75f30a2..0000000 --- a/PerlTQt/lib/Qt/GlobalSpace.pm +++ /dev/null @@ -1,25 +0,0 @@ -package TQt::GlobalSpace; -use strict; -require TQt; -require Exporter; - -our @ISA = qw(Exporter); -our @EXPORT; -our $allMeth = TQt::_internal::findAllMethods( TQt::_internal::idClass("TQGlobalSpace") ); -no strict 'refs'; - -for my $proto( keys %$allMeth ) -{ - next if $proto =~ /operator\W/; # skip operators - $proto =~ s/[\#\$\?]+$//; - *{ $proto } = sub - { - $TQt::_internal::autoload::AUTOLOAD = "TQt::GlobalSpace\::$proto"; - goto &TQt::GlobalSpace::AUTOLOAD - } unless defined &$proto; - push @EXPORT, $proto; -} - -our %EXPORT_TAGS = ( "all" => [@EXPORT] ); - -1; \ No newline at end of file diff --git a/PerlTQt/lib/Qt/attributes.pm b/PerlTQt/lib/Qt/attributes.pm deleted file mode 100644 index 4398fa5..0000000 --- a/PerlTQt/lib/Qt/attributes.pm +++ /dev/null @@ -1,51 +0,0 @@ -package TQt::attributes; -# -# I plan to support public/protected/private attributes. here goes. -# Attributes default to protected. -# -# package MyBase; -# use TQt::attributes qw( -# private: -# foo -# protected: -# bar -# public: -# baz -# ); -# -# package MyDerived; -# use TQt::isa qw(MyBase); -# -# sub foo { -# # 1 way to access private attributes from derived class -# # -# # this->{$class} contains private attributes for $class -# # I specify it to always work that way, -# # so feel free to use it in code. -# this->{MyBase}{foo} = 10; -# -# # 2 ways to access protected attributes -# bar = 10; -# this->{bar} = 10; -# -# # 3 ways to access public attributes -# baz = 10; -# this->{baz} = 10; -# this->baz = 10; -# } -# -# Attributes override any method with the same name, so you may want -# to prefix them with _ to prevent conflicts. -# -sub import { - my $class = shift; - my $caller = (caller)[0]; - - for my $attribute (@_) { - exists ${ ${$caller . '::META'}{'attributes'} }{$attribute} and next; - TQt::_internal::installattribute($caller, $attribute); - ${ ${$caller . '::META'}{'attributes'} }{$attribute} = 1; - } -} - -1; diff --git a/PerlTQt/lib/Qt/constants.pm b/PerlTQt/lib/Qt/constants.pm deleted file mode 100644 index 5bdeed0..0000000 --- a/PerlTQt/lib/Qt/constants.pm +++ /dev/null @@ -1,62 +0,0 @@ -package TQt::constants; - -require Exporter; - -our @ISA = qw(Exporter); -our @EXPORT = qw( - IO_Direct - IO_Sequential - IO_Combined - IO_TypeMask - IO_Raw - IO_Async - IO_ReadOnly - IO_WriteOnly - IO_ReadWrite - IO_Append - IO_Truncate - IO_Translate - IO_ModeMask - IO_Open - IO_StateMask - IO_Ok - IO_ReadError - IO_WriteError - IO_FatalError - IO_ResourceError - IO_OpenError - IO_ConnectError - IO_AbortError - IO_TimeOutError - IO_UnspecifiedError -); - -our %EXPORT_TAGS = ( 'IO' => [ @EXPORT ] ); - -sub IO_Direct () { 0x0100 } -sub IO_Sequential () { 0x0200 } -sub IO_Combined () { 0x0300 } -sub IO_TypeMask () { 0x0f00 } -sub IO_Raw () { 0x0040 } -sub IO_Async () { 0x0080 } -sub IO_ReadOnly () { 0x0001 } -sub IO_WriteOnly () { 0x0002 } -sub IO_ReadWrite () { 0x0003 } -sub IO_Append () { 0x0004 } -sub IO_Truncate () { 0x0008 } -sub IO_Translate () { 0x0010 } -sub IO_ModeMask () { 0x00ff } -sub IO_Open () { 0x1000 } -sub IO_StateMask () { 0xf000 } -sub IO_Ok () { 0 } -sub IO_ReadError () { 1 } -sub IO_WriteError () { 2 } -sub IO_FatalError () { 3 } -sub IO_ResourceError () { 4 } -sub IO_OpenError () { 5 } -sub IO_ConnectError () { 5 } -sub IO_AbortError () { 6 } -sub IO_TimeOutError () { 7 } -sub IO_UnspecifiedError() { 8 } - -1; \ No newline at end of file diff --git a/PerlTQt/lib/Qt/debug.pm b/PerlTQt/lib/Qt/debug.pm deleted file mode 100644 index a0f4e19..0000000 --- a/PerlTQt/lib/Qt/debug.pm +++ /dev/null @@ -1,36 +0,0 @@ -package TQt::debug; -use TQt; - -our %channel = ( - 'ambiguous' => 0x01, - 'autoload' => 0x02, - 'calls' => 0x04, - 'gc' => 0x08, - 'virtual' => 0x10, - 'verbose' => 0x20, - 'all' => 0xffff -); - -sub import { - shift; - my $db = (@_)? 0x0000 : (0x01|0x20); - my $usage = 0; - for my $ch(@_) { - if( exists $channel{$ch}) { - $db |= $channel{$ch}; - } else { - warn "Unknown debugging channel: $ch\n"; - $usage++; - } - } - TQt::_internal::setDebug($db); - print "Available channels: \n\t". - join("\n\t", sort keys %channel). - "\n" if $usage; -} - -sub unimport { - TQt::_internal::setDebug(0); -} - -1; \ No newline at end of file diff --git a/PerlTQt/lib/Qt/enumerations.pm b/PerlTQt/lib/Qt/enumerations.pm deleted file mode 100644 index 9fea98f..0000000 --- a/PerlTQt/lib/Qt/enumerations.pm +++ /dev/null @@ -1,15 +0,0 @@ -package TQt::enumerations; -# -# Proposed usage: -# -# package MyWidget; -# -# use TQt::enumerations MyInfo => { -# Foo => 1, -# Bar => 10, -# Baz => 64 -# }; -# -# use TQt::enumerations MyInfo => [qw(Foo Bar Baz)]; -# -1; diff --git a/PerlTQt/lib/Qt/isa.pm b/PerlTQt/lib/Qt/isa.pm deleted file mode 100644 index 71e9391..0000000 --- a/PerlTQt/lib/Qt/isa.pm +++ /dev/null @@ -1,81 +0,0 @@ -package TQt::isa; -use strict; - -sub import { - no strict 'refs'; - my $class = shift; - my $caller = (caller)[0]; - - # Trick 'use' into believing the file for this class has been read - my $pm = $caller . ".pm"; - $pm =~ s!::!/!g; - unless(exists $::INC{$pm}) { - $::INC{$pm} = $::INC{"TQt/isa.pm"}; - } - - for my $super (@_) { - push @{ $caller . '::ISA' }, $super; - push @{ ${$caller . '::META'}{'superClass'} }, $super; # if isa(TQObject)? - } - - *{ $caller . '::className' } = sub { # closure on $caller - return $caller; - }; - - ${ $caller. '::_INTERNAL_STATIC_'}{'SUPER'} = bless {}, " $caller"; - TQt::_internal::installsuper($caller) unless defined &{ $caller.'::SUPER' }; - - *{ $caller . '::metaObject' } = sub { - TQt::_internal::getMetaObject($caller); - }; - - *{ $caller . '::import' } = sub { - my $name = shift; # classname = function-name - my $incaller = (caller)[0]; - $incaller = (caller(1))[0] if $incaller eq 'if'; # work-around bug in package 'if' pre 0.02 - (my $cname = $name) =~ s/.*::// and do - { - *{ "$name" } = sub { - $name->new(@_); - } unless defined &{ "$name" }; - }; - my $p = defined $&? $&:''; - $p eq ($incaller=~/.*::/?($p?$&:''):'') and - *{ "$incaller\::$cname" } = sub { - $name->new(@_); - }; - - if(defined @{ ${$caller.'::META'}{'superClass'} } && - @{ ${$caller.'::META'}{'superClass'} } ) - { - # attributes inheritance - for my $attribute( keys %{ ${$caller.'::META'}{'attributes'} } ) - { - if(! defined &{$incaller.'::'.$attribute }) - { - TQt::_internal::installattribute($incaller, $attribute); - ${ ${$incaller .'::META'}{'attributes'} }{$attribute} = 1; - } - } - } - }; - - TQt::_internal::installautoload(" $caller"); - TQt::_internal::installautoload(" $caller"); - TQt::_internal::installautoload($caller); - { - package TQt::AutoLoad; - my $autosub = \&{ " $caller\::_UTOLOAD" }; - *{ " $caller\::AUTOLOAD" } = sub { &$autosub }; - $autosub = \&{ " $caller\::_UTOLOAD" }; - *{ " $caller\::AUTOLOAD" } = sub { &$autosub }; - $autosub = \&{ "$caller\::_UTOLOAD" }; - *{ "$caller\::AUTOLOAD" } = sub { &$autosub }; - } - TQt::_internal::installthis($caller); - - # operator overloading - *{ " $caller\::ISA" } = ["TQt::base::_overload"]; -} - -1; diff --git a/PerlTQt/lib/Qt/properties.pm b/PerlTQt/lib/Qt/properties.pm deleted file mode 100644 index 951cdb6..0000000 --- a/PerlTQt/lib/Qt/properties.pm +++ /dev/null @@ -1,14 +0,0 @@ -package TQt::properties; -# -# Proposed usage: -# -# use TQt::properties foo => { -# TYPE => 'bool', -# READ => 'getFoo', -# WRITE => 'setFoo', -# STORED => 0, -# RESET => 'unsetFoo', -# DESIGNABLE => 0 -# }; -# -1; diff --git a/PerlTQt/lib/Qt/signals.pm b/PerlTQt/lib/Qt/signals.pm deleted file mode 100644 index 1f454c1..0000000 --- a/PerlTQt/lib/Qt/signals.pm +++ /dev/null @@ -1,77 +0,0 @@ -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 . '::qt_emit'; - - TQt::_internal::installqt_invoke($caller . '::qt_emit') unless defined &{ $caller. '::qt_emit' }; - -# *{ $caller . '::qt_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 . '::qt_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; diff --git a/PerlTQt/lib/Qt/slots.pm b/PerlTQt/lib/Qt/slots.pm deleted file mode 100644 index c12990e..0000000 --- a/PerlTQt/lib/Qt/slots.pm +++ /dev/null @@ -1,84 +0,0 @@ -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 . '::qt_invoke'; - - TQt::_internal::installqt_invoke($caller . '::qt_invoke') unless defined &{ $caller. '::qt_invoke' }; - -# *{ $caller . '::qt_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 . '::qt_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; diff --git a/PerlTQt/lib/TQt/GlobalSpace.pm b/PerlTQt/lib/TQt/GlobalSpace.pm new file mode 100644 index 0000000..75f30a2 --- /dev/null +++ b/PerlTQt/lib/TQt/GlobalSpace.pm @@ -0,0 +1,25 @@ +package TQt::GlobalSpace; +use strict; +require TQt; +require Exporter; + +our @ISA = qw(Exporter); +our @EXPORT; +our $allMeth = TQt::_internal::findAllMethods( TQt::_internal::idClass("TQGlobalSpace") ); +no strict 'refs'; + +for my $proto( keys %$allMeth ) +{ + next if $proto =~ /operator\W/; # skip operators + $proto =~ s/[\#\$\?]+$//; + *{ $proto } = sub + { + $TQt::_internal::autoload::AUTOLOAD = "TQt::GlobalSpace\::$proto"; + goto &TQt::GlobalSpace::AUTOLOAD + } unless defined &$proto; + push @EXPORT, $proto; +} + +our %EXPORT_TAGS = ( "all" => [@EXPORT] ); + +1; \ No newline at end of file diff --git a/PerlTQt/lib/TQt/attributes.pm b/PerlTQt/lib/TQt/attributes.pm new file mode 100644 index 0000000..4398fa5 --- /dev/null +++ b/PerlTQt/lib/TQt/attributes.pm @@ -0,0 +1,51 @@ +package TQt::attributes; +# +# I plan to support public/protected/private attributes. here goes. +# Attributes default to protected. +# +# package MyBase; +# use TQt::attributes qw( +# private: +# foo +# protected: +# bar +# public: +# baz +# ); +# +# package MyDerived; +# use TQt::isa qw(MyBase); +# +# sub foo { +# # 1 way to access private attributes from derived class +# # +# # this->{$class} contains private attributes for $class +# # I specify it to always work that way, +# # so feel free to use it in code. +# this->{MyBase}{foo} = 10; +# +# # 2 ways to access protected attributes +# bar = 10; +# this->{bar} = 10; +# +# # 3 ways to access public attributes +# baz = 10; +# this->{baz} = 10; +# this->baz = 10; +# } +# +# Attributes override any method with the same name, so you may want +# to prefix them with _ to prevent conflicts. +# +sub import { + my $class = shift; + my $caller = (caller)[0]; + + for my $attribute (@_) { + exists ${ ${$caller . '::META'}{'attributes'} }{$attribute} and next; + TQt::_internal::installattribute($caller, $attribute); + ${ ${$caller . '::META'}{'attributes'} }{$attribute} = 1; + } +} + +1; diff --git a/PerlTQt/lib/TQt/constants.pm b/PerlTQt/lib/TQt/constants.pm new file mode 100644 index 0000000..5bdeed0 --- /dev/null +++ b/PerlTQt/lib/TQt/constants.pm @@ -0,0 +1,62 @@ +package TQt::constants; + +require Exporter; + +our @ISA = qw(Exporter); +our @EXPORT = qw( + IO_Direct + IO_Sequential + IO_Combined + IO_TypeMask + IO_Raw + IO_Async + IO_ReadOnly + IO_WriteOnly + IO_ReadWrite + IO_Append + IO_Truncate + IO_Translate + IO_ModeMask + IO_Open + IO_StateMask + IO_Ok + IO_ReadError + IO_WriteError + IO_FatalError + IO_ResourceError + IO_OpenError + IO_ConnectError + IO_AbortError + IO_TimeOutError + IO_UnspecifiedError +); + +our %EXPORT_TAGS = ( 'IO' => [ @EXPORT ] ); + +sub IO_Direct () { 0x0100 } +sub IO_Sequential () { 0x0200 } +sub IO_Combined () { 0x0300 } +sub IO_TypeMask () { 0x0f00 } +sub IO_Raw () { 0x0040 } +sub IO_Async () { 0x0080 } +sub IO_ReadOnly () { 0x0001 } +sub IO_WriteOnly () { 0x0002 } +sub IO_ReadWrite () { 0x0003 } +sub IO_Append () { 0x0004 } +sub IO_Truncate () { 0x0008 } +sub IO_Translate () { 0x0010 } +sub IO_ModeMask () { 0x00ff } +sub IO_Open () { 0x1000 } +sub IO_StateMask () { 0xf000 } +sub IO_Ok () { 0 } +sub IO_ReadError () { 1 } +sub IO_WriteError () { 2 } +sub IO_FatalError () { 3 } +sub IO_ResourceError () { 4 } +sub IO_OpenError () { 5 } +sub IO_ConnectError () { 5 } +sub IO_AbortError () { 6 } +sub IO_TimeOutError () { 7 } +sub IO_UnspecifiedError() { 8 } + +1; \ No newline at end of file diff --git a/PerlTQt/lib/TQt/debug.pm b/PerlTQt/lib/TQt/debug.pm new file mode 100644 index 0000000..a0f4e19 --- /dev/null +++ b/PerlTQt/lib/TQt/debug.pm @@ -0,0 +1,36 @@ +package TQt::debug; +use TQt; + +our %channel = ( + 'ambiguous' => 0x01, + 'autoload' => 0x02, + 'calls' => 0x04, + 'gc' => 0x08, + 'virtual' => 0x10, + 'verbose' => 0x20, + 'all' => 0xffff +); + +sub import { + shift; + my $db = (@_)? 0x0000 : (0x01|0x20); + my $usage = 0; + for my $ch(@_) { + if( exists $channel{$ch}) { + $db |= $channel{$ch}; + } else { + warn "Unknown debugging channel: $ch\n"; + $usage++; + } + } + TQt::_internal::setDebug($db); + print "Available channels: \n\t". + join("\n\t", sort keys %channel). + "\n" if $usage; +} + +sub unimport { + TQt::_internal::setDebug(0); +} + +1; \ No newline at end of file diff --git a/PerlTQt/lib/TQt/enumerations.pm b/PerlTQt/lib/TQt/enumerations.pm new file mode 100644 index 0000000..9fea98f --- /dev/null +++ b/PerlTQt/lib/TQt/enumerations.pm @@ -0,0 +1,15 @@ +package TQt::enumerations; +# +# Proposed usage: +# +# package MyWidget; +# +# use TQt::enumerations MyInfo => { +# Foo => 1, +# Bar => 10, +# Baz => 64 +# }; +# +# use TQt::enumerations MyInfo => [qw(Foo Bar Baz)]; +# +1; diff --git a/PerlTQt/lib/TQt/isa.pm b/PerlTQt/lib/TQt/isa.pm new file mode 100644 index 0000000..71e9391 --- /dev/null +++ b/PerlTQt/lib/TQt/isa.pm @@ -0,0 +1,81 @@ +package TQt::isa; +use strict; + +sub import { + no strict 'refs'; + my $class = shift; + my $caller = (caller)[0]; + + # Trick 'use' into believing the file for this class has been read + my $pm = $caller . ".pm"; + $pm =~ s!::!/!g; + unless(exists $::INC{$pm}) { + $::INC{$pm} = $::INC{"TQt/isa.pm"}; + } + + for my $super (@_) { + push @{ $caller . '::ISA' }, $super; + push @{ ${$caller . '::META'}{'superClass'} }, $super; # if isa(TQObject)? + } + + *{ $caller . '::className' } = sub { # closure on $caller + return $caller; + }; + + ${ $caller. '::_INTERNAL_STATIC_'}{'SUPER'} = bless {}, " $caller"; + TQt::_internal::installsuper($caller) unless defined &{ $caller.'::SUPER' }; + + *{ $caller . '::metaObject' } = sub { + TQt::_internal::getMetaObject($caller); + }; + + *{ $caller . '::import' } = sub { + my $name = shift; # classname = function-name + my $incaller = (caller)[0]; + $incaller = (caller(1))[0] if $incaller eq 'if'; # work-around bug in package 'if' pre 0.02 + (my $cname = $name) =~ s/.*::// and do + { + *{ "$name" } = sub { + $name->new(@_); + } unless defined &{ "$name" }; + }; + my $p = defined $&? $&:''; + $p eq ($incaller=~/.*::/?($p?$&:''):'') and + *{ "$incaller\::$cname" } = sub { + $name->new(@_); + }; + + if(defined @{ ${$caller.'::META'}{'superClass'} } && + @{ ${$caller.'::META'}{'superClass'} } ) + { + # attributes inheritance + for my $attribute( keys %{ ${$caller.'::META'}{'attributes'} } ) + { + if(! defined &{$incaller.'::'.$attribute }) + { + TQt::_internal::installattribute($incaller, $attribute); + ${ ${$incaller .'::META'}{'attributes'} }{$attribute} = 1; + } + } + } + }; + + TQt::_internal::installautoload(" $caller"); + TQt::_internal::installautoload(" $caller"); + TQt::_internal::installautoload($caller); + { + package TQt::AutoLoad; + my $autosub = \&{ " $caller\::_UTOLOAD" }; + *{ " $caller\::AUTOLOAD" } = sub { &$autosub }; + $autosub = \&{ " $caller\::_UTOLOAD" }; + *{ " $caller\::AUTOLOAD" } = sub { &$autosub }; + $autosub = \&{ "$caller\::_UTOLOAD" }; + *{ "$caller\::AUTOLOAD" } = sub { &$autosub }; + } + TQt::_internal::installthis($caller); + + # operator overloading + *{ " $caller\::ISA" } = ["TQt::base::_overload"]; +} + +1; diff --git a/PerlTQt/lib/TQt/properties.pm b/PerlTQt/lib/TQt/properties.pm new file mode 100644 index 0000000..951cdb6 --- /dev/null +++ b/PerlTQt/lib/TQt/properties.pm @@ -0,0 +1,14 @@ +package TQt::properties; +# +# Proposed usage: +# +# use TQt::properties foo => { +# TYPE => 'bool', +# READ => 'getFoo', +# WRITE => 'setFoo', +# STORED => 0, +# RESET => 'unsetFoo', +# DESIGNABLE => 0 +# }; +# +1; diff --git a/PerlTQt/lib/TQt/signals.pm b/PerlTQt/lib/TQt/signals.pm new file mode 100644 index 0000000..1f454c1 --- /dev/null +++ b/PerlTQt/lib/TQt/signals.pm @@ -0,0 +1,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 . '::qt_emit'; + + TQt::_internal::installqt_invoke($caller . '::qt_emit') unless defined &{ $caller. '::qt_emit' }; + +# *{ $caller . '::qt_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 . '::qt_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; diff --git a/PerlTQt/lib/TQt/slots.pm b/PerlTQt/lib/TQt/slots.pm new file mode 100644 index 0000000..c12990e --- /dev/null +++ b/PerlTQt/lib/TQt/slots.pm @@ -0,0 +1,84 @@ +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 . '::qt_invoke'; + + TQt::_internal::installqt_invoke($caller . '::qt_invoke') unless defined &{ $caller. '::qt_invoke' }; + +# *{ $caller . '::qt_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 . '::qt_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; -- cgit v1.2.1