CORBA-MICO
view release on metacpan or search on metacpan
2006-11-24 09:29 Pavel Rousnak <rousnak@users.sourceforge.net>
* ccc/Makefile.PL: Gtk -> Gtk2
2006-11-24 09:09 Pavel Rousnak <rousnak@users.sourceforge.net>
* ccc/Hypertext.pm: Hypertext: search implemented
2006-11-23 15:11 Pavel Rousnak <rousnak@users.sourceforge.net>
* ccc/: BGQueue.pm, CMenu.pm, Hypertext.pm, IR.pm, IR2Dia.pm,
Misc.pm, NC.pm, NCEntry.pm, Pixtree.pm, ccc: Porting to Gtk2
2006-11-17 09:03 Nikolay Logvinov <logvinon@mail.ru>
* types.cc: Fixed marshaling of octet sequence, converts sv to byte
representation first if necessary before lengthing it. Thanks to
Michael Sanders <mike.sanders@greenbay.usa.com>
2006-11-16 10:39 Nikolay Logvinov <logvinon@mail.ru>
* dispatcher.cc, errors.cc, gtkmico.h, server.cc: compiler
complainigs
2001-10-10 13:10 Pavel Rousnak <rousnak@users.sourceforge.net>
* ccc/: IR.pm, NC.pm, ccc: Name Service browser: IDL representation
of object's interfaces
2001-10-10 08:48 Pavel Rousnak <rousnak@users.sourceforge.net>
* ccc/: CMenu.pm, IR.pm, IRRoot.pm, Misc.pm, NC.pm, README, ccc:
Global menu object Global queue for background processing
2001-10-09 14:13 Nikolay Logvinov <logvinon@mail.ru>
* developers: new developer - Arun Kumar U
2001-10-09 14:10 Nikolay Logvinov <logvinon@mail.ru>
* MANIFEST, client-activate: try to forget about BOA
shlib/Makefile
shlib/hello
shlib/hello.idl
shlib/perl-client
shlib/server.cc
start-servers.sh
tictactoe
typemap
types.cc
ccc/BGQueue.pm
ccc/CMenu.pm
ccc/Hypertext.pm
ccc/IR.pm
ccc/IR2Dia.pm
ccc/IREntry.pm
ccc/IRRoot.pm
ccc/Makefile.PL
ccc/Misc.pm
ccc/NC.pm
ccc/NCEntry.pm
ccc/NCRoot.pm
ccc/CMenu.pm view on Meta::CPAN
package CORBA::MICO::CMenu;
use vars qw($serial);
use Carp;
use vars qw($DEBUG);
#$DEBUG=1;
#--------------------------------------------------------------------
# Dynamic menu. Supports a single menu for several
# objects. Each time an object becomes active
# CMenu automatically rebuilds menu so as it becomes appropriate
# for active object.
#--------------------------------------------------------------------
use Gtk2 '1.140';
#--------------------------------------------------------------------
# Create new menu
# In: $topwindow - toplevel widget
#--------------------------------------------------------------------
sub new {
my ($type, $topwindow) = @_;
my $class = ref($type) || $type;
my $accel_group = new Gtk2::AccelGroup;
my $menu_name = "<menu_$serial>";
++$serial;
my $item_factory = new Gtk2::ItemFactory('Gtk2::MenuBar',
$menu_name, $accel_group);
#$accel_group->attach($topwindow);
$topwindow->add_accel_group($accel_group);
my $main_widget = $item_factory->get_widget($menu_name);
my $self = { 'FACTORY' => $item_factory,
'NAME' => $menu_name,
'ACCEL_GROUP' => $accel_group,
'LAST_ACTION' => 0,
'CURR_ID' => '',
ccc/CMenu.pm view on Meta::CPAN
return;
}
return if exists $item->{''}; # do not mask field if it is global
my $widget = $item_factory->get_widget_by_action($item->{'ACTION'});
if( defined($widget) ) {
$widget->set_sensitive($flag);
}
}
#--------------------------------------------------------------------
# Menu callback: item activated
#--------------------------------------------------------------------
sub item_activated_cb {
my ($selfptr, @args) = @_;
warn "item_activated_cb" if $DEBUG;
if( defined($$selfptr) ) {
$$selfptr->item_activated(@args);
}
}
sub item_activated {
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,
my $ir_node = $ud->[0];
return unless defined $ir_node;
my $name = $ir_node->name();
$self->{'IR_ITEMS'}->{$name} = $ir_node;
return if $curs_watch and CORBA::MICO::Misc::cursor_watch($topwindow, 1);
&{$callback}($self, $name, $ir_node, @cb_parms);
$curs_watch and CORBA::MICO::Misc::cursor_restore_to_default($topwindow, 0);
}
#--------------------------------------------------------------------
# Menu item activated: show IDL
#--------------------------------------------------------------------
sub show_IDL_cb {
my $self = shift;
$self->call_menu_callback(
1, # cursor watch
sub { # show IDL
my ($self, $name) = @_;
$self->show_IDL($name);
}
);
}
#--------------------------------------------------------------------
# Menu item activated: show tree of inheritance
#--------------------------------------------------------------------
sub show_inheritance_cb {
my $self = shift;
$self->call_menu_callback(
1, # cursor watch
sub { # show inheritance
my ($self, $name, $ir_node) = @_;
$self->show_inheritance($name, $ir_node);
}
);
}
#--------------------------------------------------------------------
# Menu item activated: export tree of inheritance to DIA
#--------------------------------------------------------------------
sub export_to_DIA_cb {
my $self = shift;
$self->call_menu_callback(
0, # no cursor watch
sub { # export tree of inheritance to DIA
my ($self, $name, $ir_node) = @_;
$self->export_to_DIA($name, $ir_node);
}
);
}
#--------------------------------------------------------------------
# Menu item activated: expand all
#--------------------------------------------------------------------
sub expand_all_cb {
my $self = shift;
$self->{CTREE}->expand_all();
}
#--------------------------------------------------------------------
# Menu item activated: find/find regexp
#--------------------------------------------------------------------
sub search_cb {
my $ud = shift;
my ($self, $is_regexp) = @$ud;
$self->{REGEXP} = $is_regexp;
if( $self->{CTREE}->has_focus() ) {
$self->{CTREE}->signal_emit('start_interactive_search');
}
else {
# $sline - status line widget
# $bg_sched - background processing scheduler
# $menu - main menu object
#--------------------------------------------------------------------
sub init_browser {
my ($self, $orb,
$root_nc, $ir_browser, $topwindow, $sline, $bg_sched, $menu) = @_;
# Main vertical box: pane
my $vbox = new Gtk2::VBox;
# Menu
my $menu_id = "NC_$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);
# Paned window: left-tree, right-text
my $paned = new Gtk2::HPaned;
TREE_UDATA_COLUMN);
my $nc_node = $ud->[0];
return unless defined $nc_node;
my $name = $nc_node->name();
return if $curs_watch and CORBA::MICO::Misc::cursor_watch($topwindow, 1);
&{$callback}($self, $name, $nc_node, @cb_parms);
$curs_watch and CORBA::MICO::Misc::cursor_restore_to_default($topwindow, 0);
}
#--------------------------------------------------------------------
# Menu item activated: show IDL
#--------------------------------------------------------------------
sub show_IDL_cb {
my $self = shift;
$self->call_menu_callback(
1, # cursor watch
sub { # show IDL
my ($self, $name, $nc_node) = @_;
my $repoid = $nc_node->nc_node()->_repoid();
print "REF: ", ref($nc_node->nc_node()), "\n";
#my $iface = $nc_node->nc_node()->_get_interface();
status_line_write($self->{'SLINE'}, "** Can't get repoid **");
sleep(1);
return;
}
$self->{'IR_BROWSER'}->show_IDL_by_id($repoid, $self->{'TEXT'});
}
);
}
#--------------------------------------------------------------------
# Menu item activated: show tree of inheritance
#--------------------------------------------------------------------
sub show_inheritance_cb {
my $self = shift;
$self->call_menu_callback(
1, # cursor watch
sub { # show inheritance
my ($self, $name, $nc_node) = @_;
my $repoid = $nc_node->nc_node()->_repoid();
$self->{'IR_BROWSER'}->show_inheritance_by_id($repoid,
$self->{'TEXT'});
}
);
}
#--------------------------------------------------------------------
# Menu item activated: export tree of inheritance to DIA
#--------------------------------------------------------------------
sub export_to_DIA_cb {
my $self = shift;
$self->call_menu_callback(
0, # no cursor watch
sub { # export tree of inheritance to DIA
my ($self, $name, $nc_node) = @_;
my $repoid = $nc_node->nc_node()->_repoid();
$self->{'IR_BROWSER'}->export_to_DIA_by_id($repoid,
$self->{'TEXT'});
#use CORBA::MICO ids => [ 'IDL:omg.org/CORBA:1.0' => undef ];
use CORBA::MICO;
use CORBA::MICO::IRRoot;
use CORBA::MICO::NCRoot;
use CORBA::MICO::Misc qw(status_line_create);
use CORBA::MICO::IR;
use CORBA::MICO::NC;
use CORBA::MICO::BGQueue;
use CORBA::MICO::CMenu;
use strict;
#--------------------------------------------------------------------
# Global variables
#--------------------------------------------------------------------
my $skip_names='(CORBA[:\/])';
$skip_names = '';
my $bg_sched; # scheduler for background processing
# Create toplevel window
$topwindow = new Gtk2::Window('toplevel');
$topwindow->set_title('Corba Control Center: Interface repository');
$topwindow->realize();
# create status line
my $status_line = status_line_create();
# create menu
my $menu = new CORBA::MICO::CMenu($topwindow);
$menu->add_item('', '/File/_Quit', '<control>Q', sub { Gtk2->main_quit(); });
# Initialize MICO, get IR
#push (@ARGV, '-ORBIfaceRepoAddr', 'inet:127.0.0.1:8888');
#push (@ARGV, '-ORBConfFile', '/home/pr/.micorc');
#$ENV{MICORC} = '/home/pr/.micorc';
my $orb = CORBA::ORB_init("mico-local-orb");
my $root_poa = $orb->resolve_initial_references("RootPOA");
my $root_ir = $orb->resolve_initial_references("InterfaceRepository");
my $irref = $orb->object_to_string($root_ir);
( run in 0.677 second using v1.01-cache-2.11-cpan-49f99fa48dc )