use constant::boolean;
|
use constant::boolean;
|
#use Gtk2 '-init';
|
#use Gtk2 '-init';
|
use strict;
|
use strict;
|
use warnings;
|
use warnings;
|
|
|
use Data::Dumper;
|
use Data::Dumper;
|
use Gtk2::SourceView2;
|
use Gtk2::SourceView2;
|
use Consts;
|
use Consts;
|
|
|
require "common.pl";
|
require "common.pl";
|
|
|
use FindBin;
|
use FindBin;
|
use lib $FindBin::Bin;
|
use lib $FindBin::Bin;
|
use IO::CaptureOutput qw(capture qxx qxy);
|
use IO::CaptureOutput qw(capture qxx qxy);
|
|
|
use ColorButton;
|
use ColorButton;
|
use HexSpin2;
|
use HexSpin2;
|
|
|
|
|
use Gtk2::Pango;
|
use Gtk2::Pango;
|
#use Tk::Animation;
|
#use Tk::Animation;
|
|
|
our $FONT_SIZE;
|
our %glob_setting;
|
our $ICON_SIZE;
|
|
|
|
##############
|
##############
|
# combo box
|
# combo box
|
#############
|
#############
|
sub gen_combo{
|
sub gen_combo{
|
my ($combo_list, $combo_active_pos)= @_;
|
my ($combo_list, $combo_active_pos)= @_;
|
my $combo = Gtk2::ComboBox->new_text;
|
my $combo = Gtk2::ComboBox->new_text;
|
|
|
combo_set_names($combo,$combo_list);
|
combo_set_names($combo,$combo_list);
|
$combo->set_active($combo_active_pos) if(defined $combo_active_pos);
|
$combo->set_active($combo_active_pos) if(defined $combo_active_pos);
|
|
|
#my $font = Gtk2::Pango::FontDescription->from_string('Tahoma 5');
|
#my $font = Gtk2::Pango::FontDescription->from_string('Tahoma 5');
|
#$combo->modify_font($font);
|
#$combo->modify_font($font);
|
|
|
|
|
return $combo;
|
return $combo;
|
}
|
}
|
|
|
|
|
sub combo_set_names {
|
sub combo_set_names {
|
my ( $combo, $list_ref ) = @_;
|
my ( $combo, $list_ref ) = @_;
|
my @list=@{$list_ref};
|
my @list=@{$list_ref};
|
#print "$list[0]\n";
|
#print "$list[0]\n";
|
for my $item (@list){$combo->append_text($item);}
|
for my $item (@list){$combo->append_text($item);}
|
}
|
}
|
|
|
|
|
sub gen_combo_help {
|
sub gen_combo_help {
|
my ($help, @combo_list, $pos)= @_;
|
my ($help, @combo_list, $pos)= @_;
|
my $box = def_hbox(FALSE, 0);
|
my $box = def_hbox(FALSE, 0);
|
my $combo= gen_combo(@combo_list, $pos);
|
my $combo= gen_combo(@combo_list, $pos);
|
my $button=def_image_button("icons/help.png");
|
my $button=def_image_button("icons/help.png");
|
|
|
$button->signal_connect("clicked" => sub {message_dialog($help);});
|
$button->signal_connect("clicked" => sub {message_dialog($help);});
|
|
|
$box->pack_start( $combo, FALSE, FALSE, 3);
|
$box->pack_start( $combo, FALSE, FALSE, 3);
|
$box->pack_start( $button, FALSE, FALSE, 3);
|
$box->pack_start( $button, FALSE, FALSE, 3);
|
$box->show_all;
|
$box->show_all;
|
|
|
return ($box,$combo);
|
return ($box,$combo);
|
}
|
}
|
|
|
|
|
sub def_h_labeled_combo{
|
sub def_h_labeled_combo{
|
my ($label_name,$combo_list,$combo_active_pos)=@_;
|
my ($label_name,$combo_list,$combo_active_pos)=@_;
|
my $box = def_hbox(TRUE,0);
|
my $box = def_hbox(TRUE,0);
|
my $label= gen_label_in_left($label_name);
|
my $label= gen_label_in_left($label_name);
|
my $combo= gen_combo($combo_list, $combo_active_pos);
|
my $combo= gen_combo($combo_list, $combo_active_pos);
|
$box->pack_start( $label, FALSE, FALSE, 3);
|
$box->pack_start( $label, FALSE, FALSE, 3);
|
$box->pack_start( $combo, FALSE, TRUE, 3);
|
$box->pack_start( $combo, FALSE, TRUE, 3);
|
return ($box,$combo);
|
return ($box,$combo);
|
}
|
}
|
|
|
sub def_h_labeled_combo_scaled{
|
sub def_h_labeled_combo_scaled{
|
my ($label_name,$combo_list,$combo_active_pos,$label_w,$comb_w)=@_;
|
my ($label_name,$combo_list,$combo_active_pos,$label_w,$comb_w)=@_;
|
my $table= def_table(1,3,TRUE);
|
my $table= def_table(1,3,TRUE);
|
my $label= gen_label_in_left($label_name);
|
my $label= gen_label_in_left($label_name);
|
my $combo= gen_combo($combo_list, $combo_active_pos);
|
my $combo= gen_combo($combo_list, $combo_active_pos);
|
$table->attach_defaults ($label, 0, $label_w, 0, 1);
|
$table->attach_defaults ($label, 0, $label_w, 0, 1);
|
$table->attach_defaults ($combo, 1, $label_w+$comb_w, 0, 1);
|
$table->attach_defaults ($combo, 1, $label_w+$comb_w, 0, 1);
|
return ($table,$combo);
|
return ($table,$combo);
|
}
|
}
|
|
|
|
|
sub gen_combo_model{
|
sub gen_combo_model{
|
my $ref=shift;
|
my $ref=shift;
|
my %inputs=%{$ref};
|
my %inputs=%{$ref};
|
my $store = Gtk2::TreeStore->new('Glib::String');
|
my $store = Gtk2::TreeStore->new('Glib::String');
|
for my $i (sort { $a cmp $b} keys %inputs ) {
|
for my $i (sort { $a cmp $b} keys %inputs ) {
|
my $iter = $store->append(undef);
|
my $iter = $store->append(undef);
|
|
|
$store->set($iter, 0, $i);
|
$store->set($iter, 0, $i);
|
for my $capital (sort { $a cmp $b} keys %{$inputs{$i}}) {
|
for my $capital (sort { $a cmp $b} keys %{$inputs{$i}}) {
|
my $iter2 = $store->append($iter);
|
my $iter2 = $store->append($iter);
|
$store->set($iter2, 0, $capital);
|
$store->set($iter2, 0, $capital);
|
}
|
}
|
}
|
}
|
return $store;
|
return $store;
|
|
|
}
|
}
|
|
|
sub gen_tree_combo{
|
sub gen_tree_combo{
|
my $model=shift;
|
my $model=shift;
|
my $combo = Gtk2::ComboBox->new_with_model($model);
|
my $combo = Gtk2::ComboBox->new_with_model($model);
|
my $renderer = Gtk2::CellRendererText->new();
|
my $renderer = Gtk2::CellRendererText->new();
|
$combo->pack_start($renderer, TRUE);
|
$combo->pack_start($renderer, TRUE);
|
$combo->set_attributes($renderer, "text", 0);
|
$combo->set_attributes($renderer, "text", 0);
|
$combo->set_cell_data_func($renderer, \&is_capital_sensitive);
|
$combo->set_cell_data_func($renderer, \&is_capital_sensitive);
|
return $combo;
|
return $combo;
|
|
|
}
|
}
|
|
|
|
|
sub TreePath_new_from_indices {
|
sub TreePath_new_from_indices {
|
my @indices =@_;
|
my @indices =@_;
|
my $path = Gtk2::TreePath->new_from_indices(@indices);
|
my $path = Gtk2::TreePath->new_from_indices(@indices);
|
return $path;
|
return $path;
|
|
|
}
|
}
|
|
|
|
|
##############
|
##############
|
# spin button
|
# spin button
|
#############
|
#############
|
sub gen_spin{
|
sub gen_spin{
|
my ($min,$max,$step,$digit)= @_;
|
my ($min,$max,$step,$digit)= @_;
|
|
|
return Gtk2::SpinButton->new_with_range ($min, $max, $step);
|
return Gtk2::SpinButton->new_with_range ($min, $max, $step);
|
if(!defined $digit){
|
if(!defined $digit){
|
my $d1 = get_float_precision($min);
|
my $d1 = get_float_precision($min);
|
my $d2 = get_float_precision($max);
|
my $d2 = get_float_precision($max);
|
my $d3 = get_float_precision($step);
|
my $d3 = get_float_precision($step);
|
$digit = ($d1 >$d2)? $d1 : $d2;
|
$digit = ($d1 >$d2)? $d1 : $d2;
|
$digit = $d3 if($d3>$digit);
|
$digit = $d3 if($d3>$digit);
|
}
|
}
|
print "($min,$max,$step,$digit)\n";
|
print "($min,$max,$step,$digit)\n";
|
return Gtk2::SpinButton->new_with_range ($min, $max, $step) if($digit ==0);
|
return Gtk2::SpinButton->new_with_range ($min, $max, $step) if($digit ==0);
|
return gen_spin_float($min,$max,$step,$digit);
|
return gen_spin_float($min,$max,$step,$digit);
|
}
|
}
|
|
|
sub get_float_precision{
|
sub get_float_precision{
|
my $num=shift;
|
my $num=shift;
|
my $digit = length(($num =~ /\.(.*)/)[0]);
|
my $digit = length(($num =~ /\.(.*)/)[0]);
|
$digit=0 if(!defined $digit);
|
$digit=0 if(!defined $digit);
|
return $digit;
|
return $digit;
|
}
|
}
|
|
|
sub gen_spin_float{
|
sub gen_spin_float{
|
my ($min,$max,$step,$digit)= @_;
|
my ($min,$max,$step,$digit)= @_;
|
#$page_inc = ($max - $min)/
|
#$page_inc = ($max - $min)/
|
my $adj = Gtk2::Adjustment->new (0, $min, $max, $step,3.1, 0);
|
my $adj = Gtk2::Adjustment->new (0, $min, $max, $step,3.1, 0);
|
my $spinner = Gtk2::SpinButton->new ($adj, 1.0,$digit);
|
my $spinner = Gtk2::SpinButton->new ($adj, 1.0,$digit);
|
return $spinner;
|
return $spinner;
|
}
|
}
|
|
|
|
|
sub gen_spin_help {
|
sub gen_spin_help {
|
my ($help, $min,$max,$step,$digit)= @_;
|
my ($help, $min,$max,$step,$digit)= @_;
|
my $box = def_hbox(FALSE, 0);
|
my $box = def_hbox(FALSE, 0);
|
my $spin= gen_spin($min,$max,$step,$digit);
|
my $spin= gen_spin($min,$max,$step,$digit);
|
my $button=def_image_button("icons/help.png");
|
my $button=def_image_button("icons/help.png");
|
|
|
$button->signal_connect("clicked" => sub {message_dialog($help);});
|
$button->signal_connect("clicked" => sub {message_dialog($help);});
|
|
|
$box->pack_start( $spin, FALSE, FALSE, 3);
|
$box->pack_start( $spin, FALSE, FALSE, 3);
|
$box->pack_start( $button, FALSE, FALSE, 3);
|
$box->pack_start( $button, FALSE, FALSE, 3);
|
$box->show_all;
|
$box->show_all;
|
|
|
return ($box,$spin);
|
return ($box,$spin);
|
}
|
}
|
|
|
|
|
#############
|
#############
|
# entry
|
# entry
|
#############
|
#############
|
sub gen_entry{
|
sub gen_entry{
|
my ($initial) = @_;
|
my ($initial) = @_;
|
my $entry = Gtk2::Entry->new;
|
my $entry = Gtk2::Entry->new;
|
if(defined $initial){ $entry->set_text($initial)};
|
if(defined $initial){ $entry->set_text($initial)};
|
return $entry;
|
return $entry;
|
}
|
}
|
|
|
|
|
sub gen_entry_new_with_max_length{
|
sub gen_entry_new_with_max_length{
|
my ($n,$initial) = @_;
|
my ($n,$initial) = @_;
|
my $entry = Gtk2::Entry->new_with_max_length ($n);
|
my $entry = Gtk2::Entry->new_with_max_length ($n);
|
if(defined $initial){ $entry->set_text($initial)};
|
if(defined $initial){ $entry->set_text($initial)};
|
return $entry;
|
return $entry;
|
}
|
}
|
|
|
|
|
|
|
sub gen_entry_help{
|
sub gen_entry_help{
|
my ($help, $init)= @_;
|
my ($help, $init)= @_;
|
my $box = def_hbox(FALSE, 0);
|
my $box = def_hbox(FALSE, 0);
|
my $entry= gen_entry ($init);
|
my $entry= gen_entry ($init);
|
my $button=def_image_button("icons/help.png");
|
my $button=def_image_button("icons/help.png");
|
|
|
$button->signal_connect("clicked" => sub {message_dialog($help);});
|
$button->signal_connect("clicked" => sub {message_dialog($help);});
|
|
|
$box->pack_start( $entry, FALSE, FALSE, 3);
|
$box->pack_start( $entry, FALSE, FALSE, 3);
|
$box->pack_start( $button, FALSE, FALSE, 3);
|
$box->pack_start( $button, FALSE, FALSE, 3);
|
$box->show_all;
|
$box->show_all;
|
|
|
return ($box,$entry);
|
return ($box,$entry);
|
}
|
}
|
|
|
sub def_h_labeled_entry{
|
sub def_h_labeled_entry{
|
my ($label_name,$initial)=@_;
|
my ($label_name,$initial)=@_;
|
my $box = def_hbox(TRUE,0);
|
my $box = def_hbox(TRUE,0);
|
my $label= gen_label_in_left($label_name);
|
my $label= gen_label_in_left($label_name);
|
my $entry =gen_entry($initial);
|
my $entry =gen_entry($initial);
|
$box->pack_start( $label, FALSE, FALSE, 3);
|
$box->pack_start( $label, FALSE, FALSE, 3);
|
$box->pack_start( $entry, FALSE, FALSE, 3);
|
$box->pack_start( $entry, FALSE, FALSE, 3);
|
return ($box,$entry);
|
return ($box,$entry);
|
|
|
}
|
}
|
|
|
sub def_h_labeled_entry_help{
|
sub def_h_labeled_entry_help{
|
my ($help,$label_name,$initial)=@_;
|
my ($help,$label_name,$initial)=@_;
|
my $box = def_hbox(TRUE,0);
|
my $box = def_hbox(TRUE,0);
|
my $label= gen_label_in_left($label_name);
|
my $label= gen_label_in_left($label_name);
|
my ($b,$entry) =gen_entry_help($help,$initial);
|
my ($b,$entry) =gen_entry_help($help,$initial);
|
$box->pack_start( $label, FALSE, FALSE, 3);
|
$box->pack_start( $label, FALSE, FALSE, 3);
|
$box->pack_start( $b, FALSE, FALSE, 3);
|
$box->pack_start( $b, FALSE, FALSE, 3);
|
return ($box,$entry);
|
return ($box,$entry);
|
|
|
}
|
}
|
|
|
|
|
##############
|
##############
|
# ComboBoxEntry
|
# ComboBoxEntry
|
##############
|
##############
|
|
|
sub gen_combo_entry{
|
sub gen_combo_entry{
|
my ($list_ref,$pos)=@_;
|
my ($list_ref,$pos)=@_;
|
my @list=@{$list_ref};
|
my @list=@{$list_ref};
|
|
|
my $combo_box_entry = Gtk2::ComboBoxEntry->new_text;
|
my $combo_box_entry = Gtk2::ComboBoxEntry->new_text;
|
foreach my $p (@list){
|
foreach my $p (@list){
|
$combo_box_entry->append_text($p);
|
$combo_box_entry->append_text($p);
|
}
|
}
|
$pos=0 if(! defined $pos );
|
$pos=0 if(! defined $pos );
|
$combo_box_entry->set_active($pos);
|
$combo_box_entry->set_active($pos);
|
return $combo_box_entry;
|
return $combo_box_entry;
|
}
|
}
|
|
|
|
|
sub combo_entry_get_chiled{
|
sub combo_entry_get_chiled{
|
my $combentry =shift;
|
my $combentry =shift;
|
return $combentry->child;
|
return $combentry->child;
|
}
|
}
|
|
|
|
|
|
|
|
|
sub update_combo_entry_content {
|
sub update_combo_entry_content {
|
my ($self,$content,$pos)=@_;
|
my ($self,$content,$pos)=@_;
|
my @combo_list=split(/\s*,\s*/,$content) if(defined $content);
|
my @combo_list=split(/\s*,\s*/,$content) if(defined $content);
|
foreach my $p (@combo_list){
|
foreach my $p (@combo_list){
|
$self->append_text($p);
|
$self->append_text($p);
|
}
|
}
|
$pos=0 if(! defined $pos );
|
$pos=0 if(! defined $pos );
|
$self->set_active($pos);
|
$self->set_active($pos);
|
}
|
}
|
|
|
###########
|
###########
|
# checkbutton
|
# checkbutton
|
###########
|
###########
|
|
|
sub def_h_labeled_checkbutton{
|
sub def_h_labeled_checkbutton{
|
my ($label_name)=@_;
|
my ($label_name)=@_;
|
my $box = def_hbox(TRUE,0);
|
my $box = def_hbox(TRUE,0);
|
my $label= gen_label_in_left($label_name) if (defined $label_name);
|
my $label= gen_label_in_left($label_name) if (defined $label_name);
|
my $check= Gtk2::CheckButton->new;
|
my $check= Gtk2::CheckButton->new;
|
#if($status==1) $check->
|
#if($status==1) $check->
|
$box->pack_start( $label, FALSE, FALSE, 3) if (defined $label_name);
|
$box->pack_start( $label, FALSE, FALSE, 3) if (defined $label_name);
|
$box->pack_start( $check, FALSE, FALSE, 3);
|
$box->pack_start( $check, FALSE, FALSE, 3);
|
return ($box,$check);
|
return ($box,$check);
|
|
|
}
|
}
|
|
|
sub gen_checkbutton{
|
sub gen_checkbutton{
|
my $label=shift;
|
my $label=shift;
|
return Gtk2::CheckButton->new($label) if (defined $label);
|
return Gtk2::CheckButton->new($label) if (defined $label);
|
return Gtk2::CheckButton->new;
|
return Gtk2::CheckButton->new;
|
}
|
}
|
|
|
|
|
#############
|
#############
|
# label
|
# label
|
############
|
############
|
|
|
sub gen_label_in_left{
|
sub gen_label_in_left{
|
my ($data)=@_;
|
my ($data)=@_;
|
my $label = Gtk2::Label->new($data);
|
my $label = Gtk2::Label->new($data);
|
$label->set_alignment( 0, 0.5 );
|
$label->set_alignment( 0, 0.5 );
|
#my $font = Gtk2::Pango::FontDescription->from_string('Tahoma 5');
|
#my $font = Gtk2::Pango::FontDescription->from_string('Tahoma 5');
|
#$label->modify_font($font);
|
#$label->modify_font($font);
|
return $label;
|
return $label;
|
}
|
}
|
|
|
|
|
sub gen_label_in_center{
|
sub gen_label_in_center{
|
my ($data)=@_;
|
my ($data)=@_;
|
my $label = Gtk2::Label->new($data);
|
my $label = Gtk2::Label->new($data);
|
return $label;
|
return $label;
|
}
|
}
|
|
|
sub def_label{
|
sub def_label{
|
my @data=@_;
|
my @data=@_;
|
my $label = Gtk2::Label->new(@data);
|
my $label = Gtk2::Label->new(@data);
|
$label->set_alignment( 0, 0.5 );
|
$label->set_alignment( 0, 0.5 );
|
return $label;
|
return $label;
|
|
|
}
|
}
|
|
|
|
|
sub box_label{
|
sub box_label{
|
my( $homogeneous, $spacing, $name)=@_;
|
my( $homogeneous, $spacing, $name)=@_;
|
my $box=def_hbox($homogeneous, $spacing);
|
my $box=def_hbox($homogeneous, $spacing);
|
my $label= def_label($name);
|
my $label= def_label($name);
|
$box->pack_start( $label, FALSE, FALSE, 3);
|
$box->pack_start( $label, FALSE, FALSE, 3);
|
return $box;
|
return $box;
|
}
|
}
|
|
|
|
|
sub def_title_box{
|
sub def_title_box{
|
my( $homogeneous, $spacing, @labels)=@_;
|
my( $homogeneous, $spacing, @labels)=@_;
|
my $box=def_hbox($homogeneous, $spacing);
|
my $box=def_hbox($homogeneous, $spacing);
|
foreach my $label (@labels){
|
foreach my $label (@labels){
|
my $labelbox=box_label($homogeneous, $spacing, $label);
|
my $labelbox=box_label($homogeneous, $spacing, $label);
|
$box->pack_start( $labelbox, FALSE, FALSE, 3);
|
$box->pack_start( $labelbox, FALSE, FALSE, 3);
|
}
|
}
|
return $box;
|
return $box;
|
}
|
}
|
|
|
|
|
sub gen_label_help {
|
sub gen_label_help {
|
my ($help, $label_name)= @_;
|
my ($help, $label_name)= @_;
|
my $box = def_hbox(FALSE, 0);
|
my $box = def_hbox(FALSE, 0);
|
my $label= gen_label_in_left($label_name);
|
my $label= gen_label_in_left($label_name);
|
my $button=def_image_button("icons/help.png");
|
my $button=def_image_button("icons/help.png");
|
$button->signal_connect("clicked" => sub {message_dialog($help);});
|
$button->signal_connect("clicked" => sub {message_dialog($help);});
|
$box->pack_start( $label, FALSE, FALSE, 0);
|
$box->pack_start( $label, FALSE, FALSE, 0);
|
$box->pack_start( $button, FALSE, FALSE, 0);
|
$box->pack_start( $button, FALSE, FALSE, 0);
|
$box->set_spacing (0);
|
$box->set_spacing (0);
|
$box->show_all;
|
$box->show_all;
|
return $box;
|
return $box;
|
}
|
}
|
|
|
sub gen_label_with_mnemonic {
|
sub gen_label_with_mnemonic {
|
my $name=shift;
|
my $name=shift;
|
Gtk2::Label->new_with_mnemonic($name);
|
Gtk2::Label->new_with_mnemonic($name);
|
|
|
}
|
}
|
|
|
##############
|
##############
|
# button
|
# button
|
#############
|
#############
|
|
|
sub button_box{
|
sub button_box{
|
# create a new button
|
# create a new button
|
my $label=@_;
|
my $label=@_;
|
my $button = Gtk2::Button->new_from_stock($label);
|
my $button = Gtk2::Button->new_from_stock($label);
|
my $box=def_hbox(TRUE,5);
|
my $box=def_hbox(TRUE,5);
|
$box->pack_start($button, FALSE, FALSE,0);
|
$box->pack_start($button, FALSE, FALSE,0);
|
|
|
return ($box,$button);
|
return ($box,$button);
|
|
|
}
|
}
|
|
|
|
|
sub get_icon_pixbuff{
|
sub get_icon_pixbuff{
|
my $icon_file=shift;
|
my $icon_file=shift;
|
my $size;
|
my $size;
|
if ($ICON_SIZE eq 'default'){
|
if ($glob_setting{'ICON_SIZE'} eq 'default'){
|
my $font_size=get_defualt_font_size();
|
my $font_size=get_defualt_font_size();
|
$size=($font_size *2.5);
|
$size=($font_size *2.5);
|
}else{
|
}else{
|
$size = int ($ICON_SIZE);
|
$size = int ($glob_setting{'ICON_SIZE'});
|
}
|
}
|
my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file_at_scale($icon_file,$size,$size,FALSE);
|
my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file_at_scale($icon_file,$size,$size,FALSE);
|
return $pixbuf;
|
return $pixbuf;
|
}
|
}
|
|
|
|
|
|
|
sub def_icon{
|
sub def_icon{
|
my $icon_file=shift;
|
my $icon_file=shift;
|
return Gtk2::Image->new_from_pixbuf(get_icon_pixbuff($icon_file));
|
return Gtk2::Image->new_from_pixbuf(get_icon_pixbuff($icon_file));
|
}
|
}
|
|
|
sub call_gtk_drag_finish{
|
sub call_gtk_drag_finish{
|
my ($context,$a,$b,$time)=@_;
|
my ($context,$a,$b,$time)=@_;
|
$context->finish (0, 0, $time);
|
$context->finish (0, 0, $time);
|
}
|
}
|
|
|
|
|
|
|
sub add_drag_dest_set{
|
sub add_drag_dest_set{
|
my ($widget,$a,$b,$c) = @_;
|
my ($widget,$a,$b,$c) = @_;
|
#Create a target table to receive drops
|
#Create a target table to receive drops
|
my @target_table = (
|
my @target_table = (
|
{'target' => $a, 'flags' => $b, 'info' => $c },
|
{'target' => $a, 'flags' => $b, 'info' => $c },
|
);
|
);
|
$widget->drag_dest_set('all', ['copy'], @target_table);
|
$widget->drag_dest_set('all', ['copy'], @target_table);
|
}
|
}
|
|
|
sub add_drag_source {
|
sub add_drag_source {
|
my ($widget,$a,$b,$c) = @_;
|
my ($widget,$a,$b,$c) = @_;
|
$widget->drag_source_set (
|
$widget->drag_source_set (
|
['button1_mask', 'button3_mask'],
|
['button1_mask', 'button3_mask'],
|
['copy'],
|
['copy'],
|
{
|
{
|
'target' => $a,
|
'target' => $a,
|
'flags' => $b,
|
'flags' => $b,
|
'info' => $c,
|
'info' => $c,
|
},
|
},
|
);
|
);
|
}
|
}
|
|
|
sub drag_set_icon_pixbuf {
|
sub drag_set_icon_pixbuf {
|
my ($icon_view,$icon_pixbuf)=@_;
|
my ($icon_view,$icon_pixbuf)=@_;
|
$icon_view->drag_source_set_icon_pixbuf ($icon_pixbuf);
|
$icon_view->drag_source_set_icon_pixbuf ($icon_pixbuf);
|
}
|
}
|
|
|
sub gen_iconview {
|
sub gen_iconview {
|
my ($tree_model,$marc_col,$pix_con)=@_;
|
my ($tree_model,$marc_col,$pix_con)=@_;
|
my $icon_view = Gtk2::IconView->new_with_model($tree_model);
|
my $icon_view = Gtk2::IconView->new_with_model($tree_model);
|
$icon_view->set_markup_column($marc_col);
|
$icon_view->set_markup_column($marc_col);
|
$icon_view->set_pixbuf_column($pix_con);
|
$icon_view->set_pixbuf_column($pix_con);
|
return $icon_view;
|
return $icon_view;
|
}
|
}
|
|
|
|
|
sub add_frame_to_image{
|
sub add_frame_to_image{
|
my $image=shift;
|
my $image=shift;
|
my $align = Gtk2::Alignment->new (0.5, 0.5, 0, 0);
|
my $align = Gtk2::Alignment->new (0.5, 0.5, 0, 0);
|
my $frame = Gtk2::Frame->new;
|
my $frame = Gtk2::Frame->new;
|
$frame->set_shadow_type ('in');
|
$frame->set_shadow_type ('in');
|
# Animation
|
# Animation
|
$frame->add ($image);
|
$frame->add ($image);
|
$align->add ($frame);
|
$align->add ($frame);
|
return $align;
|
return $align;
|
}
|
}
|
|
|
sub gen_frame {
|
sub gen_frame {
|
return Gtk2::Frame->new;
|
return Gtk2::Frame->new;
|
}
|
}
|
|
|
|
|
|
|
sub new_image_from_file{
|
sub new_image_from_file{
|
return Gtk2::Image->new_from_file (@_);
|
return Gtk2::Image->new_from_file (@_);
|
}
|
}
|
|
|
|
|
sub gen_pixbuf{
|
sub gen_pixbuf{
|
my $file=shift;
|
my $file=shift;
|
return Gtk2::Gdk::Pixbuf->new_from_file($file);
|
return Gtk2::Gdk::Pixbuf->new_from_file($file);
|
}
|
}
|
|
|
sub open_image{
|
sub open_image{
|
my ($image_file,$x,$y,$unit)=@_;
|
my ($image_file,$x,$y,$unit)=@_;
|
if(defined $unit){
|
if(defined $unit){
|
my($width,$hight)=max_win_size();
|
my($width,$hight)=max_win_size();
|
if($unit eq 'percent'){
|
if($unit eq 'percent'){
|
$x= ($x * $width)/100;
|
$x= ($x * $width)/100;
|
$y= ($y * $hight)/100;
|
$y= ($y * $hight)/100;
|
} # else its pixels
|
} # else its pixels
|
|
|
}
|
}
|
$image_file ="icons/blank.png" unless(-f $image_file);
|
$image_file ="icons/blank.png" unless(-f $image_file);
|
my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file_at_scale($image_file,$x,$y,TRUE);
|
my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file_at_scale($image_file,$x,$y,TRUE);
|
my $image = Gtk2::Image->new_from_pixbuf($pixbuf);
|
my $image = Gtk2::Image->new_from_pixbuf($pixbuf);
|
return $image;
|
return $image;
|
}
|
}
|
|
|
sub open_inline_image{
|
sub open_inline_image{
|
my ($image_string,$x,$y,$unit)=@_;
|
my ($image_string,$x,$y,$unit)=@_;
|
if(defined $unit){
|
if(defined $unit){
|
my($width,$hight)=max_win_size();
|
my($width,$hight)=max_win_size();
|
if($unit eq 'percent'){
|
if($unit eq 'percent'){
|
$x= ($x * $width)/100;
|
$x= ($x * $width)/100;
|
$y= ($y * $hight)/100;
|
$y= ($y * $hight)/100;
|
} # else its pixels
|
} # else its pixels
|
|
|
}
|
}
|
my $pixbuf = do {
|
my $pixbuf = do {
|
my $loader = Gtk2::Gdk::PixbufLoader->new();
|
my $loader = Gtk2::Gdk::PixbufLoader->new();
|
$loader->set_size( $x,$y ) if (defined $y);
|
$loader->set_size( $x,$y ) if (defined $y);
|
$loader->write( $image_string );
|
$loader->write( $image_string );
|
$loader->close();
|
$loader->close();
|
$loader->get_pixbuf();
|
$loader->get_pixbuf();
|
};
|
};
|
|
|
|
|
my $image = Gtk2::Image->new_from_pixbuf($pixbuf);
|
my $image = Gtk2::Image->new_from_pixbuf($pixbuf);
|
|
|
return $image;
|
return $image;
|
}
|
}
|
|
|
sub find_icon{
|
sub find_icon{
|
my $file =shift;
|
my $file =shift;
|
return $file if(-f $file); #called from perl_gui
|
return $file if(-f $file); #called from perl_gui
|
return "../../$file"; #called from lib/perl
|
return "../../$file"; #called from lib/perl
|
}
|
}
|
|
|
sub def_image_button{
|
sub def_image_button{
|
my ($image_file, $label_text, $homogeneous, $mnemonic)=@_;
|
my ($image_file, $label_text, $homogeneous, $mnemonic)=@_;
|
# create box for image and label
|
# create box for image and label
|
$homogeneous = FALSE if(!defined $homogeneous);
|
$homogeneous = FALSE if(!defined $homogeneous);
|
my $box = def_hbox($homogeneous,0);
|
my $box = def_hbox($homogeneous,0);
|
my $image;
|
my $image;
|
$image_file = find_icon( $image_file);
|
$image_file = find_icon( $image_file);
|
$image = def_icon($image_file) if(-f $image_file);
|
$image = def_icon($image_file) if(-f $image_file);
|
|
|
# now on to the image stuff
|
# now on to the image stuff
|
#my $image = Gtk2::Image->new_from_file($image_file);
|
#my $image = Gtk2::Image->new_from_file($image_file);
|
$box->pack_start($image, FALSE, FALSE, 0) if(defined $image);
|
$box->pack_start($image, FALSE, FALSE, 0) if(defined $image);
|
$box->set_border_width(0);
|
$box->set_border_width(0);
|
$box->set_spacing (0);
|
$box->set_spacing (0);
|
# Create a label for the button
|
# Create a label for the button
|
if(defined $label_text ) {
|
if(defined $label_text ) {
|
my $label;
|
my $label;
|
$label = Gtk2::Label->new(" $label_text") unless (defined $mnemonic);
|
$label = Gtk2::Label->new(" $label_text") unless (defined $mnemonic);
|
$label = Gtk2::Label->new_with_mnemonic (" $label_text") if (defined $mnemonic);
|
$label = Gtk2::Label->new_with_mnemonic (" $label_text") if (defined $mnemonic);
|
$box->pack_start($label, FALSE, FALSE, 0);
|
$box->pack_start($label, FALSE, FALSE, 0);
|
}
|
}
|
|
|
my $button = Gtk2::Button->new();
|
my $button = Gtk2::Button->new();
|
$button->add($box);
|
$button->add($box);
|
$button->set_border_width(0);
|
$button->set_border_width(0);
|
$button->show_all;
|
$button->show_all;
|
return $button;
|
return $button;
|
}
|
}
|
|
|
sub def_button{
|
sub def_button{
|
my ($label_text)=@_;
|
my ($label_text)=@_;
|
my $label = Gtk2::Label->new("$label_text") if (defined $label_text);
|
my $label = Gtk2::Label->new("$label_text") if (defined $label_text);
|
my $button= Gtk2::Button->new();
|
my $button= Gtk2::Button->new();
|
$button->add($label) if (defined $label_text);
|
$button->add($label) if (defined $label_text);
|
return $button;
|
return $button;
|
}
|
}
|
|
|
|
|
sub def_image_label{
|
sub def_image_label{
|
my ($image_file, $label_text,$mnemonic)=@_;
|
my ($image_file, $label_text,$mnemonic)=@_;
|
# create box for image and label
|
# create box for image and label
|
my $box = def_hbox(FALSE,1);
|
my $box = def_hbox(FALSE,1);
|
# now on to the image stuff
|
# now on to the image stuff
|
my $image = def_icon($image_file);
|
my $image = def_icon($image_file);
|
$box->pack_start($image, TRUE, FALSE, 0);
|
$box->pack_start($image, TRUE, FALSE, 0);
|
# Create a label for the button
|
# Create a label for the button
|
if(defined $label_text ) {
|
if(defined $label_text ) {
|
my $label;
|
my $label;
|
$label = Gtk2::Label->new(" $label_text") unless (defined $mnemonic);
|
$label = Gtk2::Label->new(" $label_text") unless (defined $mnemonic);
|
$label = Gtk2::Label->new_with_mnemonic (" $label_text") if (defined $mnemonic);
|
$label = Gtk2::Label->new_with_mnemonic (" $label_text") if (defined $mnemonic);
|
$box->pack_start($label, TRUE, FALSE, 0);
|
$box->pack_start($label, TRUE, FALSE, 0);
|
}
|
}
|
|
|
return $box;
|
return $box;
|
|
|
}
|
}
|
|
|
|
|
sub gen_button_message {
|
sub gen_button_message {
|
my ($help, $image_file,$label_name)= @_;
|
my ($help, $image_file,$label_name)= @_;
|
my $box = def_hbox(FALSE, 0);
|
my $box = def_hbox(FALSE, 0);
|
my $label= gen_label_in_center($label_name) if(defined $label_name);
|
my $label= gen_label_in_center($label_name) if(defined $label_name);
|
my $button=def_image_button($image_file);
|
my $button=def_image_button($image_file);
|
|
|
if(defined $help ){$button->signal_connect("clicked" => sub {message_dialog($help);});}
|
if(defined $help ){$button->signal_connect("clicked" => sub {message_dialog($help);});}
|
|
|
$box->pack_start( $label, FALSE, FALSE, 0) if(defined $label_name);
|
$box->pack_start( $label, FALSE, FALSE, 0) if(defined $label_name);
|
$box->pack_start( $button, FALSE, FALSE, 0);
|
$box->pack_start( $button, FALSE, FALSE, 0);
|
$box->set_border_width(0);
|
$box->set_border_width(0);
|
$box->set_spacing (0);
|
$box->set_spacing (0);
|
$box->show_all;
|
$box->show_all;
|
|
|
return $box;
|
return $box;
|
|
|
|
|
}
|
}
|
|
|
|
|
sub def_colored_button{
|
sub def_colored_button{
|
my ($label_text,$color_num)=@_;
|
my ($label_text,$color_num)=@_;
|
# create box for image and label
|
# create box for image and label
|
my $box = def_hbox(FALSE,0);
|
my $box = def_hbox(FALSE,0);
|
my $font_size=get_defualt_font_size();
|
my $font_size=get_defualt_font_size();
|
|
|
my ($red,$green,$blue) = get_color($color_num);
|
my ($red,$green,$blue) = get_color($color_num);
|
my $button = ColorButton->new (red => $red, green => $green, blue => $blue, label=>"$label_text");
|
my $button = ColorButton->new (red => $red, green => $green, blue => $blue, label=>"$label_text");
|
|
|
$button->set_border_width(0);
|
$button->set_border_width(0);
|
$button->show_all;
|
$button->show_all;
|
return $button;
|
return $button;
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
sub entry_set_text_color {
|
sub entry_set_text_color {
|
my ($entry,$color_num)=@_;
|
my ($entry,$color_num)=@_;
|
my ($red,$green,$blue) = get_color($color_num);
|
my ($red,$green,$blue) = get_color($color_num);
|
my $color = Gtk2::Gdk::Color->new ($red,$green,$blue);
|
my $color = Gtk2::Gdk::Color->new ($red,$green,$blue);
|
$entry->modify_text('normal' , $color);
|
$entry->modify_text('normal' , $color);
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub show_gif{
|
sub show_gif{
|
my $gif = shift;
|
my $gif = shift;
|
$gif=find_icon( $gif);
|
$gif=find_icon( $gif);
|
my $vbox = Gtk2::HBox->new (TRUE, 8);
|
my $vbox = Gtk2::HBox->new (TRUE, 8);
|
my $filename;
|
my $filename;
|
eval {
|
eval {
|
$filename = main::demo_find_file ($gif);
|
$filename = main::demo_find_file ($gif);
|
};
|
};
|
my $image = Gtk2::Image->new_from_file ($gif);
|
my $image = Gtk2::Image->new_from_file ($gif);
|
$vbox->set_border_width (4);
|
$vbox->set_border_width (4);
|
my $align = Gtk2::Alignment->new (0.5, 0.5, 0, 0);
|
my $align = Gtk2::Alignment->new (0.5, 0.5, 0, 0);
|
my $frame = Gtk2::Frame->new;
|
my $frame = Gtk2::Frame->new;
|
$frame->set_shadow_type ('in');
|
$frame->set_shadow_type ('in');
|
# Animation
|
# Animation
|
$frame->add ($image);
|
$frame->add ($image);
|
$align->add ($frame);
|
$align->add ($frame);
|
$vbox->pack_start ($align, FALSE, FALSE, 0);
|
$vbox->pack_start ($align, FALSE, FALSE, 0);
|
return $vbox;
|
return $vbox;
|
}
|
}
|
|
|
sub gen_radiobutton {
|
sub gen_radiobutton {
|
my ($from,$label,$icon,$tip) =@_;
|
my ($from,$label,$icon,$tip) =@_;
|
my $rbtn = (defined $from )? Gtk2::RadioToolButton->new_from_widget($from) : Gtk2::RadioToolButton->new (undef);
|
my $rbtn = (defined $from )? Gtk2::RadioToolButton->new_from_widget($from) : Gtk2::RadioToolButton->new (undef);
|
$rbtn->set_label ($label) if(defined $label);
|
$rbtn->set_label ($label) if(defined $label);
|
$rbtn->set_icon_widget (def_icon($icon)) if(defined $icon);
|
$rbtn->set_icon_widget (def_icon($icon)) if(defined $icon);
|
set_tip($rbtn, $tip) if(defined $tip);
|
set_tip($rbtn, $tip) if(defined $tip);
|
return $rbtn;
|
return $rbtn;
|
}
|
}
|
|
|
sub gen_colored_label{
|
sub gen_colored_label{
|
my ($label_text, $color_num)=@_;
|
my ($label_text, $color_num)=@_;
|
|
|
my $color_hex = get_color_hex_string($color_num);
|
my $color_hex = get_color_hex_string($color_num);
|
my $label = Gtk2::Label->new($label_text);
|
my $label = Gtk2::Label->new($label_text);
|
$label->set_markup("<span
|
$label->set_markup("<span
|
background= '#$color_hex'
|
background= '#$color_hex'
|
foreground= 'black' ><b>$label_text</b></span>");
|
foreground= 'black' ><b>$label_text</b></span>");
|
|
|
return $label;
|
return $label;
|
}
|
}
|
|
|
|
|
############
|
############
|
# message_dialog
|
# message_dialog
|
############
|
############
|
|
|
sub message_dialog {
|
sub message_dialog {
|
my ($message,$type)=@_;
|
my ($message,$type)=@_;
|
$type = 'info' if (!defined $type);
|
$type = 'info' if (!defined $type);
|
my $window;
|
my $window;
|
my $dialog = Gtk2::MessageDialog->new ($window,
|
my $dialog = Gtk2::MessageDialog->new ($window,
|
[qw/modal destroy-with-parent/],
|
[qw/modal destroy-with-parent/],
|
$type,
|
$type,
|
'ok',
|
'ok',
|
$message);
|
$message);
|
$dialog->run;
|
$dialog->run;
|
$dialog->destroy;
|
$dialog->destroy;
|
|
|
}
|
}
|
|
|
|
|
|
|
sub set_tip{
|
sub set_tip{
|
my ($widget,$tip)=@_;
|
my ($widget,$tip)=@_;
|
my $tooltips = Gtk2::Tooltips->new;
|
my $tooltips = Gtk2::Tooltips->new;
|
$tooltips->set_tip($widget,$tip);
|
$tooltips->set_tip($widget,$tip);
|
|
|
|
|
}
|
}
|
|
|
|
|
sub yes_no_dialog {
|
sub yes_no_dialog {
|
my ($message)=@_;
|
my ($message)=@_;
|
my $dialog = Gtk2::MessageDialog->new (my $window,
|
my $dialog = Gtk2::MessageDialog->new (my $window,
|
'destroy-with-parent',
|
'destroy-with-parent',
|
'question', # message type
|
'question', # message type
|
'yes-no', # which set of buttons?
|
'yes-no', # which set of buttons?
|
"$message");
|
"$message");
|
my $response = $dialog->run;
|
my $response = $dialog->run;
|
$dialog->destroy;
|
$dialog->destroy;
|
return $response;
|
return $response;
|
}
|
}
|
|
|
sub create_dialog {
|
sub create_dialog {
|
my ($message_head,$message_body,$icon,@buttons)=@_;
|
my ($message_head,$message_body,$icon,@buttons)=@_;
|
# create a new dialog with some buttons - one stock, one not.
|
# create a new dialog with some buttons - one stock, one not.
|
my %hash1;
|
my %hash1;
|
my %hash2;
|
my %hash2;
|
my $i=0;
|
my $i=0;
|
foreach my $b (@buttons){
|
foreach my $b (@buttons){
|
$hash1{$b}=$i;
|
$hash1{$b}=$i;
|
$hash2{$i}=$b;
|
$hash2{$i}=$b;
|
$i++;
|
$i++;
|
}
|
}
|
|
|
my $dialog = Gtk2::Dialog->new (
|
my $dialog = Gtk2::Dialog->new (
|
" ",
|
" ",
|
Gtk2::Window->new('toplevel'),
|
Gtk2::Window->new('toplevel'),
|
[qw/modal destroy-with-parent/],
|
[qw/modal destroy-with-parent/],
|
%hash1
|
%hash1
|
);
|
);
|
my $content = $dialog->get_content_area ();
|
my $content = $dialog->get_content_area ();
|
|
|
my $table = def_table(1,3,TRUE);
|
my $table = def_table(1,3,TRUE);
|
$table->attach (def_icon($icon) , 0, 1, 0, 2,'expand','expand',2,2) if(defined $icon);
|
$table->attach (def_icon($icon) , 0, 1, 0, 2,'expand','expand',2,2) if(defined $icon);
|
if(defined $message_head){
|
if(defined $message_head){
|
my $hd=gen_label_in_left($message_head);
|
my $hd=gen_label_in_left($message_head);
|
$hd->set_markup("<span foreground= 'black' ><b>$message_head</b></span>");
|
$hd->set_markup("<span foreground= 'black' ><b>$message_head</b></span>");
|
$table->attach ($hd , 1, 10, 0, 1,'fill','shrink',2,2);
|
$table->attach ($hd , 1, 10, 0, 1,'fill','shrink',2,2);
|
}
|
}
|
if(defined $message_head){
|
if(defined $message_head){
|
$table->attach (gen_label_in_left($message_body) , 2, 10, 1, 2,'fill','shrink',2,2);
|
$table->attach (gen_label_in_left($message_body) , 2, 10, 1, 2,'fill','shrink',2,2);
|
}
|
}
|
|
|
$content->add ($table);
|
$content->add ($table);
|
$content->show_all;
|
$content->show_all;
|
|
|
$dialog->set_transient_for (Gtk2::Window->new('toplevel'));#just to get rid of transient warning
|
$dialog->set_transient_for (Gtk2::Window->new('toplevel'));#just to get rid of transient warning
|
my $response = $dialog->run;
|
my $response = $dialog->run;
|
|
|
$dialog->destroy;
|
$dialog->destroy;
|
return $hash2{$response};
|
return $hash2{$response};
|
}
|
}
|
|
|
|
|
|
|
############
|
############
|
# window
|
# window
|
###########
|
###########
|
|
|
sub def_win {
|
sub def_win {
|
my @titel=shift;
|
my @titel=shift;
|
my $window = Gtk2::Window->new('toplevel');
|
my $window = Gtk2::Window->new('toplevel');
|
$window->set_title(@titel);
|
$window->set_title(@titel);
|
$window->set_position("center");
|
$window->set_position("center");
|
$window->set_default_size(100, 100);
|
$window->set_default_size(100, 100);
|
$window->set_border_width(20);
|
$window->set_border_width(20);
|
$window->signal_connect (delete_event => sub { Gtk2->main_quit });
|
$window->signal_connect (delete_event => sub { Gtk2->main_quit });
|
return $window;
|
return $window;
|
|
|
}
|
}
|
|
|
|
|
sub def_win_size {
|
sub def_win_size {
|
my $x=shift;
|
my $x=shift;
|
my $y=shift;
|
my $y=shift;
|
my @titel=shift;
|
my @titel=shift;
|
my $window = Gtk2::Window->new('toplevel');
|
my $window = Gtk2::Window->new('toplevel');
|
$window->set_title(@titel);
|
$window->set_title(@titel);
|
$window->set_position("center");
|
$window->set_position("center");
|
$window->set_default_size($x, $y);
|
$window->set_default_size($x, $y);
|
$window->set_border_width(20);
|
$window->set_border_width(20);
|
$window->signal_connect (delete_event => sub { Gtk2->main_quit });
|
$window->signal_connect (delete_event => sub { Gtk2->main_quit });
|
return $window;
|
return $window;
|
|
|
}
|
}
|
|
|
|
|
sub def_popwin_size {
|
sub def_popwin_size {
|
my ($x,$y,$titel,$unit)=@_;
|
my ($x,$y,$titel,$unit)=@_;
|
if(defined $unit){
|
if(defined $unit){
|
my($width,$hight)=max_win_size();
|
my($width,$hight)=max_win_size();
|
if($unit eq 'percent'){
|
if($unit eq 'percent'){
|
$x= ($x * $width)/100;
|
$x= ($x * $width)/100;
|
$y= ($y * $hight)/100;
|
$y= ($y * $hight)/100;
|
} # else its pixels
|
} # else its pixels
|
|
|
}
|
}
|
#my $window = Gtk2::Window->new('popup');
|
#my $window = Gtk2::Window->new('popup');
|
my $window = Gtk2::Window->new('toplevel');
|
my $window = Gtk2::Window->new('toplevel');
|
$window->set_title($titel);
|
$window->set_title($titel);
|
$window->set_position("center");
|
$window->set_position("center");
|
$window->set_default_size($x, $y);
|
$window->set_default_size($x, $y);
|
$window->set_border_width(20);
|
$window->set_border_width(20);
|
#$window->signal_connect (delete_event => sub { $window->destroy });
|
#$window->signal_connect (delete_event => sub { $window->destroy });
|
return $window;
|
return $window;
|
|
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
sub def_scrolled_window_box{
|
sub def_scrolled_window_box{
|
|
|
my $window = def_popwin_size(@_);
|
my $window = def_popwin_size(@_);
|
my $box=def_vbox(TRUE,5);
|
my $box=def_vbox(TRUE,5);
|
my $scrolled_window = new Gtk2::ScrolledWindow (undef, undef);
|
my $scrolled_window = new Gtk2::ScrolledWindow (undef, undef);
|
$scrolled_window->set_policy( "automatic", "automatic" );
|
$scrolled_window->set_policy( "automatic", "automatic" );
|
$scrolled_window->add_with_viewport($box);
|
$scrolled_window->add_with_viewport($box);
|
$window->add($scrolled_window);
|
$window->add($scrolled_window);
|
$window->show_all;
|
$window->show_all;
|
$box->show_all;
|
$box->show_all;
|
return ($box,$window);
|
return ($box,$window);
|
|
|
}
|
}
|
|
|
|
|
|
sub get_default_screen {
|
|
return Gtk2::Gdk::Screen->get_default();
|
|
|
|
|
sub max_win_size{
|
|
my $screen =Gtk2::Gdk::Screen->get_default();
|
|
my $hight = $screen->get_height();
|
|
my $width = $screen->get_width();
|
|
return ($width,$hight);
|
|
}
|
}
|
|
|
|
|
|
|
sub get_defualt_font_size{
|
sub get_defualt_font_size{
|
return int($FONT_SIZE) if ($FONT_SIZE ne 'default');
|
return int($glob_setting{'FONT_SIZE'}) if ($glob_setting{'FONT_SIZE'} ne 'default');
|
|
|
my($width,$hight)=max_win_size();
|
my($width,$hight)=max_win_size();
|
#print "($width,$hight)\n";
|
#print "($width,$hight)\n";
|
my $font_size=($width>=1600)? 10:
|
my $font_size=($width>=1600)? 10:
|
($width>=1400)? 9:
|
($width>=1400)? 9:
|
($width>=1200)? 9:
|
($width>=1200)? 9:
|
($width>=1000)? 7:6;
|
($width>=1000)? 8:7;
|
#print "$font_size\n";
|
#print "$font_size\n";
|
return $font_size;
|
return $font_size;
|
}
|
}
|
|
|
|
|
sub set_defualt_font_size{
|
sub set_defualt_font_size{
|
my $font_size=get_defualt_font_size();
|
my $font_size=get_defualt_font_size();
|
#$font_size= int (1.5*$font_size);
|
#$font_size= int (1.5*$font_size);
|
Gtk2::Rc->parse_string(<<__);
|
Gtk2::Rc->parse_string(<<__);
|
style "normal" {
|
style "normal" {
|
font_name ="Verdana $font_size"
|
font_name ="Verdana $font_size"
|
}
|
}
|
widget "*" style "normal"
|
widget "*" style "normal"
|
__
|
__
|
|
|
}
|
}
|
|
|
|
|
|
|
sub add_widget_to_scrolled_win{
|
sub add_widget_to_scrolled_win{
|
my ($widget,$scrolled_win) =@_;
|
my ($widget,$scrolled_win) =@_;
|
if(! defined $scrolled_win){
|
if(! defined $scrolled_win){
|
$scrolled_win = new Gtk2::ScrolledWindow (undef, undef);
|
$scrolled_win = new Gtk2::ScrolledWindow (undef, undef);
|
$scrolled_win->set_policy( "automatic", "automatic" );
|
$scrolled_win->set_policy( "automatic", "automatic" );
|
}
|
}
|
$scrolled_win->add_with_viewport($widget) if(defined $widget);
|
$scrolled_win->add_with_viewport($widget) if(defined $widget);
|
#$scrolled_win->set_shadow_type('in');
|
#$scrolled_win->set_shadow_type('in');
|
#$scrolled_win->show_all;
|
#$scrolled_win->show_all;
|
return $scrolled_win;
|
return $scrolled_win;
|
}
|
}
|
|
|
sub gen_scr_win_with_adjst {
|
sub gen_scr_win_with_adjst {
|
my ($self,$name)=@_;
|
my ($self,$name)=@_;
|
my $scrolled_win = new Gtk2::ScrolledWindow (undef, undef);
|
my $scrolled_win = new Gtk2::ScrolledWindow (undef, undef);
|
$scrolled_win->set_policy( "automatic", "automatic" );
|
$scrolled_win->set_policy( "automatic", "automatic" );
|
$scrolled_win->signal_connect("destroy"=> sub{
|
$scrolled_win->signal_connect("destroy"=> sub{
|
save_scrolled_win_adj($self,$scrolled_win, $name);
|
save_scrolled_win_adj($self,$scrolled_win, $name);
|
|
|
});
|
});
|
my $adjast=0;
|
my $adjast=0;
|
$scrolled_win->signal_connect("size-allocate"=> sub{
|
$scrolled_win->signal_connect("size-allocate"=> sub{
|
if($adjast==0){
|
if($adjast==0){
|
load_scrolled_win_adj($self,$scrolled_win, $name);
|
load_scrolled_win_adj($self,$scrolled_win, $name);
|
$adjast=1;
|
$adjast=1;
|
}
|
}
|
|
|
});
|
});
|
return $scrolled_win;
|
return $scrolled_win;
|
}
|
}
|
|
|
|
|
sub save_scrolled_win_adj {
|
sub save_scrolled_win_adj {
|
my ($self,$scrolled_win,$name)=@_;
|
my ($self,$scrolled_win,$name)=@_;
|
my $ha= $scrolled_win->get_hadjustment();
|
my $ha= $scrolled_win->get_hadjustment();
|
my $va =$scrolled_win->get_vadjustment();
|
my $va =$scrolled_win->get_vadjustment();
|
return if(!defined $ha);
|
return if(!defined $ha);
|
return if(!defined $va);
|
return if(!defined $va);
|
save_adj ($self,$ha,$name,"ha");
|
save_adj ($self,$ha,$name,"ha");
|
save_adj ($self,$va,$name,"va");
|
save_adj ($self,$va,$name,"va");
|
}
|
}
|
|
|
|
|
sub load_scrolled_win_adj {
|
sub load_scrolled_win_adj {
|
my ($self,$scrolled_win,$name)=@_;
|
my ($self,$scrolled_win,$name)=@_;
|
my $ha= $scrolled_win->get_hadjustment();
|
my $ha= $scrolled_win->get_hadjustment();
|
my $va =$scrolled_win->get_vadjustment();
|
my $va =$scrolled_win->get_vadjustment();
|
my $h=load_adj ($self,$ha,$name,"ha");
|
my $h=load_adj ($self,$ha,$name,"ha");
|
my $v=load_adj ($self,$va,$name,"va");
|
my $v=load_adj ($self,$va,$name,"va");
|
#$ha->set_value($h) if(defined $h);
|
#$ha->set_value($h) if(defined $h);
|
#$va->set_value($v) if(defined $v);
|
#$va->set_value($v) if(defined $v);
|
}
|
}
|
|
|
|
|
|
|
|
|
sub save_adj {
|
sub save_adj {
|
my ($self,$adjustment,$at1,$at2)=@_;
|
my ($self,$adjustment,$at1,$at2)=@_;
|
my $value = $adjustment->value;
|
my $value = $adjustment->value;
|
$self->object_add_attribute($at1,$at2,$value);
|
$self->object_add_attribute($at1,$at2,$value);
|
}
|
}
|
|
|
|
|
sub load_adj {
|
sub load_adj {
|
my ($self,$adjustment,$at1,$at2)=@_;
|
my ($self,$adjustment,$at1,$at2)=@_;
|
return if(!defined $at1);
|
return if(!defined $at1);
|
my $value= $self->object_get_attribute($at1,$at2);
|
my $value= $self->object_get_attribute($at1,$at2);
|
return if(!defined $value);
|
return if(!defined $value);
|
my $lower = $adjustment->lower;
|
my $lower = $adjustment->lower;
|
my $upper = $adjustment->upper - $adjustment->page_size;
|
my $upper = $adjustment->upper - $adjustment->page_size;
|
$value= ($value < $lower || $value > $upper ) ? 0 : $value;
|
$value= ($value < $lower || $value > $upper ) ? 0 : $value;
|
|
|
$adjustment->set_value($value);
|
$adjustment->set_value($value);
|
}
|
}
|
|
|
sub set_pronoc_icon{
|
sub set_pronoc_icon{
|
my $window=shift;
|
my $window=shift;
|
my $navIco = gen_pixbuf("./icons/ProNoC.png");
|
my $navIco = gen_pixbuf("./icons/ProNoC.png");
|
$window->set_default_icon($navIco);
|
$window->set_default_icon($navIco);
|
}
|
}
|
|
|
##############
|
##############
|
# box
|
# box
|
#############
|
#############
|
|
|
sub def_hbox {
|
sub def_hbox {
|
my( $homogeneous, $spacing)=@_;
|
my( $homogeneous, $spacing)=@_;
|
my $box = Gtk2::HBox->new($homogeneous, $spacing);
|
my $box = Gtk2::HBox->new($homogeneous, $spacing);
|
$box->set_border_width(2);
|
$box->set_border_width(2);
|
return $box;
|
return $box;
|
}
|
}
|
|
|
sub def_vbox {
|
sub def_vbox {
|
my $box = Gtk2::VBox->new(FALSE, 0);
|
my $box = Gtk2::VBox->new(FALSE, 0);
|
$box->set_border_width(2);
|
$box->set_border_width(2);
|
return $box;
|
return $box;
|
}
|
}
|
|
|
sub def_pack_hbox{
|
sub def_pack_hbox{
|
my( $homogeneous, $spacing , @box_list)=@_;
|
my( $homogeneous, $spacing , @box_list)=@_;
|
my $box=def_hbox($homogeneous, $spacing);
|
my $box=def_hbox($homogeneous, $spacing);
|
foreach my $subbox (@box_list){
|
foreach my $subbox (@box_list){
|
$box->pack_start( $subbox, FALSE, FALSE, 3);
|
$box->pack_start( $subbox, FALSE, FALSE, 3);
|
}
|
}
|
return $box;
|
return $box;
|
|
|
|
|
}
|
}
|
|
|
sub def_pack_vbox{
|
sub def_pack_vbox{
|
my( $homogeneous, $spacing , @box_list)=@_;
|
my( $homogeneous, $spacing , @box_list)=@_;
|
my $box=def_vbox($homogeneous, $spacing);
|
my $box=def_vbox($homogeneous, $spacing);
|
foreach my $subbox (@box_list){
|
foreach my $subbox (@box_list){
|
$box->pack_start( $subbox, FALSE, FALSE, 3);
|
$box->pack_start( $subbox, FALSE, FALSE, 3);
|
}
|
}
|
return $box;
|
return $box;
|
|
|
}
|
}
|
|
|
|
|
##########
|
##########
|
# Paned
|
# Paned
|
#########
|
#########
|
|
|
|
|
sub gen_vpaned {
|
sub gen_vpaned {
|
my ($w1,$loc,$w2) = @_;
|
my ($w1,$loc,$w2) = @_;
|
my $vpaned = Gtk2::VPaned -> new;
|
my $vpaned = Gtk2::VPaned -> new;
|
my($width,$hight)=max_win_size();
|
my($width,$hight)=max_win_size();
|
|
|
$vpaned -> pack1($w1, TRUE, TRUE);
|
$vpaned -> pack1($w1, TRUE, TRUE);
|
$vpaned -> set_position ($hight*$loc);
|
$vpaned -> set_position ($hight*$loc);
|
$vpaned -> pack2($w2, TRUE, TRUE);
|
$vpaned -> pack2($w2, TRUE, TRUE);
|
|
|
return $vpaned;
|
return $vpaned;
|
}
|
}
|
|
|
|
|
sub gen_hpaned {
|
sub gen_hpaned {
|
my ($w1,$loc,$w2) = @_;
|
my ($w1,$loc,$w2) = @_;
|
my $hpaned = Gtk2::HPaned -> new;
|
my $hpaned = Gtk2::HPaned -> new;
|
my($width,$hight)=max_win_size();
|
my($width,$hight)=max_win_size();
|
|
|
|
|
$hpaned -> pack1($w1, TRUE, TRUE);
|
$hpaned -> pack1($w1, TRUE, TRUE);
|
$hpaned -> set_position ($width*$loc);
|
$hpaned -> set_position ($width*$loc);
|
$hpaned -> pack2($w2, TRUE, TRUE);
|
$hpaned -> pack2($w2, TRUE, TRUE);
|
|
|
return $hpaned;
|
return $hpaned;
|
}
|
}
|
|
|
sub gen_hpaned_adj {
|
sub gen_hpaned_adj {
|
my ($self,$w1,$loc,$w2,$name) = @_;
|
my ($self,$w1,$loc,$w2,$name) = @_;
|
my $hpaned = Gtk2::HPaned -> new;
|
my $hpaned = Gtk2::HPaned -> new;
|
$hpaned -> pack1($w1, TRUE, TRUE);
|
$hpaned -> pack1($w1, TRUE, TRUE);
|
$hpaned -> pack2($w2, TRUE, TRUE);
|
$hpaned -> pack2($w2, TRUE, TRUE);
|
|
|
$hpaned->signal_connect("destroy"=> sub{
|
$hpaned->signal_connect("destroy"=> sub{
|
my $adj = $hpaned->get_position ();
|
my $adj = $hpaned->get_position ();
|
$self->object_add_attribute("adj",$name,$adj);
|
$self->object_add_attribute("adj",$name,$adj);
|
});
|
});
|
|
|
my $val =$self->object_get_attribute("adj",$name);
|
my $val =$self->object_get_attribute("adj",$name);
|
if(defined $val){
|
if(defined $val){
|
$hpaned -> set_position ($val);
|
$hpaned -> set_position ($val);
|
} else{
|
} else{
|
my($width,$hight)=max_win_size();
|
my($width,$hight)=max_win_size();
|
$hpaned -> set_position ($width*$loc);
|
$hpaned -> set_position ($width*$loc);
|
}
|
}
|
|
|
return $hpaned;
|
return $hpaned;
|
}
|
}
|
|
|
|
|
#############
|
#############
|
# text_view
|
# text_view
|
############
|
############
|
|
|
sub create_txview {
|
sub create_txview {
|
my $scrolled_window = Gtk2::ScrolledWindow->new;
|
my $scrolled_window = Gtk2::ScrolledWindow->new;
|
$scrolled_window->set_policy ('automatic', 'automatic');
|
$scrolled_window->set_policy ('automatic', 'automatic');
|
$scrolled_window->set_shadow_type ('in');
|
$scrolled_window->set_shadow_type ('in');
|
my $tview = Gtk2::TextView->new();
|
my $tview = Gtk2::TextView->new();
|
$scrolled_window->add ($tview);
|
$scrolled_window->add ($tview);
|
$tview->show_all;
|
$tview->show_all;
|
# Make it a bit nicer for text.
|
# Make it a bit nicer for text.
|
$tview->set_wrap_mode ('word');
|
$tview->set_wrap_mode ('word');
|
$tview->set_pixels_above_lines (2);
|
$tview->set_pixels_above_lines (2);
|
$tview->set_pixels_below_lines (2);
|
$tview->set_pixels_below_lines (2);
|
# $scrolled_window->set_placement('bottom_left' );
|
# $scrolled_window->set_placement('bottom_left' );
|
add_colors_to_textview($tview);
|
add_colors_to_textview($tview);
|
|
|
return ($scrolled_window,$tview);
|
return ($scrolled_window,$tview);
|
}
|
}
|
|
|
|
|
sub txview_scrol_to_end {
|
sub txview_scrol_to_end {
|
my $tview =shift;
|
my $tview =shift;
|
my $buffer = $tview->get_buffer;
|
my $buffer = $tview->get_buffer;
|
my $end_mark = $buffer->create_mark( 'end', $buffer->get_end_iter, 0 );
|
my $end_mark = $buffer->create_mark( 'end', $buffer->get_end_iter, 0 );
|
$tview->scroll_to_mark( $end_mark, 0.0,0, 0.0, 1.0 );
|
$tview->scroll_to_mark( $end_mark, 0.0,0, 0.0, 1.0 );
|
}
|
}
|
|
|
|
|
|
|
#################
|
#################
|
# table
|
# table
|
################
|
################
|
|
|
sub def_table{
|
sub def_table{
|
my ($row,$col,$homogeneous)=@_;
|
my ($row,$col,$homogeneous)=@_;
|
my $table = Gtk2::Table->new ($row, $col, $homogeneous);
|
my $table = Gtk2::Table->new ($row, $col, $homogeneous);
|
$table->set_row_spacings (0);
|
$table->set_row_spacings (0);
|
$table->set_col_spacings (0);
|
$table->set_col_spacings (0);
|
return $table;
|
return $table;
|
|
|
}
|
}
|
|
|
sub attach_widget_to_table {
|
sub attach_widget_to_table {
|
my ($table,$row,$label,$inf_bt,$widget,$column)=@_;
|
my ($table,$row,$label,$inf_bt,$widget,$column)=@_;
|
$column = 0 if(!defined $column);
|
$column = 0 if(!defined $column);
|
#$column *=4;
|
#$column *=4;
|
#my $tmp=gen_label_in_left(" ");
|
#my $tmp=gen_label_in_left(" ");
|
if(defined $label) {$table->attach ($label , $column, $column+1, $row,$row+1,'fill','shrink',2,2);$column++;}
|
if(defined $label) {$table->attach ($label , $column, $column+1, $row,$row+1,'fill','shrink',2,2);$column++;}
|
if(defined $inf_bt) {$table->attach ($inf_bt , $column, $column+1, $row,$row+1,'fill','shrink',2,2);$column++;}
|
if(defined $inf_bt) {$table->attach ($inf_bt , $column, $column+1, $row,$row+1,'fill','shrink',2,2);$column++;}
|
if(defined $widget) {$table->attach ($widget , $column, $column+1, $row,$row+1,'fill','shrink',2,2);$column++;}
|
if(defined $widget) {$table->attach ($widget , $column, $column+1, $row,$row+1,'fill','shrink',2,2);$column++;}
|
#$table->attach ($tmp , $column+3, $column+4, $row,$row+1,'fill','shrink',2,2);
|
#$table->attach ($tmp , $column+3, $column+4, $row,$row+1,'fill','shrink',2,2);
|
}
|
}
|
|
|
sub gen_Hsep {
|
sub gen_Hsep {
|
return Gtk2::HSeparator->new;
|
return Gtk2::HSeparator->new;
|
}
|
}
|
|
|
sub gen_Vsep {
|
sub gen_Vsep {
|
return Gtk2::VSeparator->new;
|
return Gtk2::VSeparator->new;
|
}
|
}
|
|
|
|
|
sub add_Hsep_to_table {
|
sub add_Hsep_to_table {
|
my($table,$col0,$col1,$row)=@_;
|
my($table,$col0,$col1,$row)=@_;
|
my $separator = gen_Hsep();
|
my $separator = gen_Hsep();
|
$table->attach ($separator ,$col0,$col1 , $row, $row+1,'fill','fill',2,2);
|
$table->attach ($separator ,$col0,$col1 , $row, $row+1,'fill','fill',2,2);
|
}
|
}
|
|
|
sub add_Vsep_to_table {
|
sub add_Vsep_to_table {
|
my($table,$col,$row1,$row2)=@_;
|
my($table,$col,$row1,$row2)=@_;
|
my $separator = gen_Vsep();
|
my $separator = gen_Vsep();
|
$table->attach ($separator ,$col,$col+1 , $row1, $row2,'fill','fill',2,2);
|
$table->attach ($separator ,$col,$col+1 , $row1, $row2,'fill','fill',2,2);
|
}
|
}
|
|
|
|
|
##################
|
##################
|
# show_info
|
# show_info
|
##################
|
##################
|
sub show_info{
|
sub show_info{
|
my ($textview,$info)=@_;
|
my ($textview,$info)=@_;
|
#return;# if(!defined $textview_ref);
|
#return;# if(!defined $textview_ref);
|
#print "$textview_ref\n";
|
#print "$textview_ref\n";
|
my $buffer = $textview->get_buffer();
|
my $buffer = $textview->get_buffer();
|
$buffer->set_text($info);
|
$buffer->set_text($info);
|
txview_scrol_to_end($textview);
|
txview_scrol_to_end($textview);
|
}
|
}
|
|
|
sub add_info{
|
sub add_info{
|
my ($textview,$info)=@_;
|
my ($textview,$info)=@_;
|
my $buffer = $textview->get_buffer();
|
my $buffer = $textview->get_buffer();
|
my $textiter = $buffer->get_end_iter();
|
my $textiter = $buffer->get_end_iter();
|
#Insert some text into the buffer
|
#Insert some text into the buffer
|
$buffer->insert($textiter,$info);
|
$buffer->insert($textiter,$info);
|
txview_scrol_to_end($textview);
|
txview_scrol_to_end($textview);
|
|
|
}
|
}
|
|
|
|
|
sub show_colored_info{
|
sub show_colored_info{
|
my ($textview,$info,$color)=@_;
|
my ($textview,$info,$color)=@_;
|
my $buffer = $textview->get_buffer();
|
my $buffer = $textview->get_buffer();
|
#$buffer->set_text($info);
|
#$buffer->set_text($info);
|
my $textiter = $buffer->get_start_iter();
|
my $textiter = $buffer->get_start_iter();
|
$buffer->insert_with_tags_by_name ($textiter, "$info", "${color}_tag");
|
$buffer->insert_with_tags_by_name ($textiter, "$info", "${color}_tag");
|
txview_scrol_to_end($textview);
|
txview_scrol_to_end($textview);
|
}
|
}
|
|
|
sub add_colored_info{
|
sub add_colored_info{
|
my ($textview,$info,$color)=@_;
|
my ($textview,$info,$color)=@_;
|
my $buffer = $textview->get_buffer();
|
my $buffer = $textview->get_buffer();
|
my $textiter = $buffer->get_end_iter();
|
my $textiter = $buffer->get_end_iter();
|
$buffer->insert_with_tags_by_name ($textiter, "$info", "${color}_tag");
|
$buffer->insert_with_tags_by_name ($textiter, "$info", "${color}_tag");
|
txview_scrol_to_end($textview);
|
txview_scrol_to_end($textview);
|
|
|
}
|
}
|
|
|
sub add_colors_to_textview{
|
sub add_colors_to_textview{
|
my $tview= shift;
|
my $tview= shift;
|
add_colored_tag($tview,'red');
|
add_colored_tag($tview,'red');
|
add_colored_tag($tview,'blue');
|
add_colored_tag($tview,'blue');
|
add_colored_tag($tview,'brown');
|
add_colored_tag($tview,'brown');
|
add_colored_tag($tview,'green');
|
add_colored_tag($tview,'green');
|
}
|
}
|
|
|
|
|
sub add_colored_tag{
|
sub add_colored_tag{
|
my ($textview_ref,$color)=@_;
|
my ($textview_ref,$color)=@_;
|
my $buffer = $textview_ref->get_buffer();
|
my $buffer = $textview_ref->get_buffer();
|
$buffer->create_tag ("${color}_tag", foreground => $color);
|
$buffer->create_tag ("${color}_tag", foreground => $color);
|
}
|
}
|
|
|
sub add_color_to_gd{
|
sub add_color_to_gd{
|
foreach (my $i=0;$i<32;$i++ ) {
|
foreach (my $i=0;$i<32;$i++ ) {
|
my ($red,$green,$blue)=get_color($i);
|
my ($red,$green,$blue)=get_color($i);
|
add_colour("my_color$i"=>[$red>>8,$green>>8,$blue>>8]);
|
add_colour("my_color$i"=>[$red>>8,$green>>8,$blue>>8]);
|
|
|
}
|
}
|
}
|
}
|
|
|
|
|
|
|
############
|
############
|
# get file folder list
|
# get file folder list
|
###########
|
###########
|
|
|
sub get_directory_name_widget {
|
sub get_directory_name_widget {
|
my ($object,$title,$entry,$attribute1,$attribute2,$status,$timeout)= @_;
|
my ($object,$title,$entry,$attribute1,$attribute2,$status,$timeout)= @_;
|
my $browse= def_image_button("icons/browse.png");
|
my $browse= def_image_button("icons/browse.png");
|
|
|
$browse->signal_connect("clicked"=> sub{
|
$browse->signal_connect("clicked"=> sub{
|
my $entry_ref=$_[1];
|
my $entry_ref=$_[1];
|
my $file;
|
my $file;
|
$title ='select directory' if(!defined $title);
|
$title ='select directory' if(!defined $title);
|
my $dialog = Gtk2::FileChooserDialog->new(
|
my $dialog = Gtk2::FileChooserDialog->new(
|
$title, undef,
|
$title, undef,
|
# 'open',
|
# 'open',
|
'select-folder',
|
'select-folder',
|
'gtk-cancel' => 'cancel',
|
'gtk-cancel' => 'cancel',
|
'gtk-ok' => 'ok',
|
'gtk-ok' => 'ok',
|
);
|
);
|
|
|
|
|
if ( "ok" eq $dialog->run ) {
|
if ( "ok" eq $dialog->run ) {
|
$file = $dialog->get_filename;
|
$file = $dialog->get_filename;
|
$$entry_ref->set_text($file);
|
$$entry_ref->set_text($file);
|
$object->object_add_attribute($attribute1,$attribute2,$file);
|
$object->object_add_attribute($attribute1,$attribute2,$file);
|
set_gui_status($object,$status,$timeout) if(defined $status);
|
set_gui_status($object,$status,$timeout) if(defined $status);
|
#check_input_file($file,$socgen,$soc_state,$info);
|
#check_input_file($file,$socgen,$soc_state,$info);
|
#print "file = $file\n";
|
#print "file = $file\n";
|
}
|
}
|
$dialog->destroy;
|
$dialog->destroy;
|
|
|
|
|
|
|
} , \$entry);
|
} , \$entry);
|
|
|
return $browse;
|
return $browse;
|
|
|
}
|
}
|
|
|
|
|
sub get_dir_name {
|
sub get_dir_name {
|
my ($object,$title,$attribute1,$attribute2,$open_in,$status,$timeout)= @_;
|
my ($object,$title,$attribute1,$attribute2,$open_in,$status,$timeout)= @_;
|
my $dir;
|
my $dir;
|
$title ='select directory' if(!defined $title);
|
$title ='select directory' if(!defined $title);
|
my $dialog = Gtk2::FileChooserDialog->new(
|
my $dialog = Gtk2::FileChooserDialog->new(
|
$title, undef,
|
$title, undef,
|
# 'open',
|
# 'open',
|
'select-folder',
|
'select-folder',
|
'gtk-cancel' => 'cancel',
|
'gtk-cancel' => 'cancel',
|
'gtk-ok' => 'ok',
|
'gtk-ok' => 'ok',
|
);
|
);
|
if(defined $open_in){
|
if(defined $open_in){
|
$dialog->set_current_folder ($open_in);
|
$dialog->set_current_folder ($open_in);
|
}
|
}
|
|
|
if ( "ok" eq $dialog->run ) {
|
if ( "ok" eq $dialog->run ) {
|
$dir = $dialog->get_filename;
|
$dir = $dialog->get_filename;
|
$object->object_add_attribute($attribute1,$attribute2,$dir);
|
$object->object_add_attribute($attribute1,$attribute2,$dir);
|
set_gui_status($object,$status,$timeout) if(defined $status);
|
set_gui_status($object,$status,$timeout) if(defined $status);
|
$dialog->destroy;
|
$dialog->destroy;
|
}
|
}
|
}
|
}
|
|
|
|
|
|
|
sub get_file_name {
|
sub get_file_name {
|
my ($object,$title,$entry,$attribute1,$attribute2,$extension,$label,$open_in)= @_;
|
my ($object,$title,$entry,$attribute1,$attribute2,$extension,$label,$open_in)= @_;
|
my $browse= def_image_button("icons/browse.png");
|
my $browse= def_image_button("icons/browse.png");
|
|
|
$browse->signal_connect("clicked"=> sub{
|
$browse->signal_connect("clicked"=> sub{
|
my $entry_ref=$_[1];
|
my $entry_ref=$_[1];
|
my $file;
|
my $file;
|
$title ='select a file' if(!defined $title);
|
$title ='select a file' if(!defined $title);
|
my $dialog = Gtk2::FileChooserDialog->new(
|
my $dialog = Gtk2::FileChooserDialog->new(
|
'Select a File', undef,
|
'Select a File', undef,
|
'open',
|
'open',
|
'gtk-cancel' => 'cancel',
|
'gtk-cancel' => 'cancel',
|
'gtk-ok' => 'ok',
|
'gtk-ok' => 'ok',
|
);
|
);
|
if(defined $extension){
|
if(defined $extension){
|
my $filter = Gtk2::FileFilter->new();
|
my $filter = Gtk2::FileFilter->new();
|
$filter->set_name($extension);
|
$filter->set_name($extension);
|
$filter->add_pattern("*.$extension");
|
$filter->add_pattern("*.$extension");
|
$dialog->add_filter ($filter);
|
$dialog->add_filter ($filter);
|
}
|
}
|
if(defined $open_in){
|
if(defined $open_in){
|
$dialog->set_current_folder ($open_in);
|
$dialog->set_current_folder ($open_in);
|
# print "$open_in\n";
|
# print "$open_in\n";
|
|
|
}
|
}
|
|
|
if ( "ok" eq $dialog->run ) {
|
if ( "ok" eq $dialog->run ) {
|
$file = $dialog->get_filename;
|
$file = $dialog->get_filename;
|
#remove $project_dir form beginig of each file
|
#remove $project_dir form beginig of each file
|
$file =remove_project_dir_from_addr($file);
|
$file =remove_project_dir_from_addr($file);
|
$$entry_ref->set_text($file);
|
$$entry_ref->set_text($file);
|
$object->object_add_attribute($attribute1,$attribute2,$file) if(defined $object);
|
$object->object_add_attribute($attribute1,$attribute2,$file) if(defined $object);
|
my ($name,$path,$suffix) = fileparse("$file",qr"\..[^.]*$");
|
my ($name,$path,$suffix) = fileparse("$file",qr"\..[^.]*$");
|
if(defined $label){
|
if(defined $label){
|
$label->set_markup("<span foreground= 'black' ><b>$name$suffix</b></span>");
|
$label->set_markup("<span foreground= 'black' ><b>$name$suffix</b></span>");
|
$label->show;
|
$label->show;
|
}
|
}
|
|
|
#check_input_file($file,$socgen,$soc_state,$info);
|
#check_input_file($file,$socgen,$soc_state,$info);
|
#print "file = $file\n";
|
#print "file = $file\n";
|
}
|
}
|
$dialog->destroy;
|
$dialog->destroy;
|
|
|
|
|
|
|
} , \$entry);
|
} , \$entry);
|
|
|
return $browse;
|
return $browse;
|
|
|
}
|
}
|
|
|
sub gen_file_dialog {
|
sub gen_file_dialog {
|
my ($title, @extension)=@_;
|
my ($title, @extension)=@_;
|
$title = 'Select a File' if (!defined $title);
|
$title = 'Select a File' if (!defined $title);
|
|
|
my $dialog = Gtk2::FileChooserDialog->new(
|
my $dialog = Gtk2::FileChooserDialog->new(
|
$title, undef,
|
$title, undef,
|
'open',
|
'open',
|
'gtk-cancel' => 'cancel',
|
'gtk-cancel' => 'cancel',
|
'gtk-ok' => 'ok',
|
'gtk-ok' => 'ok',
|
);
|
);
|
|
|
foreach my $ext (@extension){
|
foreach my $ext (@extension){
|
my $filter = Gtk2::FileFilter->new();
|
my $filter = Gtk2::FileFilter->new();
|
$filter->set_name("$ext");
|
$filter->set_name("$ext");
|
$filter->add_pattern("*.$ext");
|
$filter->add_pattern("*.$ext");
|
$dialog->add_filter ($filter);
|
$dialog->add_filter ($filter);
|
}
|
}
|
|
|
return $dialog;
|
return $dialog;
|
}
|
}
|
|
|
|
|
sub save_file_dialog {
|
sub save_file_dialog {
|
my ($title, @extension)=@_;
|
my ($title, @extension)=@_;
|
$title = 'Select a File' if (!defined $title);
|
$title = 'Select a File' if (!defined $title);
|
|
|
my $dialog = Gtk2::FileChooserDialog->new(
|
my $dialog = Gtk2::FileChooserDialog->new(
|
$title,
|
$title,
|
undef,
|
undef,
|
'save',
|
'save',
|
'gtk-cancel' => 'cancel',
|
'gtk-cancel' => 'cancel',
|
'gtk-ok' => 'ok',
|
'gtk-ok' => 'ok',
|
);
|
);
|
|
|
$dialog->set_modal(TRUE);
|
$dialog->set_modal(TRUE);
|
$dialog->set_transient_for (Gtk2::Window->new('toplevel'));#just to get rid of transient warning
|
$dialog->set_transient_for (Gtk2::Window->new('toplevel'));#just to get rid of transient warning
|
|
|
foreach my $ext (@extension){
|
foreach my $ext (@extension){
|
my $filter = Gtk2::FileFilter->new();
|
my $filter = Gtk2::FileFilter->new();
|
$filter->set_name("$ext");
|
$filter->set_name("$ext");
|
$filter->add_pattern("*.$ext");
|
$filter->add_pattern("*.$ext");
|
$dialog->add_filter ($filter);
|
$dialog->add_filter ($filter);
|
}
|
}
|
|
|
return $dialog;
|
return $dialog;
|
|
|
}
|
}
|
|
|
|
|
|
|
|
|
sub gen_folder_dialog {
|
sub gen_folder_dialog {
|
my ($title)=@_;
|
my ($title)=@_;
|
$title = 'Select Folder' if (!defined $title);
|
$title = 'Select Folder' if (!defined $title);
|
|
|
|
|
|
|
my $dialog = Gtk2::FileChooserDialog->new(
|
my $dialog = Gtk2::FileChooserDialog->new(
|
$title,
|
$title,
|
undef,
|
undef,
|
'select-folder',
|
'select-folder',
|
'gtk-cancel' => 'cancel',
|
'gtk-cancel' => 'cancel',
|
'gtk-ok' => 'ok',
|
'gtk-ok' => 'ok',
|
);
|
);
|
$dialog->set_modal(TRUE);
|
$dialog->set_modal(TRUE);
|
|
|
return $dialog;
|
return $dialog;
|
|
|
}
|
}
|
|
|
|
|
sub get_filenames_from_dialog{
|
sub get_filenames_from_dialog{
|
my $dialog=shift;
|
my $dialog=shift;
|
my @files = $dialog->get_filenames;
|
my @files = $dialog->get_filenames;
|
return @files;
|
return @files;
|
}
|
}
|
|
|
|
|
sub new_dialog_with_buttons {
|
sub new_dialog_with_buttons {
|
my $self =shift;
|
my $self =shift;
|
return Gtk2::Dialog->new_with_buttons(
|
return Gtk2::Dialog->new_with_buttons(
|
"Goto to line",
|
"Goto to line",
|
$self->window,
|
$self->window,
|
[ 'modal' ],
|
[ 'modal' ],
|
'gtk-cancel' => 'cancel',
|
'gtk-cancel' => 'cancel',
|
'gtk-ok' => 'ok',
|
'gtk-ok' => 'ok',
|
);
|
);
|
|
|
}
|
}
|
|
|
|
|
#################
|
#################
|
# widget update object
|
# widget update object
|
#################
|
#################
|
|
|
sub gen_entry_object {
|
sub gen_entry_object {
|
my ($object,$attribute1,$attribute2,$default,$status,$timeout)=@_;
|
my ($object,$attribute1,$attribute2,$default,$status,$timeout)=@_;
|
my $old=$object->object_get_attribute($attribute1,$attribute2);
|
my $old=$object->object_get_attribute($attribute1,$attribute2);
|
my $widget;
|
my $widget;
|
if(defined $old ){
|
if(defined $old ){
|
$widget=gen_entry($old);
|
$widget=gen_entry($old);
|
}
|
}
|
else
|
else
|
{
|
{
|
$widget=gen_entry($default);
|
$widget=gen_entry($default);
|
$object->object_add_attribute($attribute1,$attribute2,$default);
|
$object->object_add_attribute($attribute1,$attribute2,$default);
|
}
|
}
|
$widget-> signal_connect("changed" => sub{
|
$widget-> signal_connect("changed" => sub{
|
my $new_param_value=$widget->get_text();
|
my $new_param_value=$widget->get_text();
|
$object->object_add_attribute($attribute1,$attribute2,$new_param_value);
|
$object->object_add_attribute($attribute1,$attribute2,$new_param_value);
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
});
|
});
|
return $widget;
|
return $widget;
|
}
|
}
|
|
|
|
|
sub gen_combobox_object {
|
sub gen_combobox_object {
|
my ($object,$attribute1,$attribute2,$content,$default,$status,$timeout)=@_;
|
my ($object,$attribute1,$attribute2,$content,$default,$status,$timeout)=@_;
|
my @combo_list=split(/\s*,\s*/,$content);
|
my @combo_list=split(/\s*,\s*/,$content);
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
my $pos;
|
my $pos;
|
$pos=get_pos($value, @combo_list) if (defined $value);
|
$pos=get_pos($value, @combo_list) if (defined $value);
|
if(!defined $pos && defined $default){
|
if(!defined $pos && defined $default){
|
$object->object_add_attribute($attribute1,$attribute2,$default);
|
$object->object_add_attribute($attribute1,$attribute2,$default);
|
$pos=get_item_pos($default, @combo_list);
|
$pos=get_item_pos($default, @combo_list);
|
}
|
}
|
#print " my $pos=get_item_pos($value, @combo_list);\n";
|
#print " my $pos=get_item_pos($value, @combo_list);\n";
|
my $widget=gen_combo(\@combo_list, $pos);
|
my $widget=gen_combo(\@combo_list, $pos);
|
$widget-> signal_connect("changed" => sub{
|
$widget-> signal_connect("changed" => sub{
|
my $new_param_value=$widget->get_active_text();
|
my $new_param_value=$widget->get_active_text();
|
$object->object_add_attribute($attribute1,$attribute2,$new_param_value);
|
$object->object_add_attribute($attribute1,$attribute2,$new_param_value);
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
});
|
});
|
return $widget;
|
return $widget;
|
|
|
|
|
}
|
}
|
|
|
|
|
sub gen_comboentry_object {
|
sub gen_comboentry_object {
|
my ($object,$attribute1,$attribute2,$content,$default,$status,$timeout)=@_;
|
my ($object,$attribute1,$attribute2,$content,$default,$status,$timeout)=@_;
|
my @combo_list;
|
my @combo_list;
|
@combo_list=split(/\s*,\s*/,$content) if(defined $content );
|
@combo_list=split(/\s*,\s*/,$content) if(defined $content );
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
my $pos;
|
my $pos;
|
$pos=get_pos($value, @combo_list) if (defined $value);
|
$pos=get_pos($value, @combo_list) if (defined $value);
|
if(!defined $pos && defined $default){
|
if(!defined $pos && defined $default){
|
$object->object_add_attribute($attribute1,$attribute2,$default);
|
$object->object_add_attribute($attribute1,$attribute2,$default);
|
$pos=get_item_pos($default, @combo_list);
|
$pos=get_item_pos($default, @combo_list);
|
}
|
}
|
#print " my $pos=get_item_pos($value, @combo_list);\n";
|
#print " my $pos=get_item_pos($value, @combo_list);\n";
|
|
|
my $widget=gen_combo_entry(\@combo_list, $pos);
|
my $widget=gen_combo_entry(\@combo_list, $pos);
|
($widget->child)->signal_connect('changed' => sub {
|
($widget->child)->signal_connect('changed' => sub {
|
my ($entry) = @_;
|
my ($entry) = @_;
|
my $new_param_value=$entry->get_text();
|
my $new_param_value=$entry->get_text();
|
$object->object_add_attribute($attribute1,$attribute2,$new_param_value);
|
$object->object_add_attribute($attribute1,$attribute2,$new_param_value);
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
});
|
});
|
return $widget;
|
return $widget;
|
|
|
}
|
}
|
|
|
|
|
|
|
sub gen_spin_object {
|
sub gen_spin_object {
|
my ($object,$attribute1,$attribute2,$content, $default,$status,$timeout)=@_;
|
my ($object,$attribute1,$attribute2,$content, $default,$status,$timeout)=@_;
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
my ($min,$max,$step,$digit)=split(/\s*,\s*/,$content);
|
my ($min,$max,$step,$digit)=split(/\s*,\s*/,$content);
|
if(!defined $value){
|
if(!defined $value){
|
$value=$default;
|
$value=$default;
|
$object->object_add_attribute($attribute1,$attribute2,$value);
|
$object->object_add_attribute($attribute1,$attribute2,$value);
|
}
|
}
|
|
|
$value=~ s/[^0-9.\-]//g;
|
$value=~ s/[^0-9.\-]//g;
|
$min=~ s/[^0-9.\-]//g;
|
$min=~ s/[^0-9.\-]//g;
|
$max=~ s/[^0-9.\-]//g;
|
$max=~ s/[^0-9.\-]//g;
|
$step=~ s/[^0-9.\-]//g;
|
$step=~ s/[^0-9.\-]//g;
|
$digit=~ s/[^0-9.\-]//g if (defined $digit);
|
$digit=~ s/[^0-9.\-]//g if (defined $digit);
|
|
|
my $widget=gen_spin($min,$max,$step,$digit);
|
my $widget=gen_spin($min,$max,$step,$digit);
|
$widget->set_value($value);
|
$widget->set_value($value);
|
$widget-> signal_connect("value_changed" => sub{
|
$widget-> signal_connect("value_changed" => sub{
|
my $new_param_value=$widget->get_value();
|
my $new_param_value=$widget->get_value();
|
$object->object_add_attribute($attribute1,$attribute2,$new_param_value);
|
$object->object_add_attribute($attribute1,$attribute2,$new_param_value);
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
});
|
});
|
return $widget;
|
return $widget;
|
}
|
}
|
|
|
|
|
sub gen_check_box_object_array {
|
sub gen_check_box_object_array {
|
my ($object,$attribute1,$attribute2,$content,$default,$status,$timeout)=@_;
|
my ($object,$attribute1,$attribute2,$content,$default,$status,$timeout)=@_;
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
$value = $default if (!defined $value);
|
$value = $default if (!defined $value);
|
my $widget = def_hbox(FALSE,0);
|
my $widget = def_hbox(FALSE,0);
|
my @check;
|
my @check;
|
for (my $i=0;$i<$content;$i++){
|
for (my $i=0;$i<$content;$i++){
|
$check[$i]= Gtk2::CheckButton->new;
|
$check[$i]= Gtk2::CheckButton->new;
|
}
|
}
|
for (my $i=0;$i<$content;$i++){
|
for (my $i=0;$i<$content;$i++){
|
$widget->pack_end( $check[$i], FALSE, FALSE, 0);
|
$widget->pack_end( $check[$i], FALSE, FALSE, 0);
|
|
|
my @chars = split("",$value);
|
my @chars = split("",$value);
|
#check if saved value match the size of check box
|
#check if saved value match the size of check box
|
if($chars[0] ne $content ) {
|
if($chars[0] ne $content ) {
|
$object->object_add_attribute($attribute1,$attribute2,$default);
|
$object->object_add_attribute($attribute1,$attribute2,$default);
|
$value=$default;
|
$value=$default;
|
@chars = split("",$value);
|
@chars = split("",$value);
|
}
|
}
|
#set initial value
|
#set initial value
|
|
|
#print "\@chars=@chars\n";
|
#print "\@chars=@chars\n";
|
for (my $i=0;$i<$content;$i++){
|
for (my $i=0;$i<$content;$i++){
|
my $loc= (scalar @chars) -($i+1);
|
my $loc= (scalar @chars) -($i+1);
|
if( $chars[$loc] eq '1') {$check[$i]->set_active(TRUE);}
|
if( $chars[$loc] eq '1') {$check[$i]->set_active(TRUE);}
|
else {$check[$i]->set_active(FALSE);}
|
else {$check[$i]->set_active(FALSE);}
|
}
|
}
|
|
|
|
|
#get new value
|
#get new value
|
$check[$i]-> signal_connect("toggled" => sub{
|
$check[$i]-> signal_connect("toggled" => sub{
|
my $new_val="$content\'b";
|
my $new_val="$content\'b";
|
|
|
for (my $i=$content-1; $i >= 0; $i--){
|
for (my $i=$content-1; $i >= 0; $i--){
|
if($check[$i]->get_active()) {$new_val="${new_val}1" ;}
|
if($check[$i]->get_active()) {$new_val="${new_val}1" ;}
|
else {$new_val="${new_val}0" ;}
|
else {$new_val="${new_val}0" ;}
|
}
|
}
|
$object->object_add_attribute($attribute1,$attribute2,$new_val);
|
$object->object_add_attribute($attribute1,$attribute2,$new_val);
|
#print "\$new_val=$new_val\n";
|
#print "\$new_val=$new_val\n";
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
});
|
});
|
}
|
}
|
return $widget;
|
return $widget;
|
|
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
sub gen_check_box_object {
|
sub gen_check_box_object {
|
my ($object,$attribute1,$attribute2,$default,$status,$timeout)=@_;
|
my ($object,$attribute1,$attribute2,$default,$status,$timeout)=@_;
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
if (!defined $value){
|
if (!defined $value){
|
#set initial value
|
#set initial value
|
$object->object_add_attribute($attribute1,$attribute2,$default);
|
$object->object_add_attribute($attribute1,$attribute2,$default);
|
$value = $default
|
$value = $default
|
}
|
}
|
my $widget = Gtk2::CheckButton->new;
|
my $widget = Gtk2::CheckButton->new;
|
if($value == 1) {$widget->set_active(TRUE);}
|
if($value == 1) {$widget->set_active(TRUE);}
|
else {$widget->set_active(FALSE);}
|
else {$widget->set_active(FALSE);}
|
|
|
#get new value
|
#get new value
|
$widget-> signal_connect("toggled" => sub{
|
$widget-> signal_connect("toggled" => sub{
|
my $new_val;
|
my $new_val;
|
if($widget->get_active()) {$new_val=1;}
|
if($widget->get_active()) {$new_val=1;}
|
else {$new_val=0;}
|
else {$new_val=0;}
|
$object->object_add_attribute($attribute1,$attribute2,$new_val);
|
$object->object_add_attribute($attribute1,$attribute2,$new_val);
|
#print "\$new_val=$new_val\n";
|
#print "\$new_val=$new_val\n";
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
});
|
});
|
|
|
return $widget;
|
return $widget;
|
|
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
sub get_dir_in_object {
|
sub get_dir_in_object {
|
my ($object,$attribute1,$attribute2,$content,$status,$timeout,$default)=@_;
|
my ($object,$attribute1,$attribute2,$content,$status,$timeout,$default)=@_;
|
my $widget = def_hbox(FALSE,0);
|
my $widget = def_hbox(FALSE,0);
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
$object->object_add_attribute($attribute1,$attribute2, $default) if (!defined $value );
|
$object->object_add_attribute($attribute1,$attribute2, $default) if (!defined $value );
|
$value = $default if (!defined $value );
|
$value = $default if (!defined $value );
|
if (defined $default){
|
if (defined $default){
|
$object->object_add_attribute($attribute1,$attribute2, $default) if !(-d $value );
|
$object->object_add_attribute($attribute1,$attribute2, $default) if !(-d $value );
|
$value = $default if !(-d $value );
|
$value = $default if !(-d $value );
|
};
|
};
|
|
|
my $warning;
|
my $warning;
|
|
|
my $entry=gen_entry($value);
|
my $entry=gen_entry($value);
|
$entry-> signal_connect("changed" => sub{
|
$entry-> signal_connect("changed" => sub{
|
my $new_param_value=$entry->get_text();
|
my $new_param_value=$entry->get_text();
|
$object->object_add_attribute($attribute1,$attribute2,$new_param_value);
|
$object->object_add_attribute($attribute1,$attribute2,$new_param_value);
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
set_gui_status($object,$status,$timeout) if (defined $status);
|
unless (-d $new_param_value ){
|
unless (-d $new_param_value ){
|
if (!defined $warning){
|
if (!defined $warning){
|
$warning = def_icon("icons/warning.png");
|
$warning = def_icon("icons/warning.png");
|
$widget->pack_start( $warning, FALSE, FALSE, 0);
|
$widget->pack_start( $warning, FALSE, FALSE, 0);
|
set_tip($warning,"$new_param_value is not a valid directory");
|
set_tip($warning,"$new_param_value is not a valid directory");
|
$widget->show_all;
|
$widget->show_all;
|
}
|
}
|
|
|
}else{
|
}else{
|
$warning->destroy if (defined $warning);
|
$warning->destroy if (defined $warning);
|
undef $warning;
|
undef $warning;
|
|
|
}
|
}
|
|
|
});
|
});
|
my $browse= get_directory_name_widget($object,undef,$entry,$attribute1,$attribute2,$status,$timeout);
|
my $browse= get_directory_name_widget($object,undef,$entry,$attribute1,$attribute2,$status,$timeout);
|
|
|
$widget->pack_start( $entry, FALSE, FALSE, 0);
|
$widget->pack_start( $entry, FALSE, FALSE, 0);
|
$widget->pack_start( $browse, FALSE, FALSE, 0);
|
$widget->pack_start( $browse, FALSE, FALSE, 0);
|
|
|
if(defined $value){
|
if(defined $value){
|
unless (-d $value ){
|
unless (-d $value ){
|
$warning= def_icon("icons/warning.png");
|
$warning= def_icon("icons/warning.png");
|
$widget->pack_start( $warning, FALSE, FALSE, 0);
|
$widget->pack_start( $warning, FALSE, FALSE, 0);
|
set_tip($warning,"$value is not a valid directory path");
|
set_tip($warning,"$value is not a valid directory path");
|
}
|
}
|
}
|
}
|
return $widget;
|
return $widget;
|
}
|
}
|
|
|
|
|
|
|
|
|
sub get_file_name_object {
|
sub get_file_name_object {
|
my ($object,$attribute1,$attribute2,$extension,$open_in)=@_;
|
my ($object,$attribute1,$attribute2,$extension,$open_in)=@_;
|
my $widget = def_hbox(FALSE,0);
|
my $widget = def_hbox(FALSE,0);
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
my $value=$object->object_get_attribute($attribute1,$attribute2);
|
my $label;
|
my $label;
|
if(defined $value){
|
if(defined $value){
|
my ($name,$path,$suffix) = fileparse("$value",qr"\..[^.]*$");
|
my ($name,$path,$suffix) = fileparse("$value",qr"\..[^.]*$");
|
$label=gen_label_in_center($name.$suffix);
|
$label=gen_label_in_center($name.$suffix);
|
|
|
} else {
|
} else {
|
$label=gen_label_in_center("Selecet a file");
|
$label=gen_label_in_center("Selecet a file");
|
$label->set_markup("<span foreground= 'red' ><b>No file has been selected yet</b></span>");
|
$label->set_markup("<span foreground= 'red' ><b>No file has been selected yet</b></span>");
|
}
|
}
|
my $entry=gen_entry();
|
my $entry=gen_entry();
|
my $browse= get_file_name($object,undef,$entry,$attribute1,$attribute2,$extension,$label,$open_in);
|
my $browse= get_file_name($object,undef,$entry,$attribute1,$attribute2,$extension,$label,$open_in);
|
$widget->pack_start( $label, FALSE, FALSE, 0);
|
$widget->pack_start( $label, FALSE, FALSE, 0);
|
$widget->pack_start( $browse, FALSE, FALSE, 0);
|
$widget->pack_start( $browse, FALSE, FALSE, 0);
|
return $widget;
|
return $widget;
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
sub gen_notebook {
|
sub gen_notebook {
|
my $notebook = Gtk2::Notebook->new;
|
my $notebook = Gtk2::Notebook->new;
|
$notebook->can_focus(FALSE);
|
$notebook->can_focus(FALSE);
|
|
|
return $notebook;
|
return $notebook;
|
}
|
}
|
################
|
################
|
# ADD info and label to widget
|
# ADD info and label to widget
|
################
|
################
|
|
|
|
|
sub gen_label_info{
|
sub gen_label_info{
|
my ($label_name,$widget,$info)=@_;
|
my ($label_name,$widget,$info)=@_;
|
my $box = def_hbox(FALSE,0);
|
my $box = def_hbox(FALSE,0);
|
#label
|
#label
|
if(defined $label_name){
|
if(defined $label_name){
|
my $label= gen_label_in_left($label_name);
|
my $label= gen_label_in_left($label_name);
|
$box->pack_start( $label, FALSE, FALSE, 3);
|
$box->pack_start( $label, FALSE, FALSE, 3);
|
}
|
}
|
$box->pack_start( $widget, FALSE, FALSE, 3);
|
$box->pack_start( $widget, FALSE, FALSE, 3);
|
#info
|
#info
|
if(defined $info){
|
if(defined $info){
|
my $button=def_image_button("icons/help.png");
|
my $button=def_image_button("icons/help.png");
|
$button->signal_connect("clicked" => sub {message_dialog($info);});
|
$button->signal_connect("clicked" => sub {message_dialog($info);});
|
$box->pack_start( $button, FALSE, FALSE, 3);
|
$box->pack_start( $button, FALSE, FALSE, 3);
|
}
|
}
|
$box->show_all;
|
$box->show_all;
|
return $box;
|
return $box;
|
}
|
}
|
|
|
|
|
############
|
############
|
#
|
#
|
###########
|
###########
|
|
|
sub gen_MenuBar{
|
sub gen_MenuBar{
|
my ($window,@menu_items)=@_;
|
my ($window,@menu_items)=@_;
|
my $accel_group = Gtk2::AccelGroup->new;
|
my $accel_group = Gtk2::AccelGroup->new;
|
my $item_factory = Gtk2::ItemFactory->new ("Gtk2::MenuBar", "<main>",$accel_group);
|
my $item_factory = Gtk2::ItemFactory->new ("Gtk2::MenuBar", "<main>",$accel_group);
|
$window->add_accel_group ($accel_group);
|
$window->add_accel_group ($accel_group);
|
# Set up item factory to go away with the window
|
# Set up item factory to go away with the window
|
$window->{'<main>'} = $item_factory;
|
$window->{'<main>'} = $item_factory;
|
# create menu items
|
# create menu items
|
$item_factory->create_items ($window, @menu_items);
|
$item_factory->create_items ($window, @menu_items);
|
return $item_factory->get_widget ("<main>");
|
return $item_factory->get_widget ("<main>");
|
}
|
}
|
|
|
sub creating_detachable_toolbar{
|
sub creating_detachable_toolbar{
|
my @attachments=@_;
|
my @attachments=@_;
|
|
|
#The handle box helps in creating a detachable toolbar
|
#The handle box helps in creating a detachable toolbar
|
my $hb = Gtk2::HandleBox->new;
|
my $hb = Gtk2::HandleBox->new;
|
#create a toolbar, and do some initial settings
|
#create a toolbar, and do some initial settings
|
my $toolbar = Gtk2::Toolbar->new;
|
my $toolbar = Gtk2::Toolbar->new;
|
$toolbar->set_icon_size ('small-toolbar');
|
$toolbar->set_icon_size ('small-toolbar');
|
$toolbar->set_show_arrow (FALSE);
|
$toolbar->set_show_arrow (FALSE);
|
foreach my $p (@attachments){
|
foreach my $p (@attachments){
|
$toolbar->insert($p,-1);
|
$toolbar->insert($p,-1);
|
|
|
}
|
}
|
$hb->add($toolbar);
|
$hb->add($toolbar);
|
return $hb;
|
return $hb;
|
}
|
}
|
|
|
sub gui_quite{
|
sub gui_quite{
|
Gtk2->main_quit;
|
Gtk2->main_quit;
|
}
|
}
|
|
|
sub gtk_gui_run{
|
sub gtk_gui_run{
|
my ($main)=@_;
|
my ($main)=@_;
|
Gtk2->init;
|
Gtk2->init;
|
&$main;
|
&$main;
|
Gtk2->main();
|
Gtk2->main();
|
return 1;
|
return 1;
|
}
|
}
|
|
|
|
|
sub refresh_gui{
|
sub refresh_gui{
|
while (Gtk2->events_pending) {
|
while (Gtk2->events_pending) {
|
Gtk2->main_iteration;
|
Gtk2->main_iteration;
|
}
|
}
|
Gtk2::Gdk->flush;
|
Gtk2::Gdk->flush;
|
}
|
}
|
|
|
|
|
sub about {
|
sub about {
|
my $version=shift;
|
my $version=shift;
|
my $about = Gtk2::AboutDialog->new;
|
my $about = Gtk2::AboutDialog->new;
|
$about->set_authors("Alireza Monemi\n Email: alirezamonemi\@opencores.org");
|
$about->set_authors("Alireza Monemi\n Email: alirezamonemi\@opencores.org");
|
$about->set_version( $version );
|
$about->set_version( $version );
|
$about->set_website('http://opencores.org/project,an-fpga-implementation-of-low-latency-noc-based-mpsoc');
|
$about->set_website('http://opencores.org/project,an-fpga-implementation-of-low-latency-noc-based-mpsoc');
|
$about->set_comments('NoC based MPSoC generator.');
|
$about->set_comments('NoC based MPSoC generator.');
|
$about->set_program_name('ProNoC');
|
$about->set_program_name('ProNoC');
|
my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file_at_scale("icons/ProNoC.png",50,50,FALSE);
|
my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file_at_scale("icons/ProNoC.png",50,50,FALSE);
|
$about->set_logo($pixbuf);
|
$about->set_logo($pixbuf);
|
|
|
$about->set_license(
|
$about->set_license(
|
"This program is free software; you can redistribute it\n"
|
"This program is free software; you can redistribute it\n"
|
. "and/or modify it under the terms of the GNU General \n"
|
. "and/or modify it under the terms of the GNU General \n"
|
. "Public License as published by the Free Software \n"
|
. "Public License as published by the Free Software \n"
|
. "Foundation; either version 1, or (at your option)\n"
|
. "Foundation; either version 1, or (at your option)\n"
|
. "any later version.\n\n"
|
. "any later version.\n\n"
|
|
|
);
|
);
|
# Add the Hide action to the 'Close' button in the AboutDialog():
|
# Add the Hide action to the 'Close' button in the AboutDialog():
|
$about->signal_connect('response' => sub { $about->hide; });
|
$about->signal_connect('response' => sub { $about->hide; });
|
|
|
|
|
$about->run;
|
$about->run;
|
$about->destroy;
|
$about->destroy;
|
return;
|
return;
|
}
|
}
|
|
|
|
|
|
|
############
|
############
|
# list_store
|
# list_store
|
###########
|
###########
|
|
|
sub gen_list_store {
|
sub gen_list_store {
|
my ($dref,$clmn_type_ref, $clmn_lables_ref)=@_;
|
my ($dref,$clmn_type_ref, $clmn_lables_ref)=@_;
|
|
|
|
|
# my @data = (
|
# my @data = (
|
# {0 => "Average distance", 1 =>"$avg"},
|
# {0 => "Average distance", 1 =>"$avg"},
|
# {0 => "Max distance", 1 =>"$max" },
|
# {0 => "Max distance", 1 =>"$max" },
|
# {0 => "Min distance",1 => "$min"},
|
# {0 => "Min distance",1 => "$min"},
|
# {0 => "Normlized data per hop", 1 =>"$norm" }
|
# {0 => "Normlized data per hop", 1 =>"$norm" }
|
# );
|
# );
|
|
|
# my @clmn_type = (#'Glib::Boolean', # => G_TYPE_BOOLEAN
|
# my @clmn_type = (#'Glib::Boolean', # => G_TYPE_BOOLEAN
|
# #'Glib::Uint', # => G_TYPE_UINT
|
# #'Glib::Uint', # => G_TYPE_UINT
|
# 'Glib::String', # => G_TYPE_STRING
|
# 'Glib::String', # => G_TYPE_STRING
|
# 'Glib::String'); # you get the idea
|
# 'Glib::String'); # you get the idea
|
|
|
|
|
my @data = @{$dref};
|
my @data = @{$dref};
|
my @clmn_type = @{$clmn_type_ref};
|
my @clmn_type = @{$clmn_type_ref};
|
my @clmn_lables= @{$clmn_lables_ref};
|
my @clmn_lables= @{$clmn_lables_ref};
|
|
|
|
|
# create list store
|
# create list store
|
my $store = Gtk2::ListStore->new ( @clmn_type);
|
my $store = Gtk2::ListStore->new ( @clmn_type);
|
|
|
|
|
# add data to the list store
|
# add data to the list store
|
foreach my $d (@data) {
|
foreach my $d (@data) {
|
my $iter = $store->append;
|
my $iter = $store->append;
|
my @clmns = sort keys %{$d};
|
my @clmns = sort keys %{$d};
|
my @a=($iter);
|
my @a=($iter);
|
foreach my $c (@clmns){
|
foreach my $c (@clmns){
|
push (@a,($c,$d->{$c}));
|
push (@a,($c,$d->{$c}));
|
|
|
}
|
}
|
$store->set (@a);
|
$store->set (@a);
|
|
|
}
|
}
|
|
|
|
|
my $treeview = Gtk2::TreeView->new ($store);
|
my $treeview = Gtk2::TreeView->new ($store);
|
$treeview->set_rules_hint (TRUE);
|
$treeview->set_rules_hint (TRUE);
|
$treeview->set_search_column (1);
|
$treeview->set_search_column (1);
|
my $renderer = Gtk2::CellRendererToggle->new;
|
my $renderer = Gtk2::CellRendererToggle->new;
|
$renderer->signal_connect (toggled => \&fixed_toggled, $store);
|
$renderer->signal_connect (toggled => \&fixed_toggled, $store);
|
|
|
|
|
# column for severities
|
# column for severities
|
my $c=0;
|
my $c=0;
|
foreach my $l (@clmn_lables){
|
foreach my $l (@clmn_lables){
|
$renderer = Gtk2::CellRendererText->new;
|
$renderer = Gtk2::CellRendererText->new;
|
my $column = Gtk2::TreeViewColumn->new_with_attributes ("$l",
|
my $column = Gtk2::TreeViewColumn->new_with_attributes ("$l",
|
$renderer,
|
$renderer,
|
text => $c );
|
text => $c );
|
$column->set_sort_column_id ($c );
|
$column->set_sort_column_id ($c );
|
$treeview->append_column ($column);
|
$treeview->append_column ($column);
|
$c++;
|
$c++;
|
}
|
}
|
|
|
|
|
return $treeview;
|
return $treeview;
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
##############
|
##############
|
# create tree
|
# create tree
|
##############
|
##############
|
|
|
|
|
sub create_tree_model_network_maker{
|
sub create_tree_model_network_maker{
|
my $model = Gtk2::TreeStore->new ('Glib::String', 'Glib::String', 'Glib::Scalar', 'Glib::Boolean');
|
my $model = Gtk2::TreeStore->new ('Glib::String', 'Glib::String', 'Glib::Scalar', 'Glib::Boolean');
|
my $tree_view = Gtk2::TreeView->new;
|
my $tree_view = Gtk2::TreeView->new;
|
$tree_view->set_model ($model);
|
$tree_view->set_model ($model);
|
my $selection = $tree_view->get_selection;
|
my $selection = $tree_view->get_selection;
|
$selection->set_mode ("single");
|
$selection->set_mode ("single");
|
my $cell = Gtk2::CellRendererText->new;
|
my $cell = Gtk2::CellRendererText->new;
|
$cell->set ('style' => 'italic');
|
$cell->set ('style' => 'italic');
|
my $column = Gtk2::TreeViewColumn->new_with_attributes ("select", $cell, 'text' => 0, 'style_set' => 3);
|
my $column = Gtk2::TreeViewColumn->new_with_attributes ("select", $cell, 'text' => 0, 'style_set' => 3);
|
return ($model,$tree_view,$column);
|
return ($model,$tree_view,$column);
|
}
|
}
|
|
|
|
|
sub treemodel_next_iter{
|
sub treemodel_next_iter{
|
my ($child , $tree_model)=@_;
|
my ($child , $tree_model)=@_;
|
return $tree_model->iter_next ($child);
|
return $tree_model->iter_next ($child);
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
# clean names for column numbers.
|
# clean names for column numbers.
|
use constant DISPLAY_COLUMN => 0;
|
use constant DISPLAY_COLUMN => 0;
|
use constant CATRGORY_COLUMN => 1;
|
use constant CATRGORY_COLUMN => 1;
|
use constant MODULE_COLUMN => 2;
|
use constant MODULE_COLUMN => 2;
|
use constant ITALIC_COLUMN => 3;
|
use constant ITALIC_COLUMN => 3;
|
use constant NUM_COLUMNS => 4;
|
use constant NUM_COLUMNS => 4;
|
|
|
sub create_tree {
|
sub create_tree {
|
my ($self,$label,$info,$tree_ref,$row_selected_func,$row_activated_func)=@_;
|
my ($self,$label,$info,$tree_ref,$row_selected_func,$row_activated_func)=@_;
|
my %tree_in = %{$tree_ref};
|
my %tree_in = %{$tree_ref};
|
my $model = Gtk2::TreeStore->new ('Glib::String', 'Glib::String', 'Glib::Scalar', 'Glib::Boolean');
|
my $model = Gtk2::TreeStore->new ('Glib::String', 'Glib::String', 'Glib::Scalar', 'Glib::Boolean');
|
my $tree_view = Gtk2::TreeView->new;
|
my $tree_view = Gtk2::TreeView->new;
|
$tree_view->set_model ($model);
|
$tree_view->set_model ($model);
|
my $selection = $tree_view->get_selection;
|
my $selection = $tree_view->get_selection;
|
$selection->set_mode ('browse');
|
$selection->set_mode ('browse');
|
|
|
|
|
|
|
foreach my $p (sort keys %tree_in)
|
foreach my $p (sort keys %tree_in)
|
{
|
{
|
|
|
my @modules= @{$tree_in{$p}};
|
my @modules= @{$tree_in{$p}};
|
#my @dev_entry= @{$tree_entry{$p}};
|
#my @dev_entry= @{$tree_entry{$p}};
|
my $iter = $model->append (undef);
|
my $iter = $model->append (undef);
|
$model->set ($iter,
|
$model->set ($iter,
|
DISPLAY_COLUMN, $p,
|
DISPLAY_COLUMN, $p,
|
CATRGORY_COLUMN, $p || '',
|
CATRGORY_COLUMN, $p || '',
|
MODULE_COLUMN, 0 || '',
|
MODULE_COLUMN, 0 || '',
|
ITALIC_COLUMN, FALSE);
|
ITALIC_COLUMN, FALSE);
|
|
|
next unless @modules;
|
next unless @modules;
|
|
|
foreach my $v ( @modules){
|
foreach my $v ( @modules){
|
my $child_iter = $model->append ($iter);
|
my $child_iter = $model->append ($iter);
|
my $entry= '';
|
my $entry= '';
|
|
|
$model->set ($child_iter,
|
$model->set ($child_iter,
|
DISPLAY_COLUMN, $v,
|
DISPLAY_COLUMN, $v,
|
CATRGORY_COLUMN, $p|| '',
|
CATRGORY_COLUMN, $p|| '',
|
MODULE_COLUMN, $v || '',
|
MODULE_COLUMN, $v || '',
|
ITALIC_COLUMN, FALSE);
|
ITALIC_COLUMN, FALSE);
|
}
|
}
|
|
|
|
|
|
|
}
|
}
|
|
|
my $cell = Gtk2::CellRendererText->new;
|
my $cell = Gtk2::CellRendererText->new;
|
$cell->set ('style' => 'italic');
|
$cell->set ('style' => 'italic');
|
my $column = Gtk2::TreeViewColumn->new_with_attributes
|
my $column = Gtk2::TreeViewColumn->new_with_attributes
|
("$label",
|
("$label",
|
$cell,
|
$cell,
|
'text' => DISPLAY_COLUMN,
|
'text' => DISPLAY_COLUMN,
|
'style_set' => ITALIC_COLUMN);
|
'style_set' => ITALIC_COLUMN);
|
|
|
$tree_view->append_column ($column);
|
$tree_view->append_column ($column);
|
my @ll=($model,$info);
|
my @ll=($model,$info);
|
#row selected
|
#row selected
|
$selection->signal_connect (changed =>sub {
|
$selection->signal_connect (changed =>sub {
|
my ($selection, $ref) = @_;
|
my ($selection, $ref) = @_;
|
my ($model,$info)=@{$ref};
|
my ($model,$info)=@{$ref};
|
my $iter = $selection->get_selected;
|
my $iter = $selection->get_selected;
|
return unless defined $iter;
|
return unless defined $iter;
|
|
|
my ($category) = $model->get ($iter, CATRGORY_COLUMN);
|
my ($category) = $model->get ($iter, CATRGORY_COLUMN);
|
my ($module) = $model->get ($iter,MODULE_COLUMN );
|
my ($module) = $model->get ($iter,MODULE_COLUMN );
|
$row_selected_func->($self,$category,$module,$info) if(defined $row_selected_func);
|
$row_selected_func->($self,$category,$module,$info) if(defined $row_selected_func);
|
|
|
|
|
|
|
}, \@ll);
|
}, \@ll);
|
|
|
# row_activated
|
# row_activated
|
$tree_view->signal_connect (row_activated => sub{
|
$tree_view->signal_connect (row_activated => sub{
|
|
|
my ($tree_view, $path, $column) = @_;
|
my ($tree_view, $path, $column) = @_;
|
my $model = $tree_view->get_model;
|
my $model = $tree_view->get_model;
|
my $iter = $model->get_iter ($path);
|
my $iter = $model->get_iter ($path);
|
my ($category) = $model->get ($iter, CATRGORY_COLUMN);
|
my ($category) = $model->get ($iter, CATRGORY_COLUMN);
|
my ($module) = $model->get ($iter,MODULE_COLUMN );
|
my ($module) = $model->get ($iter,MODULE_COLUMN );
|
|
|
|
|
if($module){
|
if($module){
|
#print "$module is selected via row activaton!\n";
|
#print "$module is selected via row activaton!\n";
|
$row_activated_func->($self,$category,$module,$info) if(defined $row_activated_func);
|
$row_activated_func->($self,$category,$module,$info) if(defined $row_activated_func);
|
#add_module_to_soc($soc,$ip,$category,$module,$info);
|
#add_module_to_soc($soc,$ip,$category,$module,$info);
|
|
|
}
|
}
|
|
|
}, \@ll);
|
}, \@ll);
|
|
|
#$tree_view->expand_all;
|
#$tree_view->expand_all;
|
|
|
my $scrolled_window = Gtk2::ScrolledWindow->new;
|
my $scrolled_window = Gtk2::ScrolledWindow->new;
|
$scrolled_window->set_policy ('automatic', 'automatic');
|
$scrolled_window->set_policy ('automatic', 'automatic');
|
$scrolled_window->set_shadow_type ('in');
|
$scrolled_window->set_shadow_type ('in');
|
$scrolled_window->add($tree_view);
|
$scrolled_window->add($tree_view);
|
|
|
my $hbox = Gtk2::HBox->new (FALSE, 0);
|
my $hbox = Gtk2::HBox->new (FALSE, 0);
|
$hbox->pack_start ( $scrolled_window, TRUE, TRUE, 0);
|
$hbox->pack_start ( $scrolled_window, TRUE, TRUE, 0);
|
|
|
return $hbox;
|
return $hbox;
|
}
|
}
|
|
|
|
|
sub row_activated_cb{
|
sub row_activated_cb{
|
my ($tree_view, $path, $column) = @_;
|
my ($tree_view, $path, $column) = @_;
|
my $model = $tree_view->get_model;
|
my $model = $tree_view->get_model;
|
my $iter = $model->get_iter ($path);
|
my $iter = $model->get_iter ($path);
|
my ($category) = $model->get ($iter, DISPLAY_COLUMN);
|
my ($category) = $model->get ($iter, DISPLAY_COLUMN);
|
my ($module) = $model->get ($iter, CATRGORY_COLUMN);
|
my ($module) = $model->get ($iter, CATRGORY_COLUMN);
|
|
|
}
|
}
|
|
|
|
|
|
|
sub file_edit_tree {
|
sub file_edit_tree {
|
my $tree_store = Gtk2::TreeStore->new('Glib::String', 'Glib::String');
|
my $tree_store = Gtk2::TreeStore->new('Glib::String', 'Glib::String');
|
my $tree_view = Gtk2::TreeView->new($tree_store);
|
my $tree_view = Gtk2::TreeView->new($tree_store);
|
my $column = Gtk2::TreeViewColumn->new_with_attributes('Double-click to open', Gtk2::CellRendererText->new(), text => "0");
|
my $column = Gtk2::TreeViewColumn->new_with_attributes('Double-click to open', Gtk2::CellRendererText->new(), text => "0");
|
$tree_view->append_column($column);
|
$tree_view->append_column($column);
|
$tree_view->set_headers_visible(TRUE);
|
$tree_view->set_headers_visible(TRUE);
|
return ($tree_store,$tree_view);
|
return ($tree_store,$tree_view);
|
}
|
}
|
|
|
##########
|
##########
|
# run external commands
|
# run external commands
|
##########
|
##########
|
|
|
|
|
|
|
sub run_cmd_in_back_ground
|
sub run_cmd_in_back_ground
|
{
|
{
|
my $command = shift;
|
my $command = shift;
|
#print "\t$command\n";
|
#print "\t$command\n";
|
|
|
### Start running the Background Job:
|
### Start running the Background Job:
|
my $proc = Proc::Background->new($command);
|
my $proc = Proc::Background->new($command);
|
my $PID = $proc->pid;
|
my $PID = $proc->pid;
|
my $start_time = $proc->start_time;
|
my $start_time = $proc->start_time;
|
my $alive = $proc->alive;
|
my $alive = $proc->alive;
|
|
|
### While $alive is NOT '0', then keep checking till it is...
|
### While $alive is NOT '0', then keep checking till it is...
|
# *When $alive is '0', it has finished executing.
|
# *When $alive is '0', it has finished executing.
|
while($alive ne 0)
|
while($alive ne 0)
|
{
|
{
|
$alive = $proc->alive;
|
$alive = $proc->alive;
|
|
|
# This while loop will cause Gtk2 to continue processing events, if
|
# This while loop will cause Gtk2 to continue processing events, if
|
# there are events pending... *which there are...
|
# there are events pending... *which there are...
|
while (Gtk2->events_pending) {
|
while (Gtk2->events_pending) {
|
Gtk2->main_iteration;
|
Gtk2->main_iteration;
|
}
|
}
|
Gtk2::Gdk->flush;
|
Gtk2::Gdk->flush;
|
|
|
usleep(1000);
|
usleep(1000);
|
}
|
}
|
|
|
my $end_time = $proc->end_time;
|
my $end_time = $proc->end_time;
|
# print "*Command Completed at $end_time, with PID = $PID\n\n";
|
# print "*Command Completed at $end_time, with PID = $PID\n\n";
|
|
|
# Since the while loop has exited, the BG job has finished running:
|
# Since the while loop has exited, the BG job has finished running:
|
# so close the pop-up window...
|
# so close the pop-up window...
|
# $popup_window->hide;
|
# $popup_window->hide;
|
|
|
# Get the RETCODE from the Background Job using the 'wait' method
|
# Get the RETCODE from the Background Job using the 'wait' method
|
my $retcode = $proc->wait;
|
my $retcode = $proc->wait;
|
$retcode /= 256;
|
$retcode /= 256;
|
|
|
#print "\t*RETCODE == $retcode\n\n";
|
#print "\t*RETCODE == $retcode\n\n";
|
Gtk2::Gdk->flush;
|
Gtk2::Gdk->flush;
|
### Check if the RETCODE returned with an Error:
|
### Check if the RETCODE returned with an Error:
|
if ($retcode ne 0) {
|
if ($retcode ne 0) {
|
print "Error: The Background Job ($command) returned with an Error...!\n";
|
print "Error: The Background Job ($command) returned with an Error...!\n";
|
return 1;
|
return 1;
|
} else {
|
} else {
|
#print "Success: The Background Job Completed Successfully...!\n";
|
#print "Success: The Background Job Completed Successfully...!\n";
|
return 0;
|
return 0;
|
}
|
}
|
|
|
}
|
}
|
|
|
sub run_cmd_in_back_ground_get_stdout
|
sub run_cmd_in_back_ground_get_stdout
|
{
|
{
|
my $cmd=shift;
|
my $cmd=shift;
|
my $exit;
|
my $exit;
|
my ($stdout, $stderr);
|
my ($stdout, $stderr);
|
|
STDOUT->flush();
|
|
STDERR->flush();
|
capture { $exit=run_cmd_in_back_ground($cmd) } \$stdout, \$stderr;
|
capture { $exit=run_cmd_in_back_ground($cmd) } \$stdout, \$stderr;
|
return ($stdout,$exit,$stderr);
|
return ($stdout,$exit,$stderr);
|
|
|
}
|
}
|
|
|
sub run_cmd_message_dialog_errors{
|
sub run_cmd_message_dialog_errors{
|
my ($cmd)=@_;
|
my ($cmd)=@_;
|
my ($stdout,$exit,$stderr)=run_cmd_in_back_ground_get_stdout($cmd);
|
my ($stdout,$exit,$stderr)=run_cmd_in_back_ground_get_stdout($cmd);
|
if(length $stderr>1){
|
if(length $stderr>1){
|
message_dialog("$stderr\n",'error');
|
message_dialog("$stderr\n",'error');
|
return 1;
|
return 1;
|
}if($exit){
|
}if($exit){
|
message_dialog("Error $cmd failed: $stdout\n",'error');
|
message_dialog("Error $cmd failed: $stdout\n",'error');
|
return 1;
|
return 1;
|
}
|
}
|
return 0;
|
return 0;
|
|
|
}
|
}
|
|
|
|
|
sub run_cmd_textview_errors{
|
sub run_cmd_textview_errors{
|
my ($cmd,$tview)=@_;
|
my ($cmd,$tview)=@_;
|
my ($stdout,$exit,$stderr)=run_cmd_in_back_ground_get_stdout($cmd);
|
my ($stdout,$exit,$stderr)=run_cmd_in_back_ground_get_stdout($cmd);
|
if(length $stderr>1){
|
if(length $stderr>1){
|
add_colored_info($tview,"Error: $stderr\n",'red');
|
add_colored_info($tview,"Error: $stderr\n",'red');
|
add_colored_info($tview,"$cmd did not run successfully!\n",'red');
|
add_colored_info($tview,"$cmd did not run successfully!\n",'red');
|
return undef;
|
return undef;
|
}
|
}
|
if($exit){
|
if($exit){
|
add_colored_info($tview,"Error:$stdout\n",'red');
|
add_colored_info($tview,"Error:$stdout\n",'red');
|
add_colored_info($tview,"$cmd did not run successfully!\n",'red');
|
add_colored_info($tview,"$cmd did not run successfully!\n",'red');
|
return undef;
|
return undef;
|
}
|
}
|
$stdout = "" if (!defined $stdout);
|
$stdout = "" if (!defined $stdout);
|
return $stdout
|
return $stdout
|
}
|
}
|
|
|
|
|
sub create_iconview_model {
|
sub create_iconview_model {
|
#----------------------------------------------------
|
#----------------------------------------------------
|
#The Iconview needs a Gtk2::Treemodel implementation-
|
#The Iconview needs a Gtk2::Treemodel implementation-
|
#containing at least a Glib::String and -------------
|
#containing at least a Glib::String and -------------
|
#Gtk2::Gdk::Pixbuf type. The first is used for the --
|
#Gtk2::Gdk::Pixbuf type. The first is used for the --
|
#text of the icon, and the last for the icon self----
|
#text of the icon, and the last for the icon self----
|
#Gtk2::ListStore is ideal for this ------------------
|
#Gtk2::ListStore is ideal for this ------------------
|
#----------------------------------------------------
|
#----------------------------------------------------
|
my ($self,$name,$ref)=@_;
|
my ($self,$name,$ref)=@_;
|
my @sources= (defined $ref)? @{$ref}:();
|
my @sources= (defined $ref)? @{$ref}:();
|
my $list_store = Gtk2::ListStore->new(qw/Glib::String Gtk2::Gdk::Pixbuf Glib::String/);
|
my $list_store = Gtk2::ListStore->new(qw/Glib::String Gtk2::Gdk::Pixbuf Glib::String/);
|
|
|
#******************************************************
|
#******************************************************
|
#we populate the Gtk2::ListStore with Gtk2::Stock icons
|
#we populate the Gtk2::ListStore with Gtk2::Stock icons
|
#******************************************************
|
#******************************************************
|
|
|
|
|
|
|
foreach my $val(@sources){
|
foreach my $val(@sources){
|
#get the iconset from the icon_factory
|
#get the iconset from the icon_factory
|
#my $iconset = $icon_factory->lookup_default($val);
|
#my $iconset = $icon_factory->lookup_default($val);
|
#try and extract the icon from it
|
#try and extract the icon from it
|
add_icon_to_tree($self,$name,$list_store,$val);
|
add_icon_to_tree($self,$name,$list_store,$val);
|
}
|
}
|
|
|
return $list_store;
|
return $list_store;
|
}
|
}
|
|
|
####################
|
####################
|
# SourceView
|
# SourceView
|
####################
|
####################
|
|
|
sub gen_SourceView_with_buffer{
|
sub gen_SourceView_with_buffer{
|
return Gtk2::SourceView2::View->new_with_buffer(@_);
|
return Gtk2::SourceView2::View->new_with_buffer(@_);
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
sub create_SourceView_buffer {
|
sub create_SourceView_buffer {
|
my $self = shift;
|
my $self = shift;
|
my $tags = Gtk2::TextTagTable->new();
|
my $tags = Gtk2::TextTagTable->new();
|
|
|
add_tag_to_SourceView($tags, search => {
|
add_tag_to_SourceView($tags, search => {
|
background => 'yellow',
|
background => 'yellow',
|
});
|
});
|
add_tag_to_SourceView($tags, goto_line => {
|
add_tag_to_SourceView($tags, goto_line => {
|
'paragraph-background' => 'orange',
|
'paragraph-background' => 'orange',
|
});
|
});
|
|
|
my $buffer = Gtk2::SourceView2::Buffer->new($tags);
|
my $buffer = Gtk2::SourceView2::Buffer->new($tags);
|
$buffer->signal_connect('notify::cursor-position' => sub {
|
$buffer->signal_connect('notify::cursor-position' => sub {
|
$self->clear_highlighted();
|
$self->clear_highlighted();
|
});
|
});
|
|
|
return $buffer;
|
return $buffer;
|
}
|
}
|
|
|
|
|
sub add_tag_to_SourceView {
|
sub add_tag_to_SourceView {
|
my ($tags, $name, $properties) = @_;
|
my ($tags, $name, $properties) = @_;
|
|
|
my $tag = Gtk2::TextTag->new($name);
|
my $tag = Gtk2::TextTag->new($name);
|
$tag->set(%{ $properties });
|
$tag->set(%{ $properties });
|
$tags->add($tag);
|
$tags->add($tag);
|
}
|
}
|
|
|
|
|
sub detect_language {
|
sub detect_language {
|
my $self = shift;
|
my $self = shift;
|
my ($filename) = @_;
|
my ($filename) = @_;
|
|
|
# Guess the programming language of the file
|
# Guess the programming language of the file
|
my $manager = Gtk2::SourceView2::LanguageManager->get_default;
|
my $manager = Gtk2::SourceView2::LanguageManager->get_default;
|
my $language = $manager->guess_language($filename);
|
my $language = $manager->guess_language($filename);
|
$self->buffer->set_language($language);
|
$self->buffer->set_language($language);
|
}
|
}
|
|
|
|
|
|
|
sub get_pressed_key{
|
sub get_pressed_key{
|
my $event=shift;
|
my $event=shift;
|
|
|
my $key = Gtk2::Gdk->keyval_name( $event->keyval );
|
my $key = Gtk2::Gdk->keyval_name( $event->keyval );
|
return $key;
|
return $key;
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
1
|
1
|
|
|