package Padre::Plugin::Parrot::ColorizeTask;
use strict;
use warnings;
use base 'Padre::Task';
use Scalar::Util ();
our $VERSION = '0.26';
our $thread_running = 0;
# This is run in the main thread before being handed
# off to a worker (background) thread. The Wx GUI can be
# polled for information here.
# If you don't need it, just inherit this default no-op.
sub prepare {
my $self = shift;
# it is not running yet.
$self->{broken} = 0;
return if $self->{_editor};
$self->{_editor} = Scalar::Util::refaddr(Padre::Current->editor);
# assign a place in the work queue
if($thread_running) {
# single thread instance at a time please. aborting...
$self->{broken} = 1;
return "break";
}
$thread_running = 1;
return 1;
}
sub is_broken {
my $self = shift;
return $self->{broken};
}
# used for coloring by parrot
my %colors = (
# Perl 6
quote_expression => Padre::Constant::PADRE_BLUE,
parse => undef,
statement_block => undef,
statementlist => undef,
statement => undef,
expr => undef,
'term:' => undef,
noun => undef,
value => undef,
quote => undef,
quote_concat => undef,
quote_term => undef,
quote_literal => undef,
post => Padre::Constant::PADRE_MAGENTA,
dotty => undef,
dottyop => undef,
methodop => Padre::Constant::PADRE_GREEN,
name => Padre::Constant::PADRE_GREEN,
identifier => undef,
term => undef,
args => undef,
arglist => undef,
EXPR => undef,
statement_control => undef,
use_statement => undef,
sym => Padre::Constant::PADRE_RED,
'infix:=' => Padre::Constant::PADRE_GREEN,
'infix:+' => Padre::Constant::PADRE_GREEN,
'infix:,' => Padre::Constant::PADRE_GREEN,
'infix:..' => undef,
'prefix:=' => undef,
'infix:|' => undef,
'infix:==' => undef,
'infix:*=' => undef,
twigil => undef,
if_statement => undef,
'infix:eq' => undef,
semilist => undef,
scope_declarator => undef,
scoped => undef,
variable_declarator => undef,
declarator => undef,
variable => Padre::Constant::PADRE_RED,
integer => undef,
number => Padre::Constant::PADRE_BROWN,
circumfix => undef,
param_sep => undef,
sigil => undef,
desigilname => undef,
longname => undef,
parameter => undef,
param_var => undef,
quant => undef,
pblock => undef,
block => undef,
signature => undef,
for_statement => undef,
xblock => undef,
lambda => Padre::Constant::PADRE_GREEN,
# Cardinal
ident => undef,
local_variable => undef,
basic_primary => undef,
basic_stmt => undef,
stmt => undef,
before => undef,
mrhs => undef,
varname => undef,
stmts => undef,
comp_stmt => undef,
assignment => undef,
mlhs => undef,
literal => undef,
arg => undef,
call_arsg => undef,
funcall => undef,
post_primary_expr => undef,
call_args => undef,
string => undef,
);
# This is run in the main thread after the task is done.
# It can update the GUI and do cleanup.
# You don't have to implement this if you don't need it.
sub finish {
my $self = shift;
my $mainwindow = shift;
my $editor = Padre::Current->editor;
my $addr = delete $self->{_editor};
if (not $addr or not $editor or $addr ne Scalar::Util::refaddr($editor)) {
# shall we try to locate the editor ?
$thread_running = 0;
return 1;
}
my $doc = Padre::Current->document;
if (not $doc) {
$thread_running = 0;
return 1;
}
if($self->{_parse_tree}) {
$doc->remove_color;
foreach my $pd (@{$self->{_parse_tree}}) {
my $type = $pd->{type};
if (not exists ($colors{$type})) {
warn "No color definiton for '$type': " .
$pd->{str} . "\n";
next;
}
if(not defined $colors{$type}) {
# no need to color
next;
}
my $color = $colors{$type};
$editor->StartStyling($pd->{start}, $color);
$editor->SetStyling($pd->{length}, $color);
}
}
$doc->{tokens} = [];
$doc->{issues} = [];
#$doc->check_syntax_in_background(force => 1); # $task-
#$doc->get_outline(force => 1);
# finished here
$thread_running = 0;
return 1;
}
# Task thread subroutine
sub run {
my $self = shift;
use File::Temp qw(tempdir);
my $dir = tempdir(CLEANUP => 1);
my $file = "$dir/file";
if (open my $fh, '>', $file) {
print $fh $self->{text};
delete $self->{text};
} else {
warn "Could not open $file for writing\n";
return;
}
# TODO check if the path is there
my $cmd = ($self->{pbc} ? qq("$ENV{PARROT_DIR}/parrot" ) : '');
$cmd .= qq("$self->{path}");
$cmd .= qq( --target=parse --dumper=padre "$file");
#print "$cmd\n";
my @data = `$cmd`;
chomp @data;
my @pd;
foreach my $line (@data) {
$line =~ s/^\s+//;
my ($start, $length, $type, $str) = split /\s+/, $line, 4;
push @pd, {
start => $start,
length => $length,
type => $type,
str => $str,
};
}
$self->{_parse_tree} = \@pd;
return;
return 1;
};
1;
__END__
=head1 AUTHOR
Ahmad M. Zawawi C<< <ahmad.zawawi at gmail.com> >>
Gabor Szabo L<http://szabgab.com/>
=head1 COPYRIGHT AND LICENSE
Copyright 2008-2009 Padre Developers as in Perl6.pm
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl 5 itself.