Enlightenment CVS committal
Author : leviathan
Project : e17
Module : proto
Dir : e17/proto/etk-perl/lib/Etk
Modified Files:
Box.pm Button.pm Combobox.pm Iconbox.pm Menu.pm Object.pm
ProgressBar.pm Tree.pm Widget.pm
Log Message:
Big fat changes. Breakage ahead!
Many changes to the API (it's now kind of unstable and very in-development)
take a look at test.pl for new access methods. I'm porting etk_test.pl
as I implement stuff.
===================================================================
RCS file: /cvs/e/e17/proto/etk-perl/lib/Etk/Box.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -3 -r1.2 -r1.3
--- Box.pm 11 Jun 2006 00:26:32 -0000 1.2
+++ Box.pm 18 Jul 2006 22:14:34 -0000 1.3
@@ -3,6 +3,9 @@
use vars qw(@ISA);
require Etk::Container;
@ISA = ("Etk::Container");
+
+use AutoLoader;
+
sub new
{
my $class = shift;
@@ -15,6 +18,10 @@
{
my $self = shift;
my $child = shift;
+ if (!$child && ref $self->{PARENT} && $self->{PARENT}->isa("Etk::Box")) {
+ $self->{PARENT}->PackStart($self, @_);
+ return $self;
+ }
my $expand = 1;
$expand = shift if(@_ > 0);
my $fill = 1;
@@ -23,6 +30,7 @@
$padding = shift if(@_ > 0);
Etk::etk_box_pack_start($self->{WIDGET}, $child->{WIDGET}, $expand,
$fill, $padding);
+ return $self;
}
sub PackEnd
@@ -51,16 +59,29 @@
$expand, $fill, $pack_end);
}
+=item ChildPackingGet($child)
+
+Get packing information about the child.
+If $child is numerical then it is the nth child added, otherwise it's the
widget itself.
+
+Returns: ($padding, $expand, $fill, $pack_end) or undef if child is not found.
+
+=cut
+
sub ChildPackingGet
{
my $self = shift;
my $child = shift;
- # RETURNS:
- # padding
- # expand
- # fill
- # pack_end
- return Etk::etk_box_child_packing_get($self->{WIDGET}, $child->{WIDGET});
+ my $child_widget;
+ if ($child + 0 eq $child) {
+ $child_widget = $self->children()->[$child];
+ } else {
+ $child_widget = $child;
+ }
+ if ($child_widget->isa("Etk::Widget")) {
+ return Etk::etk_box_child_packing_get($self->{WIDGET},
$child_widget->{WIDGET});
+ }
+ return undef;
}
sub SpacingSet
@@ -89,4 +110,37 @@
return Etk::etk_box_homogenous_Get($self->{WIDGET});
}
+sub children
+{
+ my $self = shift;
+ return $self->{CHILDREN};
+}
+
+sub AUTOLOAD
+{
+ our $AUTOLOAD;
+
+ my $package;
+ ($package = $AUTOLOAD) =~ s/.*:://;
+
+ if ($package =~ /^Add(.+)/)
+ {
+ my $self = shift;
+ my $p = $1;
+ my $return;
+
+ eval("use Etk::$p");
+ die("Cannot load package Etk::$p - $@") if $@;
+ eval("\$return = Etk::${p}->new([EMAIL PROTECTED]);");
+
+ push @{$self->{CHILDREN}}, $return;
+ $return->{PARENT} = $self;
+
+ return $return;
+ }
+}
+
1;
+
+__END__
+
===================================================================
RCS file: /cvs/e/e17/proto/etk-perl/lib/Etk/Button.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -3 -r1.3 -r1.4
--- Button.pm 15 Jul 2006 19:19:05 -0000 1.3
+++ Button.pm 18 Jul 2006 22:14:34 -0000 1.4
@@ -54,12 +54,26 @@
my $self = shift;
return Etk::etk_button_label_get($self->{WIDGET});
}
+
+=item ImageSet($image)
+
+Set the image of a button.
+If $image is a string, a new Etk::Image object is created.
+
+=cut
sub ImageSet
{
my $self = shift;
- my $image = shift;
+ my $im = shift;
+ my $image;
+ if (ref $im && $im->isa("Etk::Image")) {
+ $image = $im;
+ } else {
+ $image = Etk::Image->new($im);
+ }
Etk::etk_button_image_set($self->{WIDGET}, $image->{WIDGET});
+ return $self;
}
sub ImageGet
===================================================================
RCS file: /cvs/e/e17/proto/etk-perl/lib/Etk/Combobox.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -3 -r1.3 -r1.4
--- Combobox.pm 1 Jul 2006 20:20:22 -0000 1.3
+++ Combobox.pm 18 Jul 2006 22:14:34 -0000 1.4
@@ -4,6 +4,8 @@
require Etk::Widget;
@ISA = ("Etk::Widget");
+use Etk::Combobox::Item;
+
use constant
{
ColumnTypeLabel => 0,
===================================================================
RCS file: /cvs/e/e17/proto/etk-perl/lib/Etk/Iconbox.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -3 -r1.3 -r1.4
--- Iconbox.pm 15 Jul 2006 19:19:05 -0000 1.3
+++ Iconbox.pm 18 Jul 2006 22:14:34 -0000 1.4
@@ -3,6 +3,10 @@
use vars qw(@ISA);
require Etk::Widget;
@ISA = ("Etk::Widget");
+
+use Etk::Iconbox::Icon;
+use Etk::Iconbox::Model;
+
sub new
{
my $class = shift;
===================================================================
RCS file: /cvs/e/e17/proto/etk-perl/lib/Etk/Menu.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -3 -r1.1 -r1.2
--- Menu.pm 7 Jun 2006 11:58:34 -0000 1.1
+++ Menu.pm 18 Jul 2006 22:14:34 -0000 1.2
@@ -1,8 +1,17 @@
package Etk::Menu;
use strict;
use vars qw(@ISA);
-require Etk::Menu;
+require Etk::Menu::Shell;
@ISA = ("Etk::Menu::Shell");
+
+use Etk::Menu::Bar;
+use Etk::Menu::Item;
+
+use Etk::Menu::Item::Check;
+use Etk::Menu::Item::Image;
+use Etk::Menu::Item::Radio;
+use Etk::Menu::Item::Separator;
+
sub new
{
my $class = shift;
===================================================================
RCS file: /cvs/e/e17/proto/etk-perl/lib/Etk/Object.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -3 -r1.7 -r1.8
--- Object.pm 15 Jul 2006 19:19:05 -0000 1.7
+++ Object.pm 18 Jul 2006 22:14:34 -0000 1.8
@@ -12,65 +12,55 @@
sub SignalConnect
{
my $self = shift;
- my ($type, $mem) = split /=/, $self->{WIDGET};
my $signal_name = shift;
my $callback = shift;
my $data = undef;
$data = shift if (@_ > 0);
- Etk::etk_signal_connect($signal_name,
- bless($self->{WIDGET}, "Etk_WidgetPtr"), $callback, $data);
- bless($self->{WIDGET}, $type);
+ Etk::etk_signal_connect($signal_name, $self, $callback, $data);
+ return $self;
}
sub SignalConnectAfter
{
my $self = shift;
- my ($type, $mem) = split /=/, $self->{WIDGET};
my $signal_name = shift;
my $callback = shift;
my $data = undef;
$data = shift if (@_ > 0);
- Etk::etk_signal_connect_after($signal_name,
- bless($self->{WIDGET}, "Etk_WidgetPtr"), $callback, $data);
- bless($self->{WIDGET}, $type);
+ Etk::etk_signal_connect_after($signal_name, $self, $callback, $data);
+ return $self;
}
sub SignalConnectSwapped
{
my $self = shift;
- my ($type, $mem) = split /=/, $self->{WIDGET};
my $signal_name = shift;
my $callback = shift;
my $data = undef;
$data = shift if (@_ > 0);
- Etk::etk_signal_connect_swapped($signal_name,
- bless($self->{WIDGET}, "Etk_WidgetPtr"), $callback, $data);
- bless($self->{WIDGET}, $type);
+ Etk::etk_signal_connect_swapped($signal_name, $self, $callback, $data);
+ return $self;
}
sub SignalConnectFull
{
my $self = shift;
- my ($type, $mem) = split /=/, $self->{WIDGET};
my $signal_name = shift;
my $callback = shift;
my $data = shift;
my $swapped = shift;
my $after = shift;
- Etk::etk_signal_connect_full($signal_name,
- bless($self->{WIDGET}, "Etk_WidgetPtr"), $callback, $data, $swapped,
$after);
- bless($self->{WIDGET}, $type);
+ Etk::etk_signal_connect_full($signal_name, $self, $callback, $data,
$swapped, $after);
+ return $self;
}
sub SignalDisconnect
{
my $self = shift;
- my ($type, $mem) = split /=/, $self->{WIDGET};
my $signal_name = shift;
my $callback = shift;
- Etk::etk_signal_disconnect($signal_name,
- bless($self->{WIDGET}, "Etk_WidgetPtr"), $callback);
- bless($self->{WIDGET}, $type);
+ Etk::etk_signal_disconnect($signal_name, $self, $callback);
+ return $self;
}
sub NotificationCallbackAdd
===================================================================
RCS file: /cvs/e/e17/proto/etk-perl/lib/Etk/ProgressBar.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -3 -r1.2 -r1.3
--- ProgressBar.pm 7 Jun 2006 17:37:21 -0000 1.2
+++ ProgressBar.pm 18 Jul 2006 22:14:34 -0000 1.3
@@ -63,6 +63,7 @@
my $self = shift;
my $pulse_step = shift;
Etk::etk_progress_bar_pulse_step_set($self->{WIDGET}, $pulse_step);
+ return $self;
}
sub PulseStepGet
===================================================================
RCS file: /cvs/e/e17/proto/etk-perl/lib/Etk/Tree.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -3 -r1.2 -r1.3
--- Tree.pm 11 Jun 2006 18:59:27 -0000 1.2
+++ Tree.pm 18 Jul 2006 22:14:34 -0000 1.3
@@ -1,10 +1,21 @@
package Etk::Tree;
use strict;
use vars qw(@ISA);
-use Etk::Tree::Row;
require Etk::Widget;
@ISA = ("Etk::Widget");
+use Etk::Tree::Col;
+use Etk::Tree::Row;
+use Etk::Tree::Model;
+
+use Etk::Tree::Model::Checkbox;
+use Etk::Tree::Model::Double;
+use Etk::Tree::Model::IconText;
+use Etk::Tree::Model::Image;
+use Etk::Tree::Model::Int;
+use Etk::Tree::Model::ProgressBar;
+use Etk::Tree::Model::Text;
+
use constant
{
ModeList => 0,
@@ -207,6 +218,64 @@
{
my $self = shift;
# TODO: pending list implementation
-}
+}
+
+sub AddCol
+{
+ my $self = shift;
+ my ($title, $model, $width) = @_;
+
+ my $model_widget;
+ if ($model eq "Text") {
+ $model_widget = Etk::Tree::Model::Text->new($self);
+ } elsif ($model eq "ProgressBar") {
+ $model_widget = Etk::Tree::Model::ProgressBar->new($self);
+ } # etc...
+
+ my $widget = Etk::Tree::Col->new($self, $title, $model_widget, $width);
+ $widget->{MODEL} = $model;
+
+ push @{$self->{COLS}}, $widget;
+ return $widget;
+
+}
+
+sub AddCols
+{
+ my $self = shift;
+ my @cols = @_;
+ foreach (@cols) {
+ $self->AddCol(@$_);
+ }
+ return $self;
+}
+
+sub AddRow
+{
+ my $self = shift;
+ my @data = @_;
+ my @cols = @{$self->{COLS}};
+ my $row = $self->Append();
+ foreach my $col (@cols) {
+ if ($col->{MODEL} eq "Text") {
+ my $text = shift @data;
+ $row->FieldTextSet($col, $text);
+ } elsif ($col->{MODEL} eq "ProgressBar") {
+ my $prog = shift @data;
+ $row->FieldProgressBarSet($col, $prog->[0], $prog->[1]);
+ }
+ }
+ return $row;
+}
+
+sub AddRows
+{
+ my $self = shift;
+ my @rows = @_;
+ foreach (@rows) {
+ $self->AddRow(@$_);
+ }
+ return $self;
+}
1;
===================================================================
RCS file: /cvs/e/e17/proto/etk-perl/lib/Etk/Widget.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -3 -r1.7 -r1.8
--- Widget.pm 17 Jul 2006 23:26:17 -0000 1.7
+++ Widget.pm 18 Jul 2006 22:14:34 -0000 1.8
@@ -439,18 +439,33 @@
my $package;
($package = $AUTOLOAD) =~ s/.*:://;
- if ($package =~ /^Add(.*)/)
+ if ($package =~ /^Add(.+)/)
{
- shift;
+ my $self = shift;
my $p = $1;
my $return;
eval("use Etk::$p");
die("Cannot load package Etk::$p - $@") if $@;
eval("\$return = Etk::${p}->new([EMAIL PROTECTED]);");
+
+ $self->Add($return);
+
return $return;
}
}
+
+sub PackStart
+{
+ my $self = shift;
+ if ($self->{PARENT}->isa("Etk::Box")) {
+ $self->{PARENT}->PackStart($self, @_);
+ } else {
+ warn("Parent is not a Box\n");
+ }
+ return $self;
+}
+
1;
-------------------------------------------------------------------------
Take Surveys. Earn Cash. Influence the Future of IT
Join SourceForge.net's Techsay panel and you'll get the chance to share your
opinions on IT & business topics through brief surveys -- and earn cash
http://www.techsay.com/default.php?page=join.php&p=sourceforge&CID=DEVDEV
_______________________________________________
enlightenment-cvs mailing list
enlightenment-cvs@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/enlightenment-cvs
