From b2af005db21bd8fd068cb79b2ae700953128af2c Mon Sep 17 00:00:00 2001 From: Timothy Pearson Date: Sun, 1 Jan 2012 18:29:30 -0600 Subject: Move PerlQt --- PerlQt/lib/Qt/GlobalSpace.pm | 25 ------------- PerlQt/lib/Qt/attributes.pm | 51 -------------------------- PerlQt/lib/Qt/constants.pm | 62 -------------------------------- PerlQt/lib/Qt/debug.pm | 36 ------------------- PerlQt/lib/Qt/enumerations.pm | 15 -------- PerlQt/lib/Qt/isa.pm | 81 ----------------------------------------- PerlQt/lib/Qt/properties.pm | 14 -------- PerlQt/lib/Qt/signals.pm | 77 --------------------------------------- PerlQt/lib/Qt/slots.pm | 84 ------------------------------------------- 9 files changed, 445 deletions(-) delete mode 100644 PerlQt/lib/Qt/GlobalSpace.pm delete mode 100644 PerlQt/lib/Qt/attributes.pm delete mode 100644 PerlQt/lib/Qt/constants.pm delete mode 100644 PerlQt/lib/Qt/debug.pm delete mode 100644 PerlQt/lib/Qt/enumerations.pm delete mode 100644 PerlQt/lib/Qt/isa.pm delete mode 100644 PerlQt/lib/Qt/properties.pm delete mode 100644 PerlQt/lib/Qt/signals.pm delete mode 100644 PerlQt/lib/Qt/slots.pm (limited to 'PerlQt/lib') diff --git a/PerlQt/lib/Qt/GlobalSpace.pm b/PerlQt/lib/Qt/GlobalSpace.pm deleted file mode 100644 index 75f30a2..0000000 --- a/PerlQt/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/PerlQt/lib/Qt/attributes.pm b/PerlQt/lib/Qt/attributes.pm deleted file mode 100644 index 4398fa5..0000000 --- a/PerlQt/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/PerlQt/lib/Qt/constants.pm b/PerlQt/lib/Qt/constants.pm deleted file mode 100644 index 5bdeed0..0000000 --- a/PerlQt/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/PerlQt/lib/Qt/debug.pm b/PerlQt/lib/Qt/debug.pm deleted file mode 100644 index a0f4e19..0000000 --- a/PerlQt/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/PerlQt/lib/Qt/enumerations.pm b/PerlQt/lib/Qt/enumerations.pm deleted file mode 100644 index 9fea98f..0000000 --- a/PerlQt/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/PerlQt/lib/Qt/isa.pm b/PerlQt/lib/Qt/isa.pm deleted file mode 100644 index 71e9391..0000000 --- a/PerlQt/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/PerlQt/lib/Qt/properties.pm b/PerlQt/lib/Qt/properties.pm deleted file mode 100644 index 951cdb6..0000000 --- a/PerlQt/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/PerlQt/lib/Qt/signals.pm b/PerlQt/lib/Qt/signals.pm deleted file mode 100644 index 1f454c1..0000000 --- a/PerlQt/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/PerlQt/lib/Qt/slots.pm b/PerlQt/lib/Qt/slots.pm deleted file mode 100644 index c12990e..0000000 --- a/PerlQt/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; -- cgit v1.2.1