examples/tk/gsequence.pl

   1 #!/usr/bin/perl
   2 # gSequence - Protein Sequence Control Panel
   3 # by Lorenz Pollsk
   4 #
   5 # this is work in progress! use this only for testing
   6
   7 use Gtk;
   8 use strict;
   9 use Bio::Seq;
  10 use Bio::SeqIO;
  11 use Bio::Tools::SeqStats;
  12 use Bio::SeqFeature::Generic;
  13 use Bio::Index::Abstract;
  14 use Bio::DB::GenBank;
  15 use Bio::DB::GenPept;
  16
  17 init Gtk;
  18
  19 # constant
  20 my $false = 0;
  21 my $true = 1;
  22
  23 # global widgets
  24 my ($main_notebook,@main_label,@seq_edit);
  25 my $about_dialog;
  26 my ($import_dialog,$import_entry,@import_buttons,$import_from);
  27 my ($description_window,$description_edit);
  28 my ($comment_window,$comment_edit,$current_comment,$comment_frame);
  29 my ($seqstats_window,$seqstats_edit);
  30 my ($dblink_window,@dblink_entry,$current_dblink,$dblink_clist,$dblink_handler_id);
  31 my ($ref_window,@ref_entry,$current_ref,$ref_clist,$ref_handler_id);
  32 my ($feature_window,@feature_entry,$current_feature_item,@feature_spinner,
  33     $feature_handler_id,$feature_tree);
  34 my ($pref_window,@pref_entry);
  35
  36 # global file data
  37 my @seq;
  38 my @filename;
  39 my @modified;
  40 my @locked; # locked sequence for editing ?
  41 my $current;
  42
  43 # menu
  44 my @menu_items = ( { path        => '/_File',
  45                      type        => '<Branch>' },
  46                    { path        => '/File/_New',
  47                      accelerator => '<control>N',
  48                      callback    => \&new },
  49                    { path        => '/File/_Open SwissProt',
  50                      accelerator => '<control>O',
  51                      callback    => \&open_dialog },
  52                    { path        => '/File/_Save SwissProt',
  53                      accelerator => '<control>S',
  54                      callback    => \&save },
  55                    { path        => '/File/Save _As...',
  56                      callback    => \&saveas_dialog },
  57                    { path        => '/File/Close',
  58                      callback    => \&close },
  59                    { path        => '/File/sep1',
  60                      type        => '<Separator>' },
  61                    { path        => '/File/_Import from...',
  62                      type        => '<Branch>' },
  63                    { path        => '/File/Import from.../Remote DB',
  64                      type        => '<Branch>' },
  65                    { path        => '/File/Import from.../Remote DB/AceDB',
  66                      callback    => sub { &seq_import("ace"); } },
  67                    { path        => '/File/Import from.../Remote DB/GenPept',
  68                      callback    => sub { &seq_import("genpept"); } },
  69                    { path        => '/File/Import from.../Flat File Index',
  70                      type        => '<Branch>' },
  71                    { path        => '/File/Import from.../Flat File Index/Fasta',
  72                      callback    => sub { &seq_import("fasta"); } },
  73                    { path        => '/File/Import from.../Flat File Index/SwissProt',
  74                      callback    => sub { &seq_import("swissprot"); } },
  75                    { path        => '/File/Import from.../Flat File Index/SwissPfam',
  76                      callback    => sub { &seq_import("swisspfam"); } },
  77                    { path        => '/File/_Export to...' },
  78                    { path        => '/File/sep2',
  79                      type        => '<Separator>' },
  80                    { path        => '/File/_Quit',
  81                      callback    => sub { Gtk->exit( 0 ); } },
  82
  83                    { path        => '/_Edit',
  84                      type        => '<Branch>' },
  85                    { path        => '/Edit/C_ut',
  86                      callback    => sub { $seq_edit[$current]->cut_clipboard(); },
  87                      accelerator => '<control>X' },
  88                    { path        => '/Edit/_Copy',
  89                      callback    => sub { $seq_edit[$current]->copy_clipboard(); },
  90                      accelerator => '<control>C' },
  91                    { path        => '/Edit/_Paste',
  92                      callback    => sub { $seq_edit[$current]->paste_clipboard(); },
  93                      accelerator => '<control>V' },
  94                    { path        => '/Edit/Select All',
  95                      callback    => sub { $seq_edit[$current]->select_region(0,-1); } },
  96
  97                    { path        => '/_Specs',
  98                      type        => '<Branch>' },
  99                    { path        => '/Specs/_Sequence Stats',
 100                      callback    => sub {&update_seqstats_window(1);} },
 101                    { path        => '/Specs/sep1',
 102                      type        => '<Separator>' },
 103                    { path        => '/Specs/_Description',
 104                      callback    => sub {&update_description_window(1);} },
 105                    { path        => '/Specs/_Comments',
 106                      callback    => sub {&update_comment_window(1);} },
 107                    { path        => '/Specs/_DB Links',
 108                      callback    => sub {&update_dblink_window(1);} },
 109                    { path        => '/Specs/_References',
 110                      callback    => sub {&update_reference_window(1);} },
 111                    { path        => '/Specs/sep2',
 112                      type        => '<Separator>' },
 113                    { path        => '/Specs/_Features',
 114                      callback    => sub {&update_feature_window(1);} },
 115
 116                    { path        => '/_Tools',
 117                      type        => '<Branch>' },
 118                    { path        => '/Tools/Code Table' },
 119                    { path        => '/Tools/sep1',
 120                      type        => '<Separator>' },
 121                    { path        => '/Tools/local Blast' },
 122                    { path        => '/Tools/local HMMER' },
 123                    { path        => '/Tools/hmmpfam' },
 124                    { path        => '/Tools/web Blast' },
 125
 126                    { path        => '/_Options',
 127                      type        => '<Branch>' },
 128                    { path        => '/Options/_Preferences',
 129                      callback    => sub {&update_pref_window(1);} },
 130
 131                    { path        => '/_Help',
 132                      type        => '<LastBranch>' },
 133                    { path        => '/Help/Help' },
 134                    { path        => '/Help/_About...',
 135                      callback    => sub { $about_dialog->show_all();} } );
 136
 137 ### main
 138
 139 $current = 0;
 140 &init_windows();
 141 main Gtk;
 142 exit( 0 );
 143
 144
 145 ### Subroutines
 146
 147 sub init_windows
 148 {
 149     &init_main_window();
 150     &init_about_dialog();
 151     &init_import_dialog();
 152     &init_seqstats_window();
 153     &init_description_window();
 154     &init_comment_window();
 155     &init_dblink_window();
 156     &init_reference_window();
 157     &init_feature_window();
 158     &init_pref_window();
 159 }
 160
 161 sub init_main_window
 162 {
 163     # toplevel window
 164     my $window;
 165     $window = new Gtk::Window( 'toplevel' );
 166     $window->signal_connect( 'destroy', sub { Gtk->exit( 0 ); } );
 167     $window->set_title( "gSequence" );
 168     $window->set_usize( 600, 400 );
 169
 170     # vertical box containing menu and text editor widget
 171     my $main_vbox;
 172     $main_vbox = new Gtk::VBox( $false, 1 );
 173     $main_vbox->border_width( 1 );
 174     $window->add( $main_vbox );
 175
 176     # handlebox for menubar
 177     my $handlebox;
 178     $handlebox = new Gtk::HandleBox();
 179     $main_vbox->pack_start( $handlebox, $false, $true, 0 );
 180
 181     # menubar
 182     my $menubar;
 183     $menubar = get_menu( $window );
 184     $handlebox->add( $menubar );
 185
 186     # text widget
 187     $seq_edit[$current] = new Gtk::Text( undef, undef );
 188     $seq_edit[$current]->set_editable( $true );
 189
 190     # vertical scrollbar for text widget
 191     my $scrollbar;
 192     $scrollbar = new Gtk::VScrollbar( $seq_edit[$current]->vadj );
 193
 194     # horizontal box containing text widget and scrollbar
 195     my $seq_edit_hbox;
 196     $seq_edit_hbox = new Gtk::HBox( $false, 1 );
 197     $seq_edit_hbox->border_width( 1 );
 198     $seq_edit_hbox->pack_start( $seq_edit[$current], $true, $true, 0);
 199     $seq_edit_hbox->pack_end( $scrollbar, $false, $true, 0);
 200
 201     $main_notebook = new Gtk::Notebook();
 202     $main_notebook->set_tab_pos( 'top' );
 203
 204     $main_vbox->pack_end( $main_notebook, $true, $true, 0);
 205
 206     # show everything
 207     $window->show_all();
 208
 209     $main_notebook->signal_connect_after("switch-page",
 210        sub{ #$seq[$current]->seq($seq_edit[$current]->get_chars(0,-1))
 211             #   if (defined($seq[$current]));
 212             $current = $main_notebook->get_current_page();
 213             &update_seq_data(); } );
 214 }
 215
 216 sub get_menu
 217 {
 218     my ( $window ) = @_;
 219
 220     my $menubar;
 221     my $item_factory;
 222     my $accel_group;
 223
 224     $accel_group = new Gtk::AccelGroup();
 225
 226     # This function initializes the item factory.
 227     # Param 1: The type of menu - can be 'Gtk::MenuBar', 'Gtk::Menu',
 228     #          or 'Gtk::OptionMenu'.
 229     # Param 2: The path of the menu.
 230     # Param 3: The accelerator group.  The item factory sets up
 231     #          the accelerator table while generating menus.
 232     $item_factory = new Gtk::ItemFactory( 'Gtk::MenuBar',
 233                                           '<main>',
 234                                           $accel_group );
 235
 236     # This function generates the menu items. Pass the item factory,
 237     # the number of items in the array, the array itself, and any
 238     # callback data for the the menu items.
 239     $item_factory->create_items( @menu_items );
 240
 241     # Attach the new accelerator group to the window.
 242     $window->add_accel_group( $accel_group );
 243
 244     # Finally, return the actual menu bar created by the item factory.
 245     #*menubar = gtk_item_factory_get_widget (item_factory, "&lt;main>");
 246     return ( $item_factory->get_widget( '<main>' ) );
 247 }
 248
 249 sub new_seq_page
 250 {
 251     my ($seq) = shift;
 252     my $curr;
 253
 254     push @seq,$seq;
 255     $curr = @seq - 1;
 256     $main_label[$curr] = new Gtk::Label($seq[$curr]->id())
 257         if (defined($seq[$curr]));
 258     $main_label[$curr] = new Gtk::Label("<New>")
 259         if (!defined($seq[$curr]));
 260
 261     # text widget
 262     $seq_edit[$curr] = new Gtk::Text( undef, undef );
 263     $seq_edit[$curr]->set_editable( $true );
 264
 265     # vertical scrollbar for text widget
 266     my $scrollbar;
 267     $scrollbar = new Gtk::VScrollbar( $seq_edit[$curr]->vadj );
 268
 269     # horizontal box containing text widget and scrollbar
 270     my $seq_edit_hbox;
 271     $seq_edit_hbox = new Gtk::HBox( $false, 1 );
 272     $seq_edit_hbox->border_width( 1 );
 273     $seq_edit_hbox->pack_start( $seq_edit[$curr], $true, $true, 0);
 274     $seq_edit_hbox->pack_end( $scrollbar, $false, $true, 0);
 275
 276     $main_notebook->append_page( $seq_edit_hbox, $main_label[$curr] );
 277     $main_notebook->show_all();
 278     $main_notebook->set_page(-1);
 279 }
 280
 281 sub seq_fetch
 282 {
 283     my ($server,$port,$dir,$db); # read from preferences
 284     my ($dbobj);
 285
 286     return if (!defined($import_from) || !($import_from));
 287
 288     $dbobj = Bio::DB::GenPept->new() if ($import_from eq "genpept");
 289     $dbobj = Bio::DB::Ace->new(-host=>$server,-port=>$port)
 290         if ($import_from eq "ace");
 291     $dbobj = Bio::Index::Abstract->new("$dir/$db")
 292         if ($import_from eq "fasta") ||
 293            ($import_from eq "swissprot") ||
 294            ($import_from eq "swisspfam");
 295
 296     if( $import_buttons[0]->get_active() ) {
 297         &new_seq_page($dbobj->get_Seq_by_id($import_entry->get_text()));
 298     } else {
 299         &new_seq_page($dbobj->get_Seq_by_acc($import_entry->get_text()));
 300     }
 301 }
 302
 303 sub seq_import
 304 {
 305     ($import_from) = @_;
 306     my %names = ( "ace" => "AceDB",
 307                          "genpept" => "GenPept DB",
 308                          "fasta" => "Fasta Flat File",
 309                          "swissprot" => "SwissProt Flat File",
 310                          "swisspfam" => "SwissPfam Flat File"
 311                      );
 312     $import_dialog->set_title("Import from ".$names{$import_from});
 313     $import_entry->set_text("");
 314     $import_dialog->show_all();
 315 }
 316
 317 sub init_import_dialog
 318 {
 319     $import_dialog = new Gtk::Dialog();
 320     $import_dialog->border_width(5);
 321
 322     # create the first button and add it to a box
 323     my $button = new Gtk::RadioButton( "Fetch by ID" );
 324     $import_dialog->vbox->pack_start($button,$false,$false,2);
 325
 326     # create the second button and add it to a box
 327     $button = new Gtk::RadioButton( "Fetch by ACCESSION", $button );
 328     $import_dialog->vbox->pack_start($button,$false,$false,2);
 329     @import_buttons = $button->group();
 330
 331     $import_entry = new Gtk::Entry();
 332     my $frame = new Gtk::Frame("Enter here:");
 333     $frame->add($import_entry);
 334     $import_dialog->vbox->pack_start( $frame, $true, $true, 5);
 335
 336     my $bbox = new Gtk::HButtonBox();
 337     $bbox->set_layout("end");
 338
 339     $button = new Gtk::Button( "OK" );
 340     $bbox->add( $button );
 341     $button->signal_connect("clicked",
 342            # OK button handler
 343            sub{ $import_dialog->hide();
 344                 &seq_fetch();
 345               });
 346
 347     $button = new Gtk::Button( "Cancel" );
 348     $bbox->add( $button );
 349     $button->signal_connect("clicked",
 350            # close button handler
 351            sub{ $import_dialog->hide();
 352               });
 353
 354     $import_dialog->action_area->pack_start( $bbox, $true, $true, 0 );
 355
 356     $import_dialog->signal_connect_after( "delete_event",
 357            # window delete handler
 358            sub{ $import_dialog->hide();
 359                 return &Gtk::true;
 360               });
 361 }
 362
 363 sub open_dialog
 364 {
 365     # Create a new file selection widget
 366     my $open_dialog = new Gtk::FileSelection( "Open File..." );
 367     # Connect the ok_button to open_ok_sel function
 368     $open_dialog->ok_button->signal_connect( "clicked",
 369                                              \&ok_open_dialog,
 370                                              $open_dialog );
 371     # Connect the cancel_button to destroy the widget
 372     $open_dialog->cancel_button->signal_connect( "clicked",
 373                                                  sub { $open_dialog->destroy(); } );
 374     $open_dialog->show();
 375 }
 376
 377 # Get the selected filename
 378 sub ok_open_dialog
 379   {
 380     my ( $widget, $file_selection ) = @_;
 381     push @filename, $file_selection->get_filename();
 382
 383     $widget->parent->parent->parent->destroy();
 384
 385     my $in = Bio::SeqIO->new(-file => $filename[-1] , '-format' => 'swiss');
 386
 387     &new_seq_page($in->next_seq());
 388 }
 389
 390 sub update_seq_data
 391 {
 392     $main_label[$current]->set_text($seq[$current]->id) if (defined($seq[$current]));
 393     $main_label[$current]->set_text("<New>") if (!defined($seq[$current]));
 394
 395     $seq_edit[$current]->freeze();
 396     $seq_edit[$current]->delete_text(0,-1);
 397     $seq_edit[$current]->insert(undef,undef,undef,$seq[$current]->seq()) if (defined($seq[$current]));
 398     $seq_edit[$current]->thaw();
 399
 400     &update_comment_window();
 401     &update_description_window();
 402     &update_seqstats_window();
 403     &update_dblink_window();
 404     &update_reference_window();
 405     &update_feature_window();
 406 }
 407
 408 sub new
 409 {
 410     &new_seq_page(undef);
 411 }
 412
 413 sub close
 414 {
 415 }
 416
 417 sub save
 418 {
 419     if (!defined($filename[$current])||!$filename[$current])
 420     {
 421         &saveas_dialog;
 422         return;
 423     }
 424     my $out = Bio::SeqIO->new(-file => ">$filename[$current]" , '-format' => 'swiss');
 425     $out->write_seq($seq[$current]);
 426 }
 427
 428 sub saveas_dialog
 429 {
 430     # Create a new file selection widget
 431     my $saveas_dialog = new Gtk::FileSelection( "Save As..." );
 432     # Connect the ok_button to saveas_ok_sel function
 433     $saveas_dialog->ok_button->signal_connect( "clicked",
 434                                                \&ok_saveas_dialog,
 435                                                $saveas_dialog );
 436     # Connect the cancel_button to destroy the widget
 437     $saveas_dialog->cancel_button->signal_connect( "clicked",
 438                                                    sub { $saveas_dialog->destroy(); } );
 439     $saveas_dialog->show();
 440 }
 441
 442 # Get the selected filename and print it to the console
 443 sub ok_saveas_dialog
 444   {
 445     my ( $widget, $file_selection ) = @_;
 446     my $filename = $file_selection->get_filename();
 447     $widget->parent->parent->parent->destroy();
 448     $filename[$current] = $filename;
 449     my $out = Bio::SeqIO->new(-file => ">$filename[$current]" , '-format' => 'swiss');
 450     $out->write_seq($seq[$current]);
 451   }
 452
 453 sub init_comment_window
 454 {
 455     $current_comment = 0;
 456
 457     $comment_window = new Gtk::Dialog();
 458     $comment_window->set_default_size(650,300);
 459     $comment_window->set_policy($false,$true,$false);
 460     $comment_window->set_title("Comments");
 461     $comment_window->border_width(5);
 462
 463     # frame
 464     $comment_frame = new Gtk::Frame( "Comment[".$current_comment."]" );
 465
 466     # text widget
 467     $comment_edit = new Gtk::Text( undef, undef );
 468     $comment_edit->set_editable( $true );
 469     $comment_edit->set_word_wrap( $true );
 470
 471     # vertical scrollbar for text widget
 472     my $scrollbar;
 473     $scrollbar = new Gtk::VScrollbar( $comment_edit->vadj );
 474
 475     # horizontal box containing text widget and scrollbar
 476     my $hbox;
 477     $hbox = new Gtk::HBox( $false, 1 );
 478     $hbox->border_width( 1 );
 479     $hbox->pack_start( $comment_edit, $true, $true, 0);
 480     $hbox->pack_end( $scrollbar, $false, $true, 0);
 481     $comment_frame->add($hbox);
 482     $comment_window->vbox->pack_start( $comment_frame, $true, $true, 5);
 483
 484     my $bbox = new Gtk::HBox( $false, 5 );
 485     $bbox->border_width(10);
 486     my $arrow = new Gtk::Arrow('right','out');
 487     my $button = new Gtk::Button();
 488     $button->add($arrow);
 489     $bbox->pack_end( $button, $false, $false, 0);
 490     $button->signal_connect
 491         ( "clicked",
 492           # next comment button handler
 493           sub { return if !defined($seq[$current]);
 494                  &store_current_comment;
 495                 $current_comment++
 496                     if ($current_comment <((scalar $seq[$current]->annotation->each_Comment)-1));
 497                 &update_comment_window;
 498             } );
 499
 500     $arrow = new Gtk::Arrow('left','out');
 501     $button = new Gtk::Button();
 502     $button->add($arrow);
 503     $bbox->pack_end( $button, $false, $false, 0);
 504     $button->signal_connect( "clicked",
 505            # prev comment button handler
 506            sub { return if !defined($seq[$current]);
 507                  &store_current_comment;
 508                  $current_comment--
 509                      if ($current_comment > 0);
 510                  &update_comment_window;
 511                } );
 512
 513     $button = new Gtk::Button("Add");
 514     $bbox->pack_start( $button, $false, $false, 0);
 515     $button->signal_connect( "clicked",
 516            # add comment button handler
 517            sub { return if !defined($seq[$current]);
 518                  &store_current_comment;
 519                  my $comment = new Bio::Annotation::Comment;
 520                  $comment->text("");
 521                  $seq[$current]->annotation->add_Comment( $comment );
 522                  $current_comment = $seq[$current]->annotation->each_Comment - 1;
 523                  &update_comment_window;
 524                } );
 525
 526      $button = new Gtk::Button("Delete");
 527      $bbox->pack_start( $button, $false, $false, 0);
 528      $button->signal_connect( "clicked",
 529            # delete comment button handler
 530            sub { return if !defined($seq[$current]);
 531                  $seq[$current]->annotation->remove_Comment( $current_comment );
 532                  $current_comment = $current_comment - 1
 533                      if ($current_comment > 0);
 534                  &update_comment_window;
 535                } );
 536
 537      $comment_window->vbox->pack_end( $bbox, $false, $false, 0);
 538
 539      $bbox = new Gtk::HButtonBox();
 540      $bbox->set_layout("end");
 541
 542      $button = new Gtk::Button( "Close" );
 543      $bbox->add( $button );
 544      $button->signal_connect("clicked",
 545            # close button handler
 546            sub{ $comment_window->hide();
 547                 &store_current_comment;
 548               });
 549
 550      $comment_window->action_area->pack_start( $bbox, $true, $true, 0 );
 551      $comment_window->signal_connect_after( "delete_event",
 552            # window delete handler
 553            sub{ $comment_window->hide();
 554                 &store_current_comment;
 555                 return &Gtk::true;
 556               });
 557 }
 558
 559 sub store_current_comment
 560 {
 561     (($seq[$current]->annotation->each_Comment)[$current_comment])->
 562         text($comment_edit->get_chars(0,-1) )
 563             if ((defined($seq[$current])) && ($seq[$current]->annotation->each_Comment));
 564 }
 565
 566 sub update_comment_window
 567 {
 568     my ($show_me) = @_;
 569     $comment_frame->set_label("Comment[".$current_comment."]");
 570     # insert comment text
 571     $comment_edit->freeze();
 572     $comment_edit->delete_text(0,-1);
 573     if (defined($seq[$current]))
 574     {
 575         my @comment = $seq[$current]->annotation->each_Comment;
 576         $comment_edit->insert(undef,undef,undef, $comment[$current_comment]->text)
 577             if (@comment);
 578     }
 579     $comment_edit->thaw();
 580
 581     $comment_window->show_all() if (defined($show_me));
 582 }
 583
 584 sub init_description_window
 585 {
 586     $description_window = new Gtk::Dialog();
 587     $description_window->set_default_size(620,250);
 588     $description_window->border_width(5);
 589     $description_window->set_title("Description");
 590
 591     # frame
 592     my $description_frame = new Gtk::Frame( "Description" );
 593
 594     # text widget
 595     $description_edit = new Gtk::Text( undef, undef );
 596     $description_edit->set_editable( $true );
 597     $description_edit->set_word_wrap( $true );
 598
 599     # vertical scrollbar for text widget
 600     my $scrollbar;
 601     $scrollbar = new Gtk::VScrollbar( $description_edit->vadj );
 602
 603     # horizontal box containing text widget and scrollbar
 604     my $hbox;
 605     $hbox = new Gtk::HBox( $false, 1 );
 606     $hbox->border_width( 1 );
 607     $hbox->pack_start( $description_edit, $true, $true, 0);
 608     $hbox->pack_end( $scrollbar, $false, $true, 0);
 609     $description_frame->add($hbox);
 610     $description_window->vbox->pack_start( $description_frame, $true, $true, 5);
 611
 612     my $bbox = new Gtk::HButtonBox();
 613     $bbox->set_layout("end");
 614
 615     my $button = new Gtk::Button( "Close" );
 616     $bbox->add( $button );
 617     $button->signal_connect("clicked",
 618            # close button handler
 619            sub{ $description_window->hide();
 620                 $seq[$current]->desc($description_edit->get_chars(0,-1))
 621                     if $description_edit->get_chars(0,-1);
 622               });
 623
 624     $description_window->action_area->pack_start( $bbox, $true, $true, 0 );
 625     $description_window->signal_connect_after( "delete_event",
 626            # window delete handler
 627            sub{ $description_window->hide();
 628                 $seq[$current]->desc($description_edit->get_chars(0,-1))
 629                     if $description_edit->get_chars(0,-1);
 630                 return &Gtk::true;
 631               });
 632 }
 633
 634 sub update_description_window
 635 {
 636     my ($show_me) = @_;
 637     $description_edit->freeze();
 638     $description_edit->delete_text(0,-1);
 639     $description_edit->insert(undef,undef,undef,$seq[$current]->desc)
 640         if defined($seq[$current]) && defined($seq[$current]->desc);
 641     $description_edit->thaw();
 642
 643     $description_window->show_all() if (defined($show_me));
 644 }
 645
 646 sub init_seqstats_window
 647 {
 648     $seqstats_window = new Gtk::Dialog();
 649     $seqstats_window->border_width(5);
 650     $seqstats_window->set_default_size(100,250);
 651     $seqstats_window->set_title("Sequence Statistics");
 652
 653     # frame
 654     my $seqstats_frame = new Gtk::Frame( "Sequence Statistics" );
 655
 656     # text widget
 657     $seqstats_edit = new Gtk::Text( undef, undef );
 658     $seqstats_edit->set_editable( $false );
 659     $seqstats_edit->set_word_wrap( $true );
 660
 661     # vertical scrollbar for text widget
 662     my $scrollbar;
 663     $scrollbar = new Gtk::VScrollbar( $seqstats_edit->vadj );
 664
 665     # horizontal box containing text widget and scrollbar
 666     my $hbox;
 667     $hbox = new Gtk::HBox( $false, 1 );
 668     $hbox->border_width( 1 );
 669     $hbox->pack_start( $seqstats_edit, $true, $true, 0);
 670     $hbox->pack_end( $scrollbar, $false, $true, 0);
 671     $seqstats_frame->add($hbox);
 672     $seqstats_window->vbox->pack_start( $seqstats_frame, $true, $true, 5);
 673
 674     my $bbox = new Gtk::HButtonBox();
 675     $bbox->set_layout("end");
 676
 677     my $button = new Gtk::Button( "Close" );
 678     $bbox->add( $button );
 679     $button->signal_connect("clicked",
 680        # close button handler
 681        sub{ $seqstats_window->hide();
 682           });
 683
 684     $seqstats_window->action_area->pack_start( $bbox, $true, $true, 0 );
 685     $seqstats_window->signal_connect_after( "delete_event",
 686        # window delete handler
 687        sub{ $seqstats_window->hide();
 688             return &Gtk::true;
 689           });
 690 }
 691
 692 sub update_seqstats_window
 693 {
 694     my ($show_me) = @_;
 695     my ($data,$weight,$count_hash,$percent);
 696
 697     $seqstats_edit->freeze();
 698     $seqstats_edit->delete_text(0,-1);
 699     if (defined($seq[$current]))
 700     {
 701         $data = $seq[$current]->id."\n\n";
 702         $weight = Bio::Tools::SeqStats->get_mol_wt($seq[$current]->primary_seq);
 703         if ($$weight[0] == $$weight[1]) {
 704             $data .= "Molecular weight of sequence equals to ".$$weight[0]."\n\n";
 705         } else {
 706             $data .= "Molecular weight of sequence is greater than ";
 707             $data .= $$weight[0]." and less than ".$$weight[1]."\n\n";
 708         }
 709         $count_hash = Bio::Tools::SeqStats->count_monomers($seq[$current]->primary_seq);
 710         $data .= "Amino Acids:\n";
 711         foreach (sort keys %$count_hash)
 712         {
 713             $percent = sprintf "%.1f",
 714             (($$count_hash{$_} / $seq[$current]->length)*100);
 715             $data .= "${_}: ".$$count_hash{$_}." (${percent}%) \n"
 716             }
 717         $seqstats_edit->insert(undef,undef,undef,$data)
 718         }
 719     $seqstats_edit->thaw();
 720
 721     $seqstats_window->show_all() if (defined($show_me));
 722 }
 723
 724 sub init_dblink_window
 725 {
 726     $current_dblink = 0;
 727
 728     $dblink_window = new Gtk::Dialog();
 729     $dblink_window->set_default_size(500,400);
 730     $dblink_window->set_policy($true,$true,$false);
 731     $dblink_window->set_title("Database Links");
 732     $dblink_window->border_width(5);
 733
 734     # Create a scrolled window to pack the CList widget into
 735     my $scrolled_window = new Gtk::ScrolledWindow( undef, undef );
 736     $dblink_window->vbox->pack_start( $scrolled_window, $true, $true, 0 );
 737     $scrolled_window->set_policy( 'automatic', 'always' );
 738
 739     # Create the CList. For this example we use 2 columns
 740     $dblink_clist = new_with_titles Gtk::CList( "Primary Id","Database" );
 741
 742     # When a selection is made, we want to know about it. The callback
 743     # used is selection_made, and its code can be found further down
 744     $dblink_handler_id = $dblink_clist->signal_connect( "select_row",
 745        sub{ return if (!defined($seq[$current]));
 746             my ( $clist, $row ) = @_;
 747             &store_current_dblink;
 748             $current_dblink = $row;
 749             &update_dblink_window;
 750           } );
 751
 752     # It isn't necessary to shadow the border, but it looks nice :)
 753     $dblink_clist->set_shadow_type( 'out' );
 754
 755     # What however is important, is that we set the column widths as
 756     # they will never be right otherwise. Note that the columns are
 757     # numbered from 0 and up (to 1 in this case).
 758     $dblink_clist->set_column_width( 0, 150 );
 759
 760     # Add the CList widget to the vertical box
 761     $scrolled_window->add( $dblink_clist );
 762
 763     my $bbox = new Gtk::HBox( $false, 5 );
 764     $bbox->border_width(10);
 765     my $arrow = new Gtk::Arrow('down','out');
 766     my $button = new Gtk::Button();
 767     $button->add($arrow);
 768     $bbox->pack_end( $button, $false, $false, 0);
 769     $button->signal_connect
 770         ( "clicked",
 771           # next dblink button handler
 772           sub { return if (!defined($seq[$current]));
 773                 &store_current_dblink;
 774                 $current_dblink++
 775                     if ($current_dblink <((scalar $seq[$current]->annotation->each_DBLink)-1));
 776                 &update_dblink_window;
 777               } );
 778
 779     $arrow = new Gtk::Arrow('up','out');
 780     $button = new Gtk::Button();
 781     $button->add($arrow);
 782     $bbox->pack_end( $button, $false, $false, 0);
 783     $button->signal_connect( "clicked",
 784            # prev comment button handler
 785            sub { return if (!defined($seq[$current]));
 786                  &store_current_dblink;
 787                  $current_dblink--
 788                      if ($current_dblink > 0);
 789                  &update_dblink_window;
 790                } );
 791
 792     $button = new Gtk::Button("Add");
 793     $bbox->pack_start( $button, $false, $false, 0);
 794     $button->signal_connect( "clicked",
 795            # add comment button handler
 796            sub { return if (!defined($seq[$current]));
 797                  &store_current_dblink;
 798                  my $dblink = new Bio::Annotation::DBLink;
 799                  $dblink->primary_id("<New>");
 800                  $seq[$current]->annotation->add_DBLink( $dblink );
 801                  $current_dblink = $seq[$current]->annotation->each_DBLink - 1;
 802                  $dblink_clist->append("","");
 803                  &update_dblink_window;
 804                } );
 805
 806      $button = new Gtk::Button("Delete");
 807      $bbox->pack_start( $button, $false, $false, 0);
 808      $button->signal_connect( "clicked",
 809            # delete comment button handler
 810            sub { return if !defined($seq[$current]);
 811                  $seq[$current]->annotation->remove_DBLink( $current_dblink );
 812                  $dblink_clist->remove($current_dblink);
 813                  $current_dblink-- if ($current_dblink > 0);
 814                  &update_dblink_window;
 815                } );
 816
 817      $dblink_window->vbox->pack_start( $bbox, $false, $false, 0);
 818
 819     # horizontal box containing primary_id & optional_id entries
 820     my $hbox;
 821     $hbox = new Gtk::HBox( $true, 10 );
 822     $hbox->border_width( 1 );
 823
 824     # text entries
 825     $dblink_entry[0] = new Gtk::Entry();
 826     my $frame = new Gtk::Frame("primary id");
 827     $frame->add($dblink_entry[0]);
 828     $hbox->pack_start( $frame, $true, $true, 0);
 829
 830     $dblink_entry[1] = new Gtk::Entry();
 831     $frame = new Gtk::Frame("optional id");
 832     $frame->add($dblink_entry[1]);
 833     $hbox->pack_end( $frame, $true, $true, 0);
 834
 835     $dblink_window->vbox->pack_start( $hbox, $false, $false, 5);
 836
 837     $dblink_entry[2] = new Gtk::Entry();
 838     $frame = new Gtk::Frame("Database");
 839     $frame->add($dblink_entry[2]);
 840     $dblink_window->vbox->pack_start( $frame, $false, $false, 5);
 841
 842     $dblink_entry[3] = new Gtk::Entry();
 843     $frame = new Gtk::Frame("Comment");
 844     $frame->add($dblink_entry[3]);
 845     $dblink_window->vbox->pack_end( $frame, $false, $false, 5);
 846
 847      $bbox = new Gtk::HButtonBox();
 848      $bbox->set_layout("end");
 849
 850      $button = new Gtk::Button( "Close" );
 851      $bbox->add( $button );
 852      $button->signal_connect("clicked",
 853            # close button handler
 854            sub{ $dblink_window->hide();
 855                 &store_current_dblink;
 856               });
 857
 858      $dblink_window->action_area->pack_start( $bbox, $true, $true, 0 );
 859      $dblink_window->signal_connect_after( "delete_event",
 860            # window delete handler
 861            sub{ $dblink_window->hide();
 862                 &store_current_dblink;
 863                 return &Gtk::true;
 864               });
 865 }
 866
 867 sub store_current_dblink
 868 {
 869     if ((defined($seq[$current])) && ($seq[$current]->annotation->each_DBLink))
 870     {
 871         (($seq[$current]->annotation->each_DBLink)[$current_dblink])->
 872             primary_id($dblink_entry[0]->get_chars(0,-1) );
 873         (($seq[$current]->annotation->each_DBLink)[$current_dblink])->
 874             optional_id($dblink_entry[1]->get_chars(0,-1) );
 875         (($seq[$current]->annotation->each_DBLink)[$current_dblink])->
 876             database($dblink_entry[2]->get_chars(0,-1) );
 877         (($seq[$current]->annotation->each_DBLink)[$current_dblink])->
 878             comment($dblink_entry[3]->get_chars(0,-1) );
 879     }
 880 }
 881
 882 sub update_dblink_window
 883 {
 884     my ($show_me) = @_;
 885     $dblink_window->show_all() if (defined($show_me));
 886
 887     $dblink_clist->freeze();
 888     if (!defined($seq[$current]))
 889     {
 890         $dblink_clist->clear();
 891         $dblink_clist->thaw();
 892         foreach (@dblink_entry) { $_->set_text(""); }
 893         return;
 894     }
 895     my @dblinks = $seq[$current]->annotation->each_DBLink;
 896     # reset clist if rows are different to links
 897     if ($dblink_clist->rows != @dblinks) {
 898         $dblink_clist->clear();
 899         foreach (@dblinks) { $dblink_clist->append("",""); }
 900     }
 901     # redraw references
 902     for(my $i=0;$i<@dblinks;$i++)
 903     {
 904         $dblink_clist->set_text($i,0,$dblinks[$i]->primary_id);
 905         $dblink_clist->set_text($i,1,$dblinks[$i]->database);
 906     }
 907     # redraw text widgets
 908     foreach (@dblink_entry) { $_->set_text(""); }
 909     if (@dblinks)
 910     {
 911         $dblink_entry[0]->set_text($dblinks[$current_dblink]->primary_id);
 912         $dblink_entry[1]->set_text($dblinks[$current_dblink]->optional_id);
 913         $dblink_entry[2]->set_text($dblinks[$current_dblink]->database);
 914         $dblink_entry[3]->set_text($dblinks[$current_dblink]->comment);
 915     }
 916
 917     $dblink_clist->moveto($current_dblink,0,0.3,0.0)
 918         if ($dblink_clist->row_is_visible($current_dblink) ne 'full');
 919     $dblink_clist->signal_handler_block($dblink_handler_id);
 920     $dblink_clist->select_row($current_dblink,0);
 921     $dblink_clist->signal_handler_unblock($dblink_handler_id);
 922     Gtk::CList::set_focus_row($dblink_clist,$current_dblink);
 923     $dblink_clist->thaw();
 924 }
 925
 926 sub init_reference_window
 927 {
 928     $current_ref = 0;
 929
 930     $ref_window = new Gtk::Dialog();
 931     $ref_window->set_default_size(620,500);
 932     $ref_window->set_policy($true,$true,$false);
 933     $ref_window->set_title("References");
 934     $ref_window->border_width(5);
 935
 936     # Create a scrolled window to pack the CList widget into
 937     my $scrolled_window = new Gtk::ScrolledWindow( undef, undef );
 938     $ref_window->vbox->pack_start( $scrolled_window, $true, $true, 0 );
 939     $scrolled_window->set_policy( 'automatic', 'always' );
 940
 941     # Create the CList. For this example we use 2 columns
 942     $ref_clist = new_with_titles Gtk::CList( "Medline","Title","Authors" );
 943
 944     # When a selection is made, we want to know about it. The callback
 945     # used is selection_made, and its code can be found further down
 946     $ref_handler_id = $ref_clist->signal_connect( "select_row",
 947        sub{ return if (!defined($seq[$current]));
 948             my ( $clist, $row ) = @_;
 949             &store_current_reference;
 950             $current_ref = $row;
 951             &update_reference_window;
 952           } );
 953
 954     # It isn't necessary to shadow the border, but it looks nice :)
 955     $ref_clist->set_shadow_type( 'out' );
 956
 957     # What however is important, is that we set the column widths as
 958     # they will never be right otherwise. Note that the columns are
 959     # numbered from 0 and up (to 1 in this case).
 960     $ref_clist->set_column_width( 0, 70 );
 961     $ref_clist->set_column_width( 1, 350 );
 962     $ref_clist->set_column_width( 2, 300 );
 963
 964     # Add the CList widget to the vertical box
 965     $scrolled_window->add( $ref_clist );
 966
 967     my $bbox = new Gtk::HBox( $false, 5 );
 968     $bbox->border_width(10);
 969     my $arrow = new Gtk::Arrow('down','out');
 970     my $button = new Gtk::Button();
 971     $button->add($arrow);
 972     $bbox->pack_end( $button, $false, $false, 0);
 973     $button->signal_connect
 974         ( "clicked",
 975           # next ref button handler
 976           sub { return if (!defined($seq[$current]));
 977                 &store_current_reference;
 978                 $current_ref++
 979                     if ($current_ref <((scalar $seq[$current]->annotation->each_Reference)-1));
 980                 &update_reference_window;
 981             } );
 982
 983     $arrow = new Gtk::Arrow('up','out');
 984     $button = new Gtk::Button();
 985     $button->add($arrow);
 986     $bbox->pack_end( $button, $false, $false, 0);
 987     $button->signal_connect( "clicked",
 988            # prev comment button handler
 989            sub { return if (!defined($seq[$current]));
 990                  &store_current_reference;
 991                  $current_ref--
 992                      if ($current_ref > 0);
 993                  &update_reference_window;
 994                } );
 995
 996     $button = new Gtk::Button("Add");
 997     $bbox->pack_start( $button, $false, $false, 0);
 998     $button->signal_connect( "clicked",
 999            # add comment button handler
1000            sub { return if (!defined($seq[$current]));
1001                  &store_current_reference;
1002                  my $ref = new Bio::Annotation::Reference;
1003                  $ref->medline("<New>");
1004                  $seq[$current]->annotation->add_Reference( $ref );
1005                  $ref_clist->append("","","");
1006                  $current_ref = ($seq[$current]->annotation->each_Reference)-1;
1007                  &update_reference_window;
1008                } );
1009
1010      $button = new Gtk::Button("Delete");
1011      $bbox->pack_start( $button, $false, $false, 0);
1012      $button->signal_connect( "clicked",
1013            # delete comment button handler
1014            sub { return if !defined($seq[$current]);
1015                  $seq[$current]->annotation->remove_Reference( $current_ref );
1016                  $ref_clist->remove($current_ref);
1017                  $current_ref-- if ($current_ref > 0);
1018                  &update_reference_window;
1019                } );
1020
1021      $ref_window->vbox->pack_start( $bbox, $false, $false, 0);
1022
1023     # horizontal box containing primary_id & optional_id entries
1024     my $hbox;
1025     $hbox = new Gtk::HBox( $true, 10 );
1026     $hbox->border_width( 1 );
1027
1028     # text entries
1029     $ref_entry[0] = new Gtk::Entry();
1030     my $frame = new Gtk::Frame("Title");
1031     $frame->add($ref_entry[0]);
1032     $ref_window->vbox->pack_start( $frame, $false, $false, 5);
1033
1034     $ref_entry[1] = new Gtk::Entry();
1035     $frame = new Gtk::Frame("Authors");
1036     $frame->add($ref_entry[1]);
1037     $ref_window->vbox->pack_start( $frame, $false, $false, 5);
1038
1039     # horizontal box
1040     $hbox = new Gtk::HBox( $true, 10 );
1041     $hbox->border_width( 1 );
1042
1043     # text entries
1044     $ref_entry[2] = new Gtk::Entry();
1045     $frame = new Gtk::Frame("Comment");
1046     $frame->add($ref_entry[2]);
1047     $hbox->pack_start( $frame, $true, $true, 0);
1048
1049     $ref_entry[3] = new Gtk::Entry();
1050     $frame = new Gtk::Frame("Location");
1051     $frame->add($ref_entry[3]);
1052     $hbox->pack_end( $frame, $true, $true, 0);
1053
1054     $ref_window->vbox->pack_start( $hbox, $false, $false, 5);
1055
1056     # horizontal box
1057     $hbox = new Gtk::HBox( $false, 10 );
1058     $hbox->border_width( 1 );
1059
1060     # text entries
1061     $ref_entry[4] = new Gtk::Entry();
1062     $frame = new Gtk::Frame("Medline");
1063     $frame->add($ref_entry[4]);
1064     $hbox->pack_start( $frame, $false, $false, 0);
1065
1066 #    $ref_entry[5] = new Gtk::Entry();
1067 #    $frame = new Gtk::Frame("Start");
1068 #    $frame->add($ref_entry[5]);
1069 #    $hbox->pack_start( $frame, $false, $false, 0);
1070
1071     $ref_entry[5] = new Gtk::Entry();
1072     $frame = new Gtk::Frame("Reference Position");
1073     $frame->add($ref_entry[5]);
1074     $hbox->pack_end( $frame, $true, $true, 0);
1075
1076     $ref_window->vbox->pack_start( $hbox, $false, $false, 5);
1077
1078
1079      $bbox = new Gtk::HButtonBox();
1080      $bbox->set_layout("end");
1081
1082      $button = new Gtk::Button( "Close" );
1083      $bbox->add( $button );
1084      $button->signal_connect("clicked",
1085            # close button handler
1086            sub{ $ref_window->hide();
1087                 &store_current_reference;
1088               });
1089
1090      $ref_window->action_area->pack_start( $bbox, $true, $true, 0 );
1091      $ref_window->signal_connect_after( "delete_event",
1092            # window delete handler
1093            sub{ $ref_window->hide();
1094                 &store_current_reference;
1095                 return &Gtk::true;
1096               });
1097 }
1098
1099 sub store_current_reference
1100 {
1101     if ((defined($seq[$current])) && ($seq[$current]->annotation->each_Reference))
1102     {
1103         (($seq[$current]->annotation->each_Reference)[$current_ref])->
1104             title($ref_entry[0]->get_chars(0,-1) );
1105         (($seq[$current]->annotation->each_Reference)[$current_ref])->
1106             authors($ref_entry[1]->get_chars(0,-1) );
1107         (($seq[$current]->annotation->each_Reference)[$current_ref])->
1108             comment($ref_entry[2]->get_chars(0,-1) );
1109         (($seq[$current]->annotation->each_Reference)[$current_ref])->
1110             location($ref_entry[3]->get_chars(0,-1) );
1111         (($seq[$current]->annotation->each_Reference)[$current_ref])->
1112             medline($ref_entry[4]->get_chars(0,-1) );
1113 #       (($seq[$current]->annotation->each_Reference)[$current_ref])->
1114 #           start($ref_entry[5]->get_chars(0,-1) );
1115         (($seq[$current]->annotation->each_Reference)[$current_ref])->
1116             rp($ref_entry[5]->get_chars(0,-1) );
1117     }
1118 }
1119
1120 sub update_reference_window
1121 {
1122     my ($show_me) = @_;
1123     $ref_window->show_all() if (defined($show_me));
1124
1125     $ref_clist->freeze();
1126     if (!defined($seq[$current]))
1127     {
1128         $ref_clist->clear();
1129         $ref_clist->thaw();
1130         foreach (@ref_entry) { $_->set_text(""); }
1131         return;
1132     }
1133     my @refs = $seq[$current]->annotation->each_Reference;
1134     # reset clist if rows are different to references
1135     if ($ref_clist->rows != @refs) {
1136         $ref_clist->clear();
1137         foreach (@refs) { $ref_clist->append("","",""); }
1138     }
1139     # redraw references
1140     for(my $i=0;$i<@refs;$i++)
1141     {
1142         $ref_clist->set_text($i,0,$refs[$i]->medline)
1143           if ($refs[$i]->medline);
1144         $ref_clist->set_text($i,1,$refs[$i]->title)
1145           if ($refs[$i]->title);
1146         $ref_clist->set_text($i,2,$refs[$i]->authors)
1147           if ($refs[$i]->authors);
1148     }
1149     # redraw text widgets
1150     foreach (@ref_entry) { $_->set_text(""); }
1151     if (@refs) {
1152         $ref_entry[0]->set_text($refs[$current_ref]->title);
1153         $ref_entry[1]->set_text($refs[$current_ref]->authors);
1154         $ref_entry[2]->set_text($refs[$current_ref]->comment);
1155         $ref_entry[3]->set_text($refs[$current_ref]->location);
1156         $ref_entry[4]->set_text($refs[$current_ref]->medline);
1157 #       $ref_entry[5]->set_text($refs[$current_ref]->start);
1158         $ref_entry[5]->set_text($refs[$current_ref]->rp);
1159     }
1160
1161     $ref_clist->moveto($current_ref,0,0.3,0.0)
1162         if ($ref_clist->row_is_visible($current_ref) ne 'full');
1163     $ref_clist->signal_handler_block($ref_handler_id);
1164     $ref_clist->select_row($current_ref,0);
1165     $ref_clist->signal_handler_unblock($ref_handler_id);
1166     Gtk::CList::set_focus_row($ref_clist,$current_ref);
1167     $ref_clist->thaw();
1168 }
1169
1170
1171 sub init_about_dialog {
1172         my ($window,$bg,$tbox,$vbox,$hbox,$sep,$butbox,$button,$pixmap);
1173         $about_dialog = new Gtk::Window("dialog");
1174         $about_dialog->set_title("About gSequence");
1175         $about_dialog->signal_connect_after("destroy" =>
1176                                             sub { $about_dialog->hide;
1177                                                   return &Gtk::true; });
1178         $about_dialog->set_default_size('350','350');
1179         $about_dialog->set_policy(1,1,0);
1180         $window = $about_dialog->window;
1181         $bg = $about_dialog->style->bg('normal');
1182         $vbox= new Gtk::VBox(0,0);
1183         $about_dialog->add($vbox);
1184         $tbox = new Gtk::Label("\ngSequence\nAuthor: Lorenz Pollak\n\n
1185 gSequence is cool! :-)\n(this text is to be written...)
1186 \n");
1187         $vbox->pack_start($tbox,1,1,1);
1188
1189         $hbox = new Gtk::HBox(0,0);
1190         $vbox->pack_start($hbox,0,0,0);
1191         $sep = new Gtk::HSeparator;
1192         $sep->set_usize(-1,5);
1193         $vbox->pack_start($sep,0,1,0);
1194
1195         $butbox = new Gtk::HButtonBox;
1196         $butbox->set_usize(-1,32);
1197         $vbox->pack_start($butbox, 0,1,0);
1198         $button = new_with_label Gtk::Button("OK");
1199         $button->set_usize(50,-1);
1200         $button->signal_connect('clicked', sub { $about_dialog->hide; });
1201         $button->can_default(1);
1202         $button->grab_default;
1203         $butbox->add($button);
1204
1205   return 1;
1206 }
1207
1208 sub init_feature_window
1209 {
1210     $current_feature_item = 0;
1211
1212     $feature_window = new Gtk::Dialog();
1213     $feature_window->set_default_size(500,400);
1214     $feature_window->set_policy($true,$true,$false);
1215     $feature_window->set_title("Sequence Features");
1216     $feature_window->border_width(5);
1217
1218     my $pane = new Gtk::HPaned();
1219     $feature_window->vbox->pack_start( $pane, $true, $true, 0);
1220     $pane->set_handle_size( 10 );
1221     $pane->set_gutter_size( 8 );
1222
1223     # Create a VBox for the Entry and Tree Scrolled Window
1224     my $vbox = new Gtk::VBox( $false, 0 );
1225     $pane->add1( $vbox );
1226
1227     # Create a ScrolledWindow for the tree
1228     my $tree_scrolled_win = new Gtk::ScrolledWindow( undef, undef );
1229     $tree_scrolled_win->set_usize( 150, 400 );
1230     $vbox->pack_start( $tree_scrolled_win, $true, $true, 0 );
1231     $tree_scrolled_win->set_policy( 'automatic', 'automatic' );
1232
1233     #my $list_scrolled_win = new Gtk::ScrolledWindow( undef, undef );
1234     #$list_scrolled_win->set_policy( 'automatic', 'automatic' );
1235     $vbox = new Gtk::VBox( $false, 0 );
1236     $pane->add2( $vbox );
1237
1238     # add stuff to the vbox
1239     # text entries
1240     my $hbox = new Gtk::HBox( $true, 10 );
1241
1242     $feature_entry[0] = new Gtk::Entry();
1243     my $frame = new Gtk::Frame("Primary Tag");
1244     $frame->add($feature_entry[0]);
1245     $hbox->pack_start( $frame, $true, $true, 0);
1246
1247     $feature_entry[1] = new Gtk::Entry();
1248     $frame = new Gtk::Frame("Source Tag");
1249     $frame->add($feature_entry[1]);
1250     $hbox->pack_end( $frame, $true, $true, 0);
1251
1252     $vbox->pack_start( $hbox, $false, $false, 5);
1253
1254     $hbox = new Gtk::HBox( $true, 10 );
1255
1256     my $adj = new Gtk::Adjustment( 0, 0, 0, 0, 0, 0 );
1257     $feature_spinner[0] = new Gtk::SpinButton( $adj, 0.0, 0 );
1258     $feature_spinner[0]->signal_connect( "changed", \&select_feature_region);
1259     $frame = new Gtk::Frame("Start");
1260     $frame->add($feature_spinner[0]);
1261     $hbox->pack_start( $frame, $true, $true, 0);
1262
1263     $adj = new Gtk::Adjustment( 0, 0, 0, 0, 0, 0 );
1264     $feature_spinner[1] = new Gtk::SpinButton( $adj, 0.0, 0 );
1265     $feature_spinner[1]->signal_connect( "changed", \&select_feature_region);
1266     $frame = new Gtk::Frame("End");
1267     $frame->add($feature_spinner[1]);
1268     $hbox->pack_start( $frame, $true, $true, 0);
1269
1270     $frame = new Gtk::Frame("Strand");
1271     $hbox->pack_start( $frame, $true, $true, 0);
1272     $frame = new Gtk::Frame("Score");
1273     $hbox->pack_start( $frame, $true, $true, 0);
1274
1275     $vbox->pack_start( $hbox, $false, $false, 5);
1276
1277     $feature_entry[2] = new Gtk::Entry();
1278     $frame = new Gtk::Frame("Description");
1279     $frame->add($feature_entry[2]);
1280
1281     $vbox->pack_start( $frame, $false, $false, 5);
1282
1283     my $bbox = new Gtk::HBox( $false, 5 );
1284     $bbox->border_width(10);
1285     my $button = new Gtk::Button("Add");
1286     $bbox->pack_start( $button, $false, $false, 0);
1287     $button->signal_connect( "clicked",
1288            # add comment button handler
1289            sub { return if (!defined($seq[$current]));
1290                  &store_current_feature if ($current_feature_item);
1291                  my $feature = new Bio::SeqFeature::Generic;
1292                  $feature->primary_tag("<New>");
1293                  $seq[$current]->add_SeqFeature( $feature );
1294                  my $item_new = new_with_label Gtk::TreeItem( "<New>" );
1295                  $item_new->set_user_data( $feature );
1296                  $item_new->signal_connect( 'select', \&select_feature_item );
1297                  $current_feature_item->parent->append( $item_new )
1298                      if ($current_feature_item);
1299                  $feature_tree->append( $item_new ) if (!$current_feature_item);
1300                  $item_new->show();
1301                  $current_feature_item->deselect()
1302                      if ($current_feature_item);
1303                  $item_new->select();
1304                } );
1305     $button = new Gtk::Button("Add Subfeature");
1306     $bbox->pack_start( $button, $false, $false, 0);
1307     $button->signal_connect( "clicked",
1308            # add comment button handler
1309            sub { return if (!defined($seq[$current])||!$current_feature_item);
1310                  &store_current_feature;
1311                  my $feature = new Bio::SeqFeature::Generic;
1312                  $feature->primary_tag("<New>");
1313                  $feature->start($current_feature_item->get_user_data->start);
1314                  $feature->end($current_feature_item->get_user_data->end);
1315                  $current_feature_item->get_user_data->add_sub_SeqFeature( $feature );
1316                  my $new_subtree = new Gtk::Tree();
1317                  $current_feature_item->set_subtree( $new_subtree );
1318                  my $item_new = new_with_label Gtk::TreeItem( "<New>" );
1319                  $item_new->set_user_data( $feature );
1320                  $item_new->signal_connect( 'select', \&select_feature_item );
1321                  $new_subtree->append( $item_new );
1322                  $item_new->show();
1323                  $current_feature_item->deselect();
1324                  $current_feature_item->expand();
1325                  $item_new->select();
1326                } );
1327      $button = new Gtk::Button("Delete");
1328      $bbox->pack_start( $button, $false, $false, 0);
1329      $button->signal_connect( "clicked",
1330            # delete comment button handler
1331            sub { return if (!$current_feature_item);
1332                  &store_current_feature;
1333                  my $flist = $seq[$current]->{_as_feat};
1334                  my $pos;
1335                  for(my $i=0;$i<@$flist;$i++) {
1336                    $pos=$i if $$flist[$i]==$current_feature_item->get_user_data();
1337                  }
1338                  splice @$flist, $pos, 1;
1339                  $seq[$current]->{_as_feat} = $flist;
1340                  $current_feature_item->parent->remove_item($current_feature_item);
1341                  $current_feature_item=0;
1342                } );
1343
1344      $vbox->pack_end( $bbox, $false, $false, 0);
1345
1346     # Create root tree
1347     $feature_tree = new Gtk::Tree();
1348     $tree_scrolled_win->add_with_viewport( $feature_tree );
1349     $feature_tree->set_selection_mode( 'single' );
1350     $feature_tree->set_view_mode( 'item' );
1351
1352     $bbox = new Gtk::HButtonBox();
1353     $bbox->set_layout("end");
1354
1355     $button = new Gtk::Button( "Close" );
1356     $bbox->add( $button );
1357     $button->signal_connect("clicked",
1358                             # close button handler
1359                             sub{ $feature_window->hide();
1360                                  &store_current_feature;
1361                              });
1362
1363     $feature_window->action_area->pack_start( $bbox, $true, $true, 0 );
1364     $feature_window->signal_connect_after( "delete_event",
1365                                            # window delete handler
1366                                            sub{ $feature_window->hide();
1367                                                 &store_current_feature;
1368                                                 return &Gtk::true;
1369                                             });
1370 }
1371
1372 # Callback for expanding tree
1373 sub expand_feature_tree
1374   {
1375     my ( $item, $subtree ) = @_;
1376     my ($feature,$subfeature,$item_new,$new_subtree);
1377     $feature = $item->get_user_data();
1378
1379     foreach $subfeature ($feature->sub_SeqFeature)
1380       {
1381           $item_new = new_with_label Gtk::TreeItem( $subfeature->primary_tag );
1382           $item_new->set_user_data( $subfeature );
1383           $item_new->signal_connect( 'select', \&select_feature_item );
1384           $subtree->append( $item_new );
1385           $item_new->show();
1386
1387           if ( $subfeature->sub_SeqFeature )
1388           {
1389               $new_subtree = new Gtk::Tree();
1390               $item_new->set_subtree( $new_subtree );
1391               $item_new->signal_connect( 'expand',
1392                                          \&expand_feature_tree,
1393                                          $new_subtree );
1394               $item_new->signal_connect( 'collapse', \&collapse_feature_tree );
1395           }
1396           $item_new->expand();
1397       }
1398   }
1399
1400
1401 # Callback for collapsing tree
1402 sub collapse_feature_tree
1403   {
1404     my ( $item ) = @_;
1405
1406     my $subtree = new Gtk::Tree();
1407
1408     $item->remove_subtree();
1409     $item->set_subtree( $subtree );
1410     $item->signal_connect( 'expand', \&expand_feature_tree, $subtree );
1411   }
1412
1413
1414 sub store_current_feature
1415 {
1416   if ((defined($seq[$current])) && ($seq[$current]->top_SeqFeatures) && ($current_feature_item))
1417   {
1418     my $current_feature = $current_feature_item->get_user_data();
1419     $current_feature->primary_tag( $feature_entry[0]->get_chars(0,-1) );
1420     $current_feature->source_tag( $feature_entry[1]->get_chars(0,-1) );
1421     if ($current_feature->has_tag("description"))
1422     {
1423       $current_feature->remove_tag("description");
1424       $current_feature->add_tag_value("description",
1425                                       $feature_entry[2]->get_chars(0,-1));
1426     }
1427     $current_feature->start($feature_spinner[0]->get_value_as_int());
1428     $current_feature->end($feature_spinner[1]->get_value_as_int());
1429     # set tree item
1430     ($current_feature_item->children)[0]->set($current_feature->primary_tag);
1431   }
1432 }
1433
1434 sub select_feature_item
1435 {
1436     my ($widget) = @_;
1437     &store_current_feature;
1438     $current_feature_item->deselect()
1439       if $current_feature_item;
1440     $current_feature_item = $widget;
1441     &update_feature_paned2;
1442 }
1443
1444 sub update_feature_paned2
1445 {
1446   $feature_entry[0]->set_text("");
1447   $feature_entry[1]->set_text("");
1448   $feature_entry[2]->set_text("");
1449
1450   return if (!defined($seq[$current])||(!$current_feature_item));
1451   my $current_feature = $current_feature_item->get_user_data();
1452   $feature_entry[0]->set_text($current_feature->primary_tag);
1453   $feature_entry[1]->set_text($current_feature->source_tag)
1454     if (defined($current_feature->source_tag));
1455   $feature_entry[2]->set_text(($current_feature->each_tag_value("description"))[0])
1456     if ($current_feature->has_tag("description"));
1457   my $adj = new Gtk::Adjustment($current_feature->start,
1458                                 0,
1459                                 $seq[$current]->length-1,
1460                                 1,
1461                                 1,
1462                                 0
1463                                );
1464   $feature_spinner[0]->set_adjustment($adj);
1465   $feature_spinner[0]->set_value($current_feature->start);
1466   $feature_spinner[0]->show_all();
1467   $adj = new Gtk::Adjustment($current_feature->end,
1468                              0,
1469                              $seq[$current]->length-1,
1470                              1,
1471                              1,
1472                              0
1473                             );
1474   $feature_spinner[1]->set_adjustment($adj);
1475   $feature_spinner[1]->set_value($current_feature->end);
1476   $feature_spinner[1]->show_all();
1477 }
1478
1479 sub select_feature_region
1480 {
1481   $seq_edit[$current]->freeze;
1482   $seq_edit[$current]->select_region($feature_spinner[0]->get_value_as_int(),
1483                            $feature_spinner[1]->get_value_as_int()+1);
1484   $seq_edit[$current]->thaw;
1485 }
1486
1487 sub update_feature_window
1488 {
1489     my ($show_me) = @_;
1490     $feature_window->show_all() if (defined($show_me));
1491
1492     $feature_tree->clear_items(0,-1);
1493     if (!defined($seq[$current]))
1494     {
1495         &update_feature_paned2;
1496         return;
1497     }
1498
1499     my ($item_new,$new_subtree);
1500     foreach ($seq[$current]->top_SeqFeatures)
1501       {
1502           $item_new = new_with_label Gtk::TreeItem( $_->primary_tag );
1503           $item_new->set_user_data( $_ );
1504           $item_new->signal_connect( 'select', \&select_feature_item );
1505           $feature_tree->append( $item_new );
1506           if ( $_->sub_SeqFeature )
1507           {
1508               $new_subtree = new Gtk::Tree();
1509               $item_new->set_subtree( $new_subtree );
1510               $item_new->signal_connect( 'expand',
1511                                          \&expand_feature_tree,
1512                                          $new_subtree );
1513               $item_new->signal_connect( 'collapse', \&collapse_feature_tree );
1514           }
1515           $item_new->expand();
1516       }
1517     $feature_tree->select_item($current_feature_item)
1518       if $current_feature_item;
1519     $feature_tree->show_all();
1520
1521     &update_feature_paned2;
1522 }
1523
1524 sub store_prefs
1525 {
1526 }
1527
1528 sub update_pref_window
1529 {
1530   $pref_window->show_all();
1531 }
1532
1533 sub init_pref_window
1534 {
1535   $pref_window = new Gtk::Dialog();
1536   $pref_window->set_default_size(500,400);
1537   $pref_window->set_policy($true,$true,$false);
1538   $pref_window->border_width( 5 );
1539
1540   # Create a new notebook, place the position of the tabs
1541   my $notebook = new Gtk::Notebook();
1542   $pref_window->vbox->pack_start( $notebook, $true, $true, 0);
1543   $notebook->set_tab_pos( 'top' );
1544
1545   my $main_vbox = new Gtk::VBox($false,10);
1546
1547   my $label = new Gtk::Label( "Import Options" );
1548   my $frame = new Gtk::Frame("Flat File Indexes");
1549   my $vbox = new Gtk::VBox($false,10);
1550   $frame->add($vbox);
1551   $main_vbox->pack_start($frame,$false,$false,10);
1552
1553   $notebook->append_page( $main_vbox, $label );
1554
1555   my $hbox = new Gtk::HBox($false,0);
1556
1557   $pref_entry[0] = new Gtk::Entry();
1558   $frame = new Gtk::Frame("Indexes Directory");
1559   $frame->add($pref_entry[0]);
1560   $hbox->pack_start( $frame, $true, $false, 0);
1561
1562   $pref_entry[1] = new Gtk::Entry();
1563   $frame = new Gtk::Frame("Index Type");
1564   $frame->add($pref_entry[1]);
1565   $hbox->pack_start( $frame, $false, $false, 0);
1566
1567   $vbox->pack_start( $hbox, $false, $false, 0);
1568
1569   $pref_entry[2] = new Gtk::Entry();
1570   $frame = new Gtk::Frame("Fasta Index Name");
1571   $frame->add($pref_entry[2]);
1572   $vbox->pack_start( $frame, $false, $false, 0);
1573
1574   $pref_entry[3] = new Gtk::Entry();
1575   $frame = new Gtk::Frame("SwissProt Index Name");
1576   $frame->add($pref_entry[3]);
1577   $vbox->pack_start( $frame, $false, $false, 0);
1578
1579   $pref_entry[4] = new Gtk::Entry();
1580   $frame = new Gtk::Frame("SwissPfam Index Name");
1581   $frame->add($pref_entry[4]);
1582   $vbox->pack_start( $frame, $false, $false, 0);
1583
1584   $frame = new Gtk::Frame("Remote DBs");
1585   $hbox = new Gtk::HBox($false,10);
1586   $frame->add($hbox);
1587   $main_vbox->pack_start($frame,$false,$false,10);
1588
1589   $pref_entry[5] = new Gtk::Entry();
1590   $frame = new Gtk::Frame("AceDB host");
1591   $frame->add($pref_entry[5]);
1592   $hbox->pack_start( $frame, $true, $false, 0);
1593
1594   $pref_entry[6] = new Gtk::Entry();
1595   $frame = new Gtk::Frame("AceDB port");
1596   $frame->add($pref_entry[6]);
1597   $hbox->pack_start( $frame, $false, $false, 0);
1598
1599   $notebook->set_page( 0 );
1600
1601   my $bbox = new Gtk::HButtonBox();
1602   $bbox->set_layout("end");
1603
1604   my $button = new Gtk::Button( "Save" );
1605   $bbox->add( $button );
1606   $button->signal_connect("clicked",
1607                           # close button handler
1608                           sub{ $pref_window->hide();
1609                                &store_prefs();
1610                              });
1611
1612   $button = new Gtk::Button( "Close" );
1613   $bbox->add( $button );
1614   $button->signal_connect("clicked",
1615                           # close button handler
1616                           sub{ $pref_window->hide();
1617                              });
1618
1619   $pref_window->action_area->pack_start( $bbox, $true, $true, 0 );
1620   $pref_window->signal_connect_after( "delete_event",
1621                                          # window delete handler
1622                                          sub{ $pref_window->hide();
1623                                               return &Gtk::true;
1624                                             });
1625 }