view release on metacpan or  search on metacpan

ccc/IR.pm  view on Meta::CPAN

    $self->show_inheritance($entry->name(), $entry);
  }
}

#--------------------------------------------------------------------
# Prepare widgets, internal data, start timeout handler
# In: $root_ir   - IRRoot
#     $topwindow - toplevel widget
#     $sline     - status line widget
#     $bg_sched  - background processing scheduler
#     $menu       - main menu object
#--------------------------------------------------------------------
sub init_browser {
  my ($self, $root_ir, $topwindow, $sline, $bg_sched, $menu) = @_;
  
  # Determine MICO version
  my $ai = $root_ir->entry_by_id('IDL:omg.org/CORBA/AbstractInterfaceDef:1.0');
  my $is_235 = not $ai;

  # Vertical box: pane
  my $vbox = new Gtk2::VBox;

  # Menu
  my $menu_id = "IR_$serial"; ++$serial;
  $menu->add_item($menu_id, $menu_item_IDL,
                            undef, \&show_IDL_cb, $self);
  $menu->add_item($menu_id, $menu_item_iheritance,
                            undef, \&show_inheritance_cb, $self);
  $menu->add_item($menu_id, $menu_item_DIA,
                            undef, \&export_to_DIA_cb, $self);
  $menu->add_item($menu_id, $menu_item_search,
                            '<control>F', \&search_cb, [$self, 0]);
  $menu->add_item($menu_id, $menu_item_search_re,
                            '<control>R', \&search_cb, [$self, 1]);
  $menu->add_item($menu_id, $menu_item_expand_all,
                            undef, \&expand_all_cb, $self);
  # Create paned window: left-tree, right-text
  my $paned = new Gtk2::HPaned;
  $vbox->pack_start($paned, 1, 1, 0);
  $vbox->show_all();

  # Create scrolled window for CTree
  my $scrolled = new Gtk2::ScrolledWindow(undef,undef);
  $scrolled->set_policy( 'automatic', 'automatic' );
  $paned->add($scrolled);

  # Create ctree widget (use Gtk2::TreeView instead of Gtk::CTree)
  my $model = Gtk2::TreeStore->new('Glib::String', 'Glib::Scalar');
  my $ctree = Gtk2::TreeView->new;
  $ctree->set_model($model);
  my $selection = $ctree->get_selection;
  $selection->set_mode ('browse');
  my $cell = Gtk2::CellRendererText->new;
  my $column = Gtk2::TreeViewColumn->new_with_attributes('',
                              $cell, 'text' => TREE_TITLE_COLUMN);
  $ctree->append_column($column);
  # disable incremental search
  $ctree->set_enable_search(0);
  # search by regexp
  $ctree->set_search_equal_func(\&CORBA::MICO::Misc::ctree_std_search, $self);
  # and use popup search via CTRL_F/CTRL_R
  #$ctree->signal_connect(
  #               key_press_event => \&CORBA::MICO::Misc::ctree_kpress, $self);

  $scrolled->add($ctree);

  # Create text window for IDL-representation of selected items
  my $hptext = CORBA::MICO::Hypertext::hypertext_create(1);
  $paned->add2($hptext);

  $paned->set_position(200);
  $scrolled->show();
  $ctree->show();
  $paned->show();
  $bg_sched->add_entry($self);
  $ctree->signal_connect('destroy',
                     sub { $self->close();$bg_sched->remove_entry($self); 1; });
  $selection->signal_connect(changed => \&row_selected, $self);
  $ctree->signal_connect(row_expanded => \&row_expanded, $self);
  $ctree->signal_connect(row_activated => \&row_activated, $self);

  $self->{'TOPWINDOW'} = $topwindow;    # toplevel window
  $self->{'SLINE'}     = $sline;        # status line
  $self->{'TEXT'}      = $hptext;       # hypertext text widget
  $self->{'MENU'}      = $menu;         # global menu
  $self->{'NOIDL'}     = 0;             # global menu
  $self->{'ID'}        = $menu_id;      # unique ID (for menu items)
  $self->{'ROOT'}      = $root_ir;      # IRRoot
  $self->{'CTREE'}     = $ctree;        # CTree widget
  $self->{'NODE'}      = undef;         # current (selected) row 
  $self->{'MODEL'}     = $model;        # tree model
  $self->{'WIDGET'}    = $vbox;         # main window
  $self->{'VER_2_3_5'} = $is_235;       # MICO version 2.3.5 or lower
  $self->{'IR_ITEMS'}  = {};            # hash -> IR object name => IR object
  $self->{'BG_QUEUE'}  = [];            # queue for background processing
  $self->{'BG_UPPER'}  = [              # top items of CTree (for background
      ['Modules',    'dk_Module'],      # processing): [name, type1, type2,...]
      ['Interfaces', 'dk_Interface'],
      ['Values',     'dk_Value'],
      ['Types',      'dk_Struct', 'dk_Union', 'dk_Enum', 'dk_Alias',
                     'dk_String', 'dk_Wstring', 'dk_Fixed',
                     'dk_Sequence', 'dk_Array', 
                     'dk_Typedef', 'dk_Primitive', 'dk_Native', 
                     'dk_Attribute', 'dk_ValueMember'],
      ['Constants',  'dk_Constant']
  ];
}                         

#--------------------------------------------------------------------
# get value of 'any' (translate boolean values to string representation)
#--------------------------------------------------------------------
sub any_value {
  my $any = shift;
  my $kind = tc_unalias($any->type());
  my $retval = $any->value();
  if( $kind eq "tk_boolean" ) {
    $retval = $retval ? "TRUE" : "FALSE";
  }
  elsif ( $kind eq "tk_string" ) {
    $retval = qq("$retval");
  }