/[libconf]/libconf/perl-Libconf/GUI/Gtk2.pm
ViewVC logotype

Diff of /libconf/perl-Libconf/GUI/Gtk2.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by dams, Thu Jul 24 14:42:19 2003 UTC revision 1.4 by dams, Sat Aug 2 12:35:24 2003 UTC
# Line 1  Line 1 
1  package Libconf::GUI::Gtk2;  package Libconf::GUI::Gtk2;
2    
3  @ISA = qw(Exporter);  our @ISA = qw(Exporter);
4  %EXPORT_TAGS = (  %EXPORT_TAGS = (
5      generators => [ qw(generateWidget getBestWidget) ],      generators => [ qw(generateWidget getBestWidget) ],
6  );  );
# Line 10  $EXPORT_TAGS{all} = [ map { @$_ } values Line 10  $EXPORT_TAGS{all} = [ map { @$_ } values
10  use lib qw(/usr/lib/libDrakX);  use lib qw(/usr/lib/libDrakX);
11  #use interactive;  #use interactive;
12  use common;  use common;
 use ugtk2 qw(:helpers :wrappers :create);  
   
13  use Libconf;  use Libconf;
14    
15  # public methods  # public methods
16    
17    
18    # @widget_options is optional
19  sub getBestWidget {  sub getBestWidget {
20      my ($struct, $key) = @_;      my ($struct, $key, @widget_options) = @_;
21      my $data = $Libconf::data{$struct->{libconf}{template_name}};      my $data = $Libconf::data{$struct->{libconf}{template_name}};
22      my $data_mapping = $Libconf::data_mapping{$struct->{libconf}{template_name}};      my $data_mapping = $Libconf::data_mapping{$struct->{libconf}{template_name}};
23  #    { type => 'LIST', type2 => 'STRING|INTERFACE|IP/MASK', type3 => ' '}  #    { type => 'LIST', type2 => 'STRING|INTERFACE|IP/MASK', type3 => ' '}
24    
25      build_widget(@{$data->{$key}}{qw(type type2 type3)}, $data_mapping);      build_widget($data->{$key}, $data_mapping, @widget_options);
26  }  }
27    
28    
29  #        STRING|INTERFACE|IP/MASK  #        STRING|INTERFACE|IP/MASK
30    
31    # @widget_options is optional
32  sub build_widget {  sub build_widget {
33      my ($type, $type2, $type3, $data_mapping) = @_;      my ($data, $data_mapping, @widget_options) = @_;
34        my ($type, $type2, $type3, $default) = @{$data}{qw(type type2 type3, default)};
35    
36  #    print "-- $type\n";  #    print "-- $type\n";
37  #     if ($type eq 'LIST') {  #     if ($type eq 'LIST') {
38  #         defined $type2 or die "ERROR : missing type2 for LIST type. key : $key, malformed template : . " $struct->{libconf}{template_name};  #         defined $type2 or die "ERROR : missing type2 for LIST type. key : $key, malformed template : . " $struct->{libconf}{template_name};
# Line 40  sub build_widget { Line 42  sub build_widget {
42  #         }  #         }
43  #     } els  #     } els
44      if ($type eq 'BOOLEAN') {      if ($type eq 'BOOLEAN') {
45          $ret = Gtk2::CheckButton->new();          $ret = Libconf::GUI::Gtk2::CheckButton->new($default, $data_mapping->{BOOLEAN}, @widget_options);
         $ret->set_data('value', 4);  
         print " -- " . $ret->get_data('value') . "\n";  
         gtksignal_connect($ret, toggled => sub {  
                               my ($widget) = @_;  
                               my $value = $widget->get_active;  
                               exists $data_mapping->{BOOLEAN} and $value = $data_mapping->{BOOLEAN}->($value);  
                               print " -- $value \n";  
                               $ret->set_data('value', 4);  
                               $widget->get_data('value') . "\n"; });  
46      } elsif ($type eq 'STRING') {      } elsif ($type eq 'STRING') {
47          $ret = gtkentry();          $ret = Libconf::GUI::Gtk2::Entry->new();
48      } else {      } else {
49          $ret = gtkentry();          $ret = Libconf::GUI::Gtk2::Entry->new();
50      }      }
51      $ret;      $ret;
52  }  }
# Line 189  sub create_dialog { Line 182  sub create_dialog {
182      $dialog->destroy;      $dialog->destroy;
183      $ret;      $ret;
184  }  }
185    
186    package Libconf::GUI::Gtk2::CheckButton;
187    
188    use ugtk2 qw(:helpers :wrappers :create);
189    
190    our @ISA = qw(Gtk2::CheckButton);
191    
192    #constructor
193    #@widget_options is optional
194    sub new {
195        my ($class, $default, $data_mapping, @widget_options) = @_;
196        my $self = $class->SUPER::new(@widget_options);
197    
198    #    $self->set_data('default_value', $default);
199        $self->{'default_value'} = $default;
200    #    $self->set_data('data_mapping', $data_mapping);
201        $self->{'data_mapping'} = $data_mapping;
202        bless $self, $class;
203        $self->set_default();
204    #    print " -- " . $self->get_data('value') . "\n";
205        print " -- " . $self->{'value'} . "\n";
206        gtksignal_connect($self, toggled => sub {
207                              my ($widget) = @_;
208                              my $value = $widget->get_active;
209                              defined $data_mapping and $value = $data_mapping->($value);
210                              $self->set_value($value);
211                              print " getvalue : -- " . $self->get_value() . "\n";
212                          });
213        return $self;
214    }
215    
216    #### TO BE REWORKED
217    sub set_default {
218        my ($self) = @_;
219    #    my $default_value = $self->get_data('default_value');
220        my $default_value = $self->{'default_value'};
221        $self->set_active($default_value);
222        defined $self->{'data_mapping'} and $default_value = $self->{'data_mapping'}->($default_value);
223        $self->{'value'} = $default_value;
224    #    $self->set_data('value', $default_value);
225    }
226    
227    sub set_value {
228        my ($self, $value) = @_;
229    #    $self->set_data('value', $value);
230        $self->{'value'} = $value;
231        defined $self->{'data_mapping'} and $value = $self->{'data_mapping'}->($value);
232        $self->set_active($value);
233    }
234    
235    sub get_value {
236        my ($self) = @_;
237    #    my $value = $self->get_data('value');
238        my $value = $self->{'value'};
239        defined $self->{'data_mapping'} and $value = $self->{'data_mapping'}->($value);
240        $value;
241    }
242    
243    package Libconf::GUI::Gtk2::Entry;
244    
245    use ugtk2 qw(:helpers :wrappers :create);
246    
247    our @ISA = qw(Gtk2::Entry);
248    
249    #constructor
250    #@widget_options is optional
251    sub new {
252        my ($class, $default, $data_mapping, @widget_options) = @_;
253    
254        #call the constructor of the parent class.
255        my $self = $class->SUPER::new(@widget_options);
256        bless $self, $class;
257        return $self;
258    }

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26