FS/FS/UI/Gtk.pm

   1 package FS::UI::Gtk;
   2
   3 use strict;
   4 use Gtk;
   5 use FS::UID qw(adminsuidsetup);
   6
   7 die "Can't initialize Gtk interface; $FS::UI::Base::_lock used"
   8   if $FS::UI::Base::_lock;
   9 $FS::UI::Base::_lock = "FS::UI::Gtk";
  10
  11 =head1 NAME
  12
  13 FS::UI::Gtk - Base class for Gtk user-interface objects
  14
  15 =head1 SYNOPSIS
  16
  17   use FS::UI::Gtk;
  18   use FS::UI::some_table;
  19
  20   $interface = new FS::UI::some_table;
  21
  22   $error = $interface->browse;
  23   $error = $interface->search;
  24   $error = $interface->view;
  25   $error = $interface->edit;
  26   $error = $interface->process;
  27
  28 =head1 DESCRIPTION
  29
  30 An FS::UI::Gtk object represents a Gtk user interface object.
  31
  32 =head1 METHODS
  33
  34 =over 4
  35
  36 =item new
  37
  38 =cut
  39
  40 sub new {
  41   my $proto = shift;
  42   my $class = ref($proto) || $proto;
  43   my $self = { @_ };
  44
  45   bless ( $self, $class );
  46
  47   $self->{'_user'} = 'ivan'; #Pop up login window?
  48   $self->{'_dbh'} = FS::UID::adminsuidsetup $self->{'_user'};
  49
  50
  51
  52   $self;
  53 }
  54
  55 sub activate {
  56   my $self = shift;
  57
  58   my $vbox = new Gtk::VBox ( 0, 4 );
  59
  60   foreach my $widget ( @{ $self->{'Widgets'} } ) {
  61     $widget->_gtk->show;
  62     $vbox->pack_start ( $widget->_gtk, 1, 1, 4 );
  63   }
  64   $vbox->show;
  65
  66   my $window = new Gtk::Window "toplevel";
  67   $self->{'_gtk'} = $window;
  68   $window->set_title( $self->title );
  69   $window->add ( $vbox );
  70   $window->show;
  71   main Gtk;
  72 }
  73
  74 =item interface
  75
  76 Returns the string `Gtk'.  Useful for the author of a table-specific UI class
  77 to conditionally specify certain behaviour.
  78
  79 =cut
  80
  81 sub interface { 'Gtk'; }
  82
  83 =back
  84
  85 =cut
  86
  87 package FS::UI::_Widget;
  88
  89 use vars qw( $AUTOLOAD );
  90
  91 sub new {
  92   my $proto = shift;
  93   my $class = ref($proto) || $proto;
  94   my $self = { @_ };
  95   bless ( $self, $class );
  96 }
  97
  98 sub _gtk {
  99   my $self = shift;
 100   $self->{'_gtk'};
 101 }
 102
 103 sub AUTOLOAD {
 104   my $self = shift;
 105   my $value = shift;
 106   my($field)=$AUTOLOAD;
 107   $field =~ s/.*://;
 108   if ( defined($value) ) {
 109     $self->{$field} = $value;
 110   } else {
 111     $self->{$field};
 112   }
 113 }
 114
 115 package FS::UI::_Text;
 116
 117 use vars qw ( @ISA );
 118
 119 @ISA = qw ( FS::UI::_Widget );
 120
 121 sub new {
 122   my $proto = shift;
 123   my $class = ref($proto) || $proto;
 124   my $self = {};
 125   $self->{'_gtk'} = new Gtk::Label ( shift );
 126   bless ( $self, $class );
 127 }
 128
 129 package FS::UI::_Link;
 130
 131 use vars qw ( @ISA );
 132
 133 @ISA = qw ( FS::UI::_Widget );
 134
 135 sub new {
 136   my $proto = shift;
 137   my $class = ref($proto) || $proto;
 138   my $self = { @_ };
 139   $self->{'_gtk'} = new_with_label Gtk::Button ( $self->{'text'} );
 140   $self->{'_gtk'}->signal_connect( 'clicked', sub {
 141       print "STUB: (Gtk) FS::UI::_Link";
 142     }, "hi", "there" );
 143   bless ( $self, $class );
 144 }
 145
 146
 147 package FS::UI::_Table;
 148
 149 use vars qw ( @ISA );
 150
 151 @ISA = qw ( FS::UI::_Widget );
 152
 153 sub new {
 154   my $proto = shift;
 155   my $class = ref($proto) || $proto;
 156   my $self = { @_ };
 157   bless ( $self, $class );
 158
 159   $self->{'_gtk'} = new Gtk::Table (
 160     $self->rows,
 161     $self->columns,
 162     0, #homogeneous
 163   );
 164
 165   $self;
 166 }
 167
 168 sub attach {
 169   my $self = shift;
 170   my ( $row, $column, $widget, $rowspan, $colspan ) = @_;
 171   $rowspan ||= 1;
 172   $colspan ||= 1;
 173   $self->_gtk->attach_defaults(
 174     $widget->_gtk,
 175     $column,
 176     $column + $colspan,
 177     $row,
 178     $row + $rowspan,
 179   );
 180   $widget->_gtk->show;
 181 }
 182
 183 package FS::UI::_Tableborder;
 184
 185 use vars qw ( @ISA );
 186
 187 @ISA = qw ( FS::UI::_Table );
 188
 189 =head1 VERSION
 190
 191 $Id: Gtk.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $
 192
 193 =head1 BUGS
 194
 195 This documentation is incomplete.
 196
 197 _Tableborder is just a _Table now.  _Tableborders should scroll (but not the
 198 headers) and need and need more decoration. (data in white section ala gtksql
 199 and sliding field widths) headers should be buttons that callback to sort on
 200 their fields.
 201
 202 There should be a persistant, per-(freeside)-user store for window positions
 203 and sizes and sort fields etc (see L<FS::UI::CGI/BUGS>.
 204
 205 Still some small bits of widget code same as FS::UI::CGI.
 206
 207 =head1 SEE ALSO
 208
 209 L<FS::UI::Base>
 210
 211 =head1 HISTORY
 212
 213 $Log: Gtk.pm,v $
 214 Revision 1.1  1999-08-04 09:03:53  ivan
 215 initial checkin of module files for proper perl installation
 216
 217 Revision 1.1  1999/01/20 09:30:36  ivan
 218 skeletal cross-UI UI code.
 219
 220
 221 =cut
 222
 223 1;
 224