CORBA-MICO
view release on metacpan or search on metacpan
ccc/Hypertext.pm view on Meta::CPAN
#--------------------------------------------------------------------
# Create a 'hypertext' object
#--------------------------------------------------------------------
sub hypertext_create {
my $scrolled = new Gtk2::ScrolledWindow(undef,undef); # scrolled for main text
$scrolled->set_policy( 'automatic', 'automatic' );
my $text = Gtk2::TextView->new;
$text->set_wrap_mode ('none');
$text->set_editable(0);
$text->set_cursor_visible(0);
$scrolled->add($text);
my $retval = new Gtk2::VPaned;
$retval->pack1($scrolled, 1, 0);
$retval->set_size_request(600, 400);
$retval->show_all();
return $retval;
}
#--------------------------------------------------------------------
# Show IDL-representation of given IR object via hypertext widget
ccc/Hypertext.pm view on Meta::CPAN
my $cbdata = { NAME => $name,
CALLBACK => $prepare_cb,
UDATA => $udata,
PARENTS => $parents,
WPARENT => $htext,
PREPOST => $prepost_cb,
SRCHDATA => {},
CURSOR_HAND => undef };
#$htext->show_all();
$prepost_cb->($udata, 1);
CORBA::MICO::Misc::cursor_watch($htext, 0);
$text->get_window('text')->set_cursor(Gtk2::Gdk::Cursor->new('watch'));
$htext->queue_draw();
return if CORBA::MICO::Misc::process_pending();
my $desc = $prepare_cb->($name, $udata);
my $iter = $buffer->get_iter_at_offset(0);
if( defined($desc) ) {
my $cnt = 0;
foreach my $line (@$desc) {
my @parts = split(item_suffix, $line);
foreach my $portion (@parts) {
my @regions = split(item_prefix, $portion);
ccc/Hypertext.pm view on Meta::CPAN
$buffer->insert_with_tags($iter, $regions[1], $tag);
}
}
$buffer->insert($iter, "\n");
CORBA::MICO::Misc::process_pending() unless ++$cnt % 10;
}
}
$text->{CBDATA} = $cbdata;
$text->signal_connect(event_after => \&event_after);
$text->signal_connect(backspace => \&event_backspace);
CORBA::MICO::Misc::cursor_restore_to_default($htext, 0);
set_curs($text, $cbdata);
$prepost_cb->($udata, 0);
$htext->queue_draw();
}
#--------------------------------------------------------------------
# Search
sub do_search {
my ($htext, $is_regexp) = @_;
ccc/Hypertext.pm view on Meta::CPAN
my $stags = $sdata->{TAGS};
if( $stags ) {
# remove prev search tags
for my $e (@$stags) {
$buffer->remove_tag(@$e);
}
}
$stags = [];
my $pat = $se->get_text();
if( $pat ) {
$text->get_window('text')->set_cursor(Gtk2::Gdk::Cursor->new('watch'));
return if CORBA::MICO::Misc::process_pending();
my $itext = $buffer->get_text($buffer->get_bounds(), 1);
my @sres;
if( $is_regexp ) {
eval { @sres = split(/((?mi)$pat)/, $itext) };
}
else {
eval { @sres = split(/((?i)\Q$pat\E)/, $itext) };
}
$text->get_window('text')->set_cursor(Gtk2::Gdk::Cursor->new('xterm'));
return if CORBA::MICO::Misc::process_pending();
if( @sres ) {
# found
my $eiter;
my $rect = $text->get_visible_rect();
if( defined($sdata->{PREV}) && $sdata->{PREV} eq $pat ) {
$eiter = $text->get_iter_at_location($rect->x+$rect->width,
$rect->y+$rect->height);
}
else {
ccc/Hypertext.pm view on Meta::CPAN
$dialog->add($ht);
$dialog->show_all();
$dialog->realize();
return 1 if CORBA::MICO::Misc::process_pending();
hypertext_show($ht, $node, @$cbdata{qw(CALLBACK UDATA PREPOST)}, undef);
}
return 0;
}
#--------------------------------------------------------------------
# Motion notify: set appropriate cursor type
sub set_curs {
my ($w, $cbdata) = @_;
my (undef, $x, $y, undef) = $w->window->get_pointer();
($x, $y) = $w->window_to_buffer_coords('widget', $x, $y);
my $iter = $w->get_iter_at_location ($x, $y);
return 0 unless $iter;
my $curshand = defined(get_hlink($iter));
if( !defined($cbdata->{CURS_HAND}) || $curshand != $cbdata->{CURS_HAND} ) {
$w->get_window('text')->set_cursor
(Gtk2::Gdk::Cursor->new($curshand ? 'hand2' : 'xterm'));
$cbdata->{CURS_HAND} = $curshand;
}
return 0;
}
my $ctree = $self->{'CTREE'};
my $queue = $self->{'BG_QUEUE'};
my $topwindow = $self->{'TOPWINDOW'};
my $model = $self->{'MODEL'};
my ($desc, $ud) = $model->get($node,
TREE_TITLE_COLUMN,
TREE_UDATA_COLUMN);
my $contents = $ud->[1];
my $buffered = $ud->[2];
return 1 unless defined($contents) or defined($buffered);
return 1 if CORBA::MICO::Misc::cursor_watch($topwindow, 1);
$ctree->hide();
if( defined($buffered) ) {
# insert buffered subnodes (if any)
foreach my $b (@$buffered) {
insert_buffered($self, $ctree, $node, $b);
}
$ud->[2] = undef;
}
if( defined($contents) ) {
# insert new (unbuffered) subnodes (if any) into CTree
my $ir_node = $ud->[0];
create_subtree($ctree, $node, $contents, $queue, $self);
$ud->[1] = undef; # mark node as fully constructed
}
CORBA::MICO::Misc::cursor_restore_to_default($topwindow, 0);
$ctree->show();
}
#--------------------------------------------------------------------
# Hypertext handler
# args: item_name, %ir_items
# Returns a list of lines to be shown
sub hypertext_cb {
my ($name, $self) = @_;
my $root_ir = $self->{'ROOT'};
my $selected_node = $self->{'NODE'};
return unless defined($selected_node);
my $model = $self->{'MODEL'};
my ($desc, $ud) = $model->get($selected_node,
TREE_TITLE_COLUMN,
TREE_UDATA_COLUMN);
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
#--------------------------------------------------------------------
ccc/Misc.pm view on Meta::CPAN
require Exporter;
require Gtk2;
use strict;
@CORBA::MICO::Misc::ISA = qw(Exporter);
@CORBA::MICO::Misc::EXPORT = qw();
@CORBA::MICO::Misc::EXPORT_OK = qw(
process_pending
cursor_clock
cursor_hand2
cursor_restore_to_default
warning
select_file
status_line_create
status_line_write
ctree_pixmaps
);
use vars qw($ctree_pixmaps);
#--------------------------------------------------------------------
# Force updating of screen (process pending events)
# Return value: TRUE if main_quit has been called, FALSE else
sub process_pending {
my $ret = Gtk2->main_iteration() while Gtk2->events_pending();
return $ret;
}
#--------------------------------------------------------------------
# Set cursor: watch
# In: widget - widget-owner of window cursor will be set to
# do_repaint - repaint immediately if TRUE
# Return value: TRUE if main_quit has been called, FALSE else
#--------------------------------------------------------------------
sub cursor_watch {
# return cursor_set(Gtk2::Gdk::GDK_WATCH, @_);
return cursor_set(Gtk2::Gdk::Cursor->new('watch'), @_);
}
#--------------------------------------------------------------------
# Set cursor: hand2
# In: widget - widget-owner of window cursor will be set to
# do_repaint - repaint immediately if TRUE
# Return value: TRUE if main_quit has been called, FALSE else
#--------------------------------------------------------------------
sub cursor_hand2 {
# return cursor_set(Gtk2::Gdk::GDK_HAND2, @_);
return cursor_set(Gtk2::Gdk::Cursor->new('hand2'), @_);
}
#--------------------------------------------------------------------
# Restore cursor to its default value
# In: widget - widget-owner of window cursor will be set to
# do_repaint - repaint immediately if TRUE
# Return value: TRUE if main_quit has been called, FALSE else
#--------------------------------------------------------------------
sub cursor_restore_to_default {
return cursor_set(undef, @_);
}
#--------------------------------------------------------------------
# Set cursor
# In: cursor, widget, do_repaint
# Return value: TRUE if main_quit has been called, FALSE else
#--------------------------------------------------------------------
sub cursor_set {
my ($cursor, $widget, $do_repaint) = @_;
my $ret = 0;
my $window = $widget->window();
if( defined($window) ) {
$window->set_cursor($cursor);
if( $do_repaint ) {
$ret = process_pending();
}
}
return $ret;
}
#--------------------------------------------------------------------
# Ask file name via file selection dialog
# In: $title - title
$paned->add2($paned1);
# Create text window for IDL-representation of selected items
my $text = CORBA::MICO::Hypertext::hypertext_create(1);
$paned1->add($text);
# Text widget for IOR
my $ior_widget = Gtk2::TextView->new;
$ior_widget->set_wrap_mode ('char');
$ior_widget->set_editable(0);
$ior_widget->set_cursor_visible(0);
$paned1->add2($ior_widget);
$paned1->set_position(400);
$paned->set_position(200);
$scrolled->show();
$paned->show();
$bg_sched->add_entry($self);
$ctree->signal_connect('destroy', sub { $bg_sched->remove_entry($self); 1; });
$selection->signal_connect(changed => \&row_selected, $self);
my $ctree = $self->{'CTREE'};
my $queue = $self->{'BG_QUEUE'};
my $topwindow = $self->{'TOPWINDOW'};
my $model = $self->{'MODEL'};
my ($desc, $ud) = $model->get($node,
TREE_TITLE_COLUMN,
TREE_UDATA_COLUMN);
my $contents = $ud->[1];
my $buffered = $ud->[2];
return 1 unless defined($contents) or defined($buffered);
return 1 if CORBA::MICO::Misc::cursor_watch($topwindow, 1);
$ctree->hide();
if( defined($buffered) ) {
# insert buffered subnodes (if any)
foreach my $b (@$buffered) {
insert_buffered($self, $ctree, $node, $b);
}
$ud->[2] = undef;
}
if( defined($contents) ) {
# insert new (unbuffered) subnodes (if any) into CTree
my $nc_node = $ud->[0];
create_subtree($ctree, $node, $contents, $queue, $self);
$ud->[1] = undef; # mark node as fully constructed
}
CORBA::MICO::Misc::cursor_restore_to_default($topwindow, 0);
$ctree->show();
}
#--------------------------------------------------------------------
# Prepare some internal data for callback and call callback handler
# In: $curs_watch - change cursoe to watch if TRUE
# $callback - callback handler, must expect parameters:
# $self
# $name - name of NC entry
# $nc_node - NC entry object
my $topwindow = $self->{'TOPWINDOW'};
my $selected_node = $self->{'NODE'};
return unless defined($selected_node);
my $model = $self->{'MODEL'};
my ($desc, $ud) = $model->get($selected_node,
TREE_TITLE_COLUMN,
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();
#print "IFACE: ", ref($iface), "\n";
#my $deasc = $iface->describe_interface();
#print "IF ID: $desc->{id}, NAME: $desc->{name}\n";
#print "IF ID: $iface->{id}, NAME: $iface->{name}\n";
unless($repoid) {
}
);
}
#--------------------------------------------------------------------
# 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'});
}
);
}
#--------------------------------------------------------------------
( run in 0.263 second using v1.01-cache-2.11-cpan-4d50c553e7e )