CodeManager
view release on metacpan or search on metacpan
lib/Prima/CodeManager/CodeManager.pm view on Meta::CPAN
use base "Prima::CodeManager::File";
#use base "Prima::CodeManager::Remote";
use File::Copy;
use File::Path qw(make_path remove_tree);
use File::Copy::Recursive qw(fcopy rcopy dircopy fmove rmove dirmove);
use File::HomeDir;
our $VERSION = '0.04';
########################################################################################
my ( $screen_width, $screen_height ) = $::application->size;
$::application-> wantUnicodeInput(1);
#-------------------------------------------------------
#setting OS
our $_OS;
$_OS = 'unknown';
$_OS = 'os' if $::application-> get_system_info()->{apc} == 1;
$_OS = 'windows' if $::application-> get_system_info()->{apc} == 2;
$_OS = 'linux' if $::application-> get_system_info()->{apc} == 3;
#-------------------------------------------------------
our $CodeManager_encoding = '';
#-------------------------------------------------------
#setting CodeManager.pm directory
our $CodeManager_directory = '';
if ( $PerlApp::BUILD ) {
# $CodeManager_directory = PerlApp::exe();
# $CodeManager_directory =~ s/(\\|\/)[^\\\/]*\.exe$//;
# $CodeManager_directory .= '/Prima/CodeManager';
$CodeManager_directory = 'Prima/CodeManager';
} else {
$CodeManager_directory = $INC{'Prima/CodeManager/CodeManager.pm'};
$CodeManager_directory =~ s/\/CodeManager\.pm$//;
}
#print "CodeManager_directory=$CodeManager_directory\n";
#-------------------------------------------------------
#setting user home directory
our $home_directory = File::HomeDir-> my_home.'/.CodeManager';
#-------------------------------------------------------
our %developer;
our %info_of_files;
our @list_of_files;
our %file_encodings; #this is a hash of the files encodings
our %all_extensions;
our $file_number = 0;
my $popup;
#-------------------------------------------------------
my $int_color = int(rand(360));
my $int_white = 170;
my $int_black = 40;
my $project_color = Prima::CodeManager::Misc::angle_color( undef, $int_color, $int_white, $int_black );
#-------------------------------------------------------
sub new
{
my ( $project ) = ( shift );
my $this = {};
bless ( $this, $project );
use Prima::Application (
title => 'CodeManager',
wantUnicodeInput => 1,
hintFont => {
name => 'DejaVu Sans',
size => 10,
style => fs::Italic,
},
font => {
name => 'DejaVu Sans',
size => 10,
style => fs::Normal,
},
);
#-------------------------------------------------------
$this-> create_user_home_directory ( $home_directory ) unless -d "$home_directory";
Prima::message ( "I can't create your CodeManager home directory:\n$home_directory" ) unless -d $home_directory;
#-------------------------------------------------------
my $DIR;
#reading names of the hiliting files in "Prima/CodeManager/hilite" subdirectory:
my @hilite_files = [];
my @hilite_files_ext; # = <$CodeManager_directory/hilite/hilite_*.pl>; (doesn't work on Windows)
if ( opendir $DIR, "$CodeManager_directory/hilite" ) {
@hilite_files_ext = sort grep { $_ =~ /hilite_\w+\.pl/ } readdir $DIR;
closedir $DIR;
}
##################################################
for ( my $i = 0; $i < @hilite_files_ext; $i++ ) {
if ( $hilite_files_ext[$i] =~ /hilite_(\w+)\.pl/ ) {
my $ext = $1;
$hilite_files[$i] = [ $1 => sub { $this->file_edit ( "$CodeManager_directory/hilite/hilite_$ext.pl" ) } ];
eval ( $this-> read_file( "$CodeManager_directory/hilite/hilite_$ext.pl" ));
$all_extensions{$ext} = $ext if $ext;
$all_extensions{'pm'} = 'pm' if $ext eq 'pl';
}
}
#-------------------------------------------------------
#reading images:
my @images_files_ext; # = <$CodeManager_directory/img/*.png>;
if ( opendir $DIR, "$CodeManager_directory/img" ) {
@images_files_ext = sort grep { $_ =~ /\.png/ } readdir $DIR;
lib/Prima/CodeManager/CodeManager.pm view on Meta::CPAN
$self->{global}->{GLOBAL}{tree_fontName} ||= 'DejaVu Sans Mono';
my @items = [];
my $i = 0;
while ( my $directory = $self->{global}->{DIRECTORY}->{"directory_$i"} ) {
$self->{global}->{DIRECTORY}->{"directory_$i"} .= '/' unless $self->{global}->{DIRECTORY}->{"directory_$i"} =~ /\/$/;
$self->{global}->{DIRECTORY}->{"image_$i"} = '' unless $self->{global}->{DIRECTORY}->{"image_$i"};
$self->{images}->{"dir_$i"} =
$self-> load_icon( $self->{global}->{DIRECTORY}->{"image_$i"} )
|| $self-> load_icon( "$CodeManager_directory/img/".$self->{global}->{DIRECTORY}->{"image_$i"} )
|| $self-> load_icon( "$CodeManager_directory/img/nil.png" );
my $name = $self->{global}->{DIRECTORY}->{"name_$i"};
$name = $self->{global}->{DIRECTORY}->{name}.'-'.$i unless $name;
$items[0]->[$i][0] = [ $name, $self->{images}->{"dir_$i"}, 0, '', $directory, $i, $name ];
$items[0]->[$i][1] = [];
my $ext_exclude = '\.~CodeManager'; $ext_exclude .= '|'.$self->{global}->{DIRECTORY}->{"ext_exclude_$i"} if $self->{global}->{DIRECTORY}->{"ext_exclude_$i"};
my $dir_exclude = '\.~CodeManager'; $dir_exclude .= '|'.$self->{global}->{DIRECTORY}->{"dir_exclude_$i"} if $self->{global}->{DIRECTORY}->{"dir_exclude_$i"};
# if ( $self->{global}->{DIRECTORY}->{"host_$i"} ) {
# $self->connect( $i );
# }
$items[0]->[$i][1] = [] unless $self-> read_tree( $items[0]->[$i][1], $directory, 1, $i, $ext_exclude, $dir_exclude );
$items[0]->[$i][2] = $self->{expanded}->{$name} || 0;
$self->{list}->[$i] = $items[0]->[$i][0];
$i++;
}
$self->{listdim} = 1;
delete $self->{tree} if $self->{tree};
$self->{tree} = $self->{frame_left}-> insert_to_frame(
1,
'CodeManager::Outline' =>
name => 'tree',
multiSelect => 0,
extendedSelect => 0,
path => './',
buffered => 0,
borderWidth => 1,
place => {
x=>0, relx => 0.5, width =>-6, relwidth => 1,
y=>-2, rely => 0.5, height =>-6, relheight => 1,
},
light3DColor=> $self->licz_kolor( 0xffffff, $project_color, 0.2 ),
dark3DColor => $self->licz_kolor( 0xffffff, $project_color, 0.4 ),
darkColor => $self->licz_kolor( 0xf7f7f7, $self->angle_color( $int_color , 255, 220 ), 0 ),
frameProfile => {
borderWidth => 1,
backColor => $self->licz_kolor( 0xffffff, $project_color, 0.5 ),
light3DColor=> $self->licz_kolor( 0xffffff, $project_color, 0.6 ),
dark3DColor => $self->licz_kolor( 0xffffff, $project_color, 0.4 ),
},
items => @items,
indent => $self->{global}->{GLOBAL}{tree_itemIndent},
itemHeight => $self->{global}->{GLOBAL}{tree_itemHeight},
# multiSelect => 1,
hScroll => 1,
vScroll => 1,
popupFont => {
name => 'DejaVu Sans',
size => 9,
style => fs::Normal,
},
font => {
name => $self->{global}->{GLOBAL}{tree_fontName},
$type_dimen => $font_dimen,
style => fs::Normal,
},
onMouseClick => sub {
my ($this, $btn, $mod, $x, $y, $dblclk) = @_;
my $clicked = int( $this->topItem + ($self->{tree}-> height - $y)/$this-> itemHeight );
if ( $btn == 4 && !$dblclk ) {
$this-> deselect_all ();
$this-> select_item ( $clicked );
$this-> focusedItem ( $clicked );
$popup = $self->popup_show (
$this,
$clicked,
left => $self->{frame_left}-> left + $x,
bottom => $self->{frame_left}-> bottom + $y,
title => 'Making tree',
itemHeight => $this-> itemHeight,
);
}
my @arr = $this-> get_item( $clicked );
if ( $arr[0]->[0] ) {
my $fn = $arr[0]->[0]->[4].'/'.$arr[0]->[0]->[0];
if ( $arr[0]->[0]->[3] eq 'file' && $fn && -e $fn && $dblclk ) {
$self->file_edit( $fn, $arr[0]->[0]->[5] );
}
}
#we remember (for later refreshing) if the branch is expanded:
$self->{expanded}->{$arr[0]->[0]->[6]} = $arr[0]->[2] if defined $arr[0]->[2];
},
onKeyDown => sub {
my ($this, $code, $key, $mode) = @_;
# print "$this, $code, $key, $mode\n";
if ( $code == 13 ) {
my $current = $this->focusedItem;
my @arr = $this-> get_item( $current );
if ( $arr[0]->[0] ) {
my $fn = $arr[0]->[0]->[4].'/'.$arr[0]->[0]->[0];
if ( $arr[0]->[0]->[3] eq 'file' && $fn && -e $fn ) {
$self->file_edit( $fn, $arr[0]->[0]->[5] );
}
}
#we remember (for later refreshing) if the branch is expanded:
$self->{expanded}->{$arr[0]->[0]->[6]} = $arr[0]->[2] if defined $arr[0]->[2];
}
},
);
$self->{tree}->set( topItem => $self->{expanded}->{topItem} ) if $self->{expanded}->{topItem};
$developer{ftt} = $self-> {frame_left}-> insert_to_frame (
0,
CheckList =>
items => [],
multiColumn => 0,
vertical => 1,
multiSelect => 1,
extendedSelect => 0,
place => {
x => 0, relx => 0.5, width => -6, relwidth => 1,
y => 0, rely => 0.5, height => -6, relheight => 1,
},
font => {
name => 'DejaVu Sans Mono',
size => 9,
style => fs::Normal,
},
frameProfile => {
borderWidth => 1,
backColor => $self->licz_kolor( 0xffffff, $project_color, 0.5 ),
light3DColor=> $self->licz_kolor( 0xffffff, $project_color, 0.6 ),
dark3DColor => $self->licz_kolor( 0xffffff, $project_color, 0.4 ),
},
lib/Prima/CodeManager/CodeManager.pm view on Meta::CPAN
while ( my $file = shift @_ ) {
my $ext = chr(254);
$ext = $1 if $file =~ /\.([^\.]*)$/;
$ext_contents{"ext_${ext}_$file"} = $file;
}
my @contents;
# according extentions:
foreach my $ext (sort mysort (keys(%ext_contents))) {
push @contents, $ext_contents{$ext}
}
# according names:
# foreach my $ext (sort {lc($ext_contents{$a}) cmp lc($ext_contents{$b}) } keys %ext_contents) {
# push @contents, $ext_contents{$ext}
# }
return @contents;
}
################################################################################
sub make_notebook
{
my ( $self ) = shift;
my $fontSize = $self->{global}->{GLOBAL}{notebook_fontSize} + 0; $fontSize = 10 if $fontSize < 1;
my $fontName = $self->{global}->{GLOBAL}{notebook_fontName} || 'DejaVu Sans Mono';
my $sliderWidth = 4;
undef $developer{notes};
$developer{notes} = $self->{frame_top}->insert_to_frame (
1,
'CodeManager::TabbedScrollNotebook' =>
tabs => [],
place => {
x=>0, relx => 0.5, width =>-6, relwidth => 1,
y=>0, rely => 0.5, height=>-6, relheight => 1,
},
colored => 1,
enabled => 1,
style => tns::Standard,
font => {
name => $fontName,
size => $fontSize,
style => fs::Normal,
},
orientation => tno::Top,
borderWidth => 1,
backColor => $self->licz_kolor( 0xffffff, $project_color, 0.5 ),
arrangement => fra::Vertical,
size => [$self->{mw}-> size],
origin => [0,0],
# frameSizes => [qw(3% *)],
opaqueResize => 1,
);
# for ( my $page = 0; $page < $file_number; $page++ ) {
# Prima::Notebook::delete_page( $developer{notes}, $page, 1 ) ;
# }
@list_of_files = ();
$file_number = 0;
$developer{notes}-> set_tabs( @list_of_files );
$developer{notes}-> repaint;
}
################################################################################
sub popup_show
{
my ( $self, $tree, $clicked ) = @_;
my @arr = $tree-> get_item( $clicked );
my $level = $arr[0]->[0]->[2];
my $name = $arr[0]->[0]->[0];
my $type = $arr[0]->[0]->[3]||'',
my $dir = $arr[0]->[0]->[4],
my $bra = $arr[0]->[0]->[5],
my %par;
my $i = 3;
while ( my $key = $_[$i] ) { $par{$key} = $_[$i+1]; $i += 2 }
$par{left} = 0 unless $par{left};
$par{bottom} = 0 unless $par{bottom};
$par{width} = 740;
$par{height} = 240;
my $x = [$self->{mw}->origin]->[0] + [$self->{frame_left}->pointerPos]->[0];
my $y = [$self->{mw}->origin]->[1] + [$self->{frame_left}->pointerPos]->[1] - $par{height} + $par{itemHeight};
my $tmp_popup = Prima::Dialog-> create(
title => $par{title},
text => $par{title},
origin => [ $x, $y ],
size => [ $par{width}, $par{height} ],
# borderIcons => 0,
# borderStyle => bs::None,
backColor => $self->licz_kolor( 0xffffff, $project_color, 0.5, 0 ),
onPaint => sub {
my ( $this, $canvas) = @_;
$canvas-> clear;
$canvas-> color( $self->licz_kolor( 0xffffff, $project_color, 0.2, 0 ) );
$canvas-> bar( 0, 0, $this-> width, $this-> height);
my $margin = 2;
my $width = 1;
$canvas-> color( $self->licz_kolor( 0xffffff, $project_color, 0.8, 0 ) );
$canvas-> fillpoly([
$margin, $margin,
$margin, $this-> height - $margin - 1,
$this-> width - $margin - 1, $this-> height - $margin - 1,
$this-> width - $margin - 1, $margin
]);
$canvas-> color( $self->licz_kolor( 0xffffff, $project_color, 0.5, 0 ) );
$canvas-> fillpoly([
$margin + $width, $margin + $width,
$margin + $width, $this-> height - $margin - 1 - $width,
$this-> width - $margin - 1 - $width, $this-> height - $margin - 1 - $width,
$this-> width - $margin - 1 - $width, $margin + $width
]);
},
);
$tmp_popup->insert( Label =>
origin => [ 10, $par{height} - 30 ],
size => [ $par{width} - 20, 20 ],
text => $name,
flat => 1,
x_centered => 1,
alignment => ta::Center,
color => $self->licz_kolor( 0x000000, $project_color, 0.8, 0 ),
borderWidth => 1,
font => { size => 10, style => fs::Normal, },
);
$tmp_popup->insert( Button =>
origin => [ 10, 10 ],
size => [ 80, 20 ],
text => 'Cancel',
enabled => 1,
flat => 0,
color => 0x000000,
borderWidth => 1,
borderColor => 0xffffff,
backColor => $self->licz_kolor( 0xffffff, $project_color, 0.8, 0 ),
font => { size => 9, style => fs::Normal, },
onClick => sub {
$tmp_popup->close;
undef $popup;
},
);
#----------------------------------------------------------------
my $input = $tmp_popup-> insert( InputLine =>
origin => [ 10, $par{height} -55 ],
size => [ 480, 20 ],
text => $name,
flat => 0,
alignment => ta::Left,
color => 0x000000,
borderWidth => 1,
font => {
size => 10,
style => fs::Normal,
},
backColor => 0xffffff,
);
#----------------------------------------------------------------
my @lista = split /\n/, $self->read_file( "$home_directory/templates/templates.ini" );
my @template_names = ('...');
my @template_files = ('' );
my $j = 0;
foreach (@lista) {
if ( $_ =~ /^(.*?)=(.*)$/ ) {
my ( $file, $name ) = ( $1, $2 );
$file =~ s/^\s*//; $file =~ s/\s*$//;
$name =~ s/^\s*//; $name =~ s/\s*$//;
next unless $file && $name;
if ( $file ne 'line' ) {
$j++;
push @template_files, $file;
push @template_names, "$j. $name";
} else {
push @template_names, "";
}
}
}
my $check1 = $tmp_popup-> insert( ComboBox =>
origin => [ 10, $par{height} -80 ],
size => [ 480, 20 ],
style => (cs::DropDownList),
items => [( @template_names )],
flat => 1,
font => {
size => 9,
style => fs::Normal,
},
);
#-------------------------------------------------------------
$tmp_popup-> insert( Button =>
origin => [ 500, $par{height} - 55 ],
size => [ 230, 20 ],
text => 'Insert',
enabled => 1,
flat => 0,
color => 0x000000,
borderWidth => 1,
borderColor => 0xffffff,
backColor => $self->licz_kolor( 0xffffff, $project_color, 0.8, 0 ),
font => { size => 9, style => fs::Normal, },
onClick => sub {
if ( $input-> text eq '' ) {
Prima::message ( "No name!" );
} else {
my $go = 1;
foreach (@{$self->{list}}) {
if ( "$dir/$name" eq $_->[4] && $_->[3] eq '' ) {
if ( $input-> text eq $_->[0] ) {
$go = 0;
last;
}
}
}
if ( $go ) {
my $tmp_name = "$name/";
$tmp_name = '' unless $level;
my $template_file = '';
if ( $check1-> text =~ /(\d+)\./ ) { $template_file = $template_files[$1] if $1 }
my $info = $self-> make_object (
action => 'Insert',
name => "$dir/$tmp_name".$input-> text,
branch => $bra,
template=> $template_file,
);
if ( $info eq 'OK' ) {
$self-> make_tree;
} else {
Prima::message ( $info );
}
$tmp_popup-> close();
undef $popup ;
} else {
Prima::message ( "The name [$name] already exists!" );
}
}
},
);
#-------------------------------------------------------------
$tmp_popup->insert( Button =>
origin => [ 500, $par{height} - 80 ],
size => [ 230, 20 ],
text => 'Update',
enabled => 1,
flat => 0,
color => 0x000000,
borderWidth => 1,
borderColor => 0xffffff,
backColor => $self->licz_kolor( 0xffffff, $project_color, 0.8, 0 ),
font => { size => 9, style => fs::Normal, },
onClick => sub {
if ( $input->text eq '' ) {
Prima::message ( "No name!" );
} elsif ( $input->text eq $name ) {
Prima::message ( "The same name!" );
} else {
my $info = $self-> make_object (
action => 'Update',
name => "$dir/".$input->text,
branch => $bra,
old_name => "$dir/".$name,
);
if ( $info eq 'OK' ) {
$self-> make_tree;
$tmp_popup->close();
undef $popup ;
} else {
Prima::message ( $info );
}
}
},
);
#-------------------------------------------------------------
$tmp_popup->insert( Button =>
origin => [ 500, $par{height} -105 ],
size => [ 230, 20 ],
text => 'Backup',
enabled => 1,
flat => 0,
color => 0x000000,
borderWidth => 1,
borderColor => 0xffffff,
backColor => $self->licz_kolor( 0xffffff, $project_color, 0.8, 0 ),
font => { size => 9, style => fs::Normal, },
onClick => sub {
my $info = $self-> make_object (
action => 'Backup',
name => "$dir/".$name,
branch => $bra,
);
if ( $info eq 'OK' ) {
my ( $x, $l ) = $tree-> get_item( $tree-> focusedItem );
$tree-> delete_item ( $x );
$tmp_popup->close();
undef $popup ;
} else {
Prima::message ( $info );
}
},
);
#-------------------------------------------------------------
$tmp_popup->insert( Button =>
origin => [ 500, $par{height} -130 ],
size => [ 230, 20 ],
text => 'Copy',
enabled => 1,
flat => 0,
color => 0x000000,
borderWidth => 1,
borderColor => 0xffffff,
backColor => $self->licz_kolor( 0xffffff, $project_color, 0.8, 0 ),
font => { size => 9, style => fs::Normal, },
onClick => sub {
if ( $input->text eq '' ) {
Prima::message ( "No name!" );
} elsif ( $input->text eq $name ) {
Prima::message ( "The same name!" );
} else {
my $info = $self-> make_object (
action => 'Copy',
old_name => "$dir/".$name,
name => "$dir/".$input->text,
branch => $bra,
);
if ( $info eq 'OK' ) {
$self-> make_tree;
$tmp_popup->close();
undef $popup ;
} else {
Prima::message ( $info );
}
}
},
);
#-------------------------------------------------------------
$tmp_popup->insert( Button =>
origin => [ 500, $par{height} -155 ],
size => [ 230, 20 ],
text => 'Delete',
enabled => 1,
flat => 0,
color => 0x000000,
borderWidth => 1,
borderColor => 0xffffff,
backColor => $self->licz_kolor( 0xffffff, $project_color, 0.8, 0 ),
font => { size => 9, style => fs::Normal, },
onClick => sub {
my $info = $self-> make_object (
action => 'Delete',
name => "$dir/".$name,
branch => $bra,
);
if ( $info eq 'OK' ) {
my ( $x, $l ) = $tree-> get_item( $tree-> focusedItem );
$tree-> delete_item ( $x );
$tmp_popup->close();
undef $popup ;
} else {
Prima::message ( $info );
}
},
);
#-------------------------------------------------------------
$tmp_popup->insert( Button =>
origin => [ 500, 10 ],
size => [ 230, 20 ],
text => 'find files with the text',
enabled => 1,
flat => 0,
color => 0x000000,
borderWidth => 1,
borderColor => 0xffffff,
backColor => $self-> licz_kolor( 0xffffff, $project_color, 0.8, 0 ),
font => { size => 9, style => fs::Normal, },
onClick => sub {
my @files = ();
foreach ( @{$self->{list}} ) {
my $fn = $_->[4]."/".$_->[0];
next unless $_->[3] eq 'file' && $fn =~ /$self->{global}->{DIRECTORY}->{"directory_$bra"}/;
push @files, $fn if ftt_has_feature( $fn, $input-> text );
}
my $cap = join "\n",@files,"\n";
$developer{ftt}-> set (
items => [@files],
onMouseClick => sub {
my ($this, $btn, $mod, $x, $y, $dblclk ) = @_;
my $clicked = int( $this-> topItem + ($developer{ftt}-> height - $y)/$this-> itemHeight );
my $fn = $developer{ftt}-> items-> [$clicked] ? $developer{ftt}-> items-> [$clicked] : '';
$self-> file_edit( $fn, $bra ) if $dblclk && -f $fn;
}
);
$tmp_popup-> close();
undef $popup ;
},
);
$tmp_popup->execute;
return $tmp_popup;
}
########################################################################
sub make_object
{
my ( $self ) = shift;
my %par;
while ( my $key = shift ) { $par{$key} = shift }
return "No name defined!" unless $par{name};
my $ext = '';
my $default = '';
if ( $par{name} =~ /\.([^\.\\\/]+)$/ ) {
$ext = $1;
$default = "$home_directory/templates/default/$ext.pl";
}
if ( $par{action} eq 'Insert' ) {
if ( -e $par{name} ) {
return "Object with the name: ['$par{name}'] already exists!";
} else {
# file is created when extension is defined:
if ( $ext ) {
# if there is template chosen:
if ( $par{template} && -e "$home_directory/templates/".$par{template} ) {
our @_ARGV = ( $self, $self->{global}->{DIRECTORY}->{"directory_".$par{branch}}, $par{name}, $par{branch}||0 );
eval $self-> read_file( "$home_directory/templates/".$par{template});
# next if there is a default extension template:
} elsif ( -e $default ) {
our @_ARGV = ( $self, $self->{global}->{DIRECTORY}->{"directory_".$par{branch}}, $par{name} );
eval $self-> read_file( $default );
# remain only to create empty file:
} else {
eval { $self-> write_to_file( $par{name}, '' ); };
}
} else {
# if no extension there is a directory:
# if there is template chosen:
if ( $par{template} && -e "$home_directory/templates/".$par{template} ) {
our @_ARGV = ( $self, $self->{global}->{DIRECTORY}->{"directory_".$par{branch}}, $par{name}, $par{branch}||0 );
eval $self-> read_file( "$home_directory/templates/".$par{template} );
# remain only to create empty directory (with .exists file only:
} else {
eval { make_path ( $par{name} ) };
# $self->write_to_file( $par{name}.'/.exists','');
}
}
return $@ || 'OK';
}
} elsif ( $par{action} eq 'Copy' ) {
( run in 0.740 second using v1.01-cache-2.11-cpan-364913b4093 )