You've already forked SmartConfigurator
mirror of
https://github.com/ret-Phoenix/SmartConfigurator.git
synced 2026-06-09 22:05:18 +02:00
SUshakov
0ae5eda157
+ Навигация по модулю переписана на 1script + Заготовка для Навигация по метаданным на 1script
722 lines
18 KiB
Perl
722 lines
18 KiB
Perl
#$ENGINE PerlScript
|
|
#$NAME CodeBeautifier
|
|
#äëÿ èñïîëüçîâàíèÿ ñêðèïòà â OpenConf ðàñêîììåíòèðóéòå äâå ïðåäûäóùèå ñòðî÷êè
|
|
|
|
|
|
#Àâòîð - Äèðêñ Àëåêñåé mailto:adirks@ngs.ru
|
|
#
|
|
#Ýòà ïðîãðàììà ÿâëÿåòñÿ ñâîáîäíûì ïðîãðàììíûì îáåñïå÷åíèåì. Âû ìîæåòå
|
|
#ðàñïðîñòðàíÿòü è (èëè) ìîäèôèöèðîâàòü åå íà óñëîâèÿõ GNU Generic Public License.
|
|
#
|
|
#Äàííàÿ ïðîãðàììà ðàñïðîñòðàíÿåòñÿ ñ íàäåæäîé îêàçàòüñÿ ïîëåçíîé, íî
|
|
#ÁÅÇ ÊÀÊÈÕ-ËÈÁÎ ÃÀÐÀÍÒÈÉ, â òîì ÷èñëå áåç ãàðàíòèé ïðèãîäíîñòè äëÿ ïðîäàæè èëè
|
|
#êàêèõ-ëèáî äðóãèõ ïðàêòè÷åñêèõ öåëåé.
|
|
#
|
|
#Ñ ïîëíûì òåêñòîì ëèöåíçèè íà àíãëèéñêîì ÿçûêå ìîæíî îçíàêîìèòñüÿ ïî àäðåñó
|
|
#http://www.gnu.org/licenses/gpl.txt èëè â ôàéëå
|
|
#gnugpl.eng.txt
|
|
#
|
|
#Ñ ðóññêèì ïåðåâîäîì ëèöåíçèè ìîæíî îçíàêîìèòüñÿ ïî àäðåñó
|
|
#http://gnu.org.ru/gpl.html èëè â ôàéëå
|
|
#gnugpl.rus.txt
|
|
#
|
|
#Âû äîëæíû ïîëó÷èòü êîïèþ GNU Generic Public License âìåñòå ñ êîïèåé ýòîé ïðîãðàììû.
|
|
#Åñëè ýòî íå òàê - ñîîáùèòå îá ýòîì àâòîðàì (mailto:adirks@ngs.ru , mailto:fe@alterplast.ru) èëè íàïèøèòå
|
|
#Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
|
|
use vars qw/ $InOpenConf /;
|
|
$InOpenConf = 1 if( defined $Configurator);
|
|
|
|
use strict "vars"; #Çàïðåòèì èñïîëüçîâàòü íåîáúÿâëåííûå ïåðåìåííûå
|
|
use locale;
|
|
use POSIX qw(locale_h);
|
|
use Getopt::Long;
|
|
use File::Find; #package äëÿ ðåêóðñèâíîãî îáõîäà êàòàëîãîâ
|
|
|
|
#Îáúÿâèì ãëîáàëüíûå ïåðåìåííûå
|
|
use vars qw/ $tab_size
|
|
$blank_after_proc $blank_before_endproc $blank_after_endproc $procname_after_endproc
|
|
$blank_after_if $blank_before_elseif $blank_before_endif
|
|
$blank_after_while $blank_before_wend
|
|
$space_around_ops /;
|
|
use vars qw/ $pat_comment $pat_proc $pat_endproc /;
|
|
use vars qw/ $file_name $root_dir $keep_old_files /;
|
|
use vars qw/ $line $line_number $trimmed_line $state @states $level /;
|
|
use vars qw/ $proc_name $proc_start /;
|
|
use vars qw/ $in_string $skip_blanks $blank_lines $unended_operator/;
|
|
use vars qw/ $FormattedText /;
|
|
|
|
############################################################################
|
|
## Íàñòðîéêè ôîðìàòèðîâàíèÿ êîäà ################################
|
|
$tab_size = 4;
|
|
$blank_after_proc = 0; #Ïóñòàÿ ñòðîêà â íà÷àëå ïðîöåäóðû/ôóíêöèè
|
|
$blank_before_endproc = 0; #Ïóñòàÿ ñòðîêà â êîíöå ïðîöåäóðû/ôóíêöèè
|
|
$blank_after_endproc = 1; #Ïóñòàÿ ñòðîêà ïîñëå ïðîöåäóðû/ôóíêöèè
|
|
$procname_after_endproc = 30;#Èìÿ ìåòîäà â êîììåíòàðèÿõ ïîñëå çàâåðøåíèÿ (íàïðèìåð ÊîíåöÏðîöåäóðû //ÏðèÎòêðûòèè)
|
|
#Çíà÷åíèå ýòîé ïåðåìåííîé - ýòî êîëè÷åñòâî ñòðîê, ïîñëå êîòîðîãî ìåòîä ñ÷èòàåòñÿ
|
|
#"áîëüøèì", è íóæíî âñòàâëÿòü êîììåíòàðèé. Åñëè ðàçìåð ìåòîäà ìåíüøå óêàçàííîãî, òî
|
|
#êîììåíòàðèé óáèðàåòñÿ
|
|
#Îòðèöàòåëüíîå çíà÷åíèå - êîììåíòàðèè îñòàíóòñÿ êàê åñòü
|
|
$blank_after_if = 0; #Ïóñòàÿ ñòðîêà â íà÷àëå áëîêà 'Åñëè'
|
|
$blank_before_elseif = 0; #Ïóñòàÿ ñòðîêà ïåðåä 'Èíà÷å', 'Èíà÷åÅñëè'
|
|
$blank_before_endif = 0; #Ïóñòàÿ ñòðîêà ïåðåä 'ÊîíåöÅñëè'
|
|
$blank_after_while = 0; #Ïóñòàÿ ñòðîêà â íà÷àëå öèêëîâ 'Ïîêà' è 'Äëÿ'
|
|
$blank_before_wend = 0; #Ïóñòàÿ ñòðîêà â êîíöå öèêëîâ 'Ïîêà' è 'Äëÿ'
|
|
$space_around_ops = 1; #Ïðîáåëû îêîëî îïåðàòîðîâ è ïîñëå çàïÿòûõ
|
|
############################################################################
|
|
|
|
$pat_comment = "\/\/.*"; #EOL comment pattern
|
|
$pat_proc = "Ôóíêöèÿ|Function|Ïðîöåäóðà|Procedure";
|
|
$pat_endproc = "ÊîíåöÔóíêöèè|EndFunction|ÊîíåöÏðîöåäóðû|EndProcedure";
|
|
|
|
my $usage = <<EOF
|
|
Èñïîëüçîâàíèå:
|
|
perl code_beautifier.pl [ïàðàìåòðû]
|
|
Ïàðàìåòðû ìîãóò áûòü:
|
|
-h|--help - ýòîò òåêñò
|
|
-d|--dir <dir> - êàòàëîã, îòêóäà íà÷í¸òñÿ ïîèñê ïðîãðàììíûõ ìîäóëåé äëÿ ôîðìàòèðîâàíèÿ (*.1S).
|
|
Ïî óìîë÷àíèþ ïîèñê íà÷èíàåòñÿ ñ òåêóùåãî êàòàëîãà.
|
|
-f|--file <file> - èìÿ ôàéëà, êîòîðûé íóæíî îòôîðìàòèðîâàòü. Åñëè çàäàí è êàòàëîã è èìÿ ôàéëà,
|
|
òî îòôîðìàòèðîâàí áóäåò òîëüêî ôàéë.
|
|
-k|--keep - ñîõðàíÿåò èñõîäíûå ìîäóëè íåòðíóòûìè, èçìåíåíèÿ çàïèñûâàþòñÿ â ôàéëû *.new.1S
|
|
EOF
|
|
;
|
|
|
|
$root_dir = '.';
|
|
|
|
#################################################################################
|
|
#################################################################################
|
|
main(); #äëÿ èñïîëüçîâàíèÿ êàê OpenConf ñêðèïò ýòó ñòðî÷êó íàäî çàêîììåíòèðîâàòü
|
|
#################################################################################
|
|
#################################################################################
|
|
|
|
|
|
sub main
|
|
{
|
|
return if( $InOpenConf );
|
|
|
|
die wintodos($usage) unless GetOptions("dir|d=s" => \$root_dir, "file|f=s" => \$file_name, "keep|k" => \$keep_old_files);
|
|
|
|
if( $file_name )
|
|
{
|
|
$File::Find::name = $file_name;
|
|
$_ = $file_name;
|
|
BeautifyModule();
|
|
}
|
|
else
|
|
{
|
|
find(\&BeautifyModule, $root_dir);
|
|
}
|
|
}
|
|
|
|
sub Beautify_OpenConf
|
|
{
|
|
my $Text = shift;
|
|
my @Lines = split(/\r\n/, $Text, -1);
|
|
_BeautifyModule(@Lines);
|
|
#Message("'$FormattedText'");
|
|
$FormattedText =~ s/\n/\r\n/g;
|
|
return $FormattedText;
|
|
}
|
|
|
|
sub perror
|
|
{
|
|
if( $InOpenConf )
|
|
{
|
|
Message(shift, 1);
|
|
}
|
|
else
|
|
{
|
|
print STDERR wintodos(shift), "\n";
|
|
}
|
|
}
|
|
|
|
|
|
sub _BeautifyModule
|
|
{
|
|
my @Lines = @_;
|
|
$line_number = 0;
|
|
my $NLines = @_;
|
|
|
|
$FormattedText = "";
|
|
$state = "module";
|
|
$level = 0;
|
|
pop @states while (scalar @states) > 0;
|
|
$skip_blanks = 0;
|
|
$blank_lines = 0;
|
|
$in_string = 0;
|
|
$unended_operator = 0;
|
|
my $module_head = 1;
|
|
|
|
foreach $line (@Lines)
|
|
{
|
|
$line_number++;
|
|
$line =~ s/[\r\n]//g; #óáåð¸ì çàâåðøàþùèå \n è \r, åñëè îíè òàì åñòü
|
|
$trimmed_line = $line;
|
|
$trimmed_line =~ s/^\s*(.*?)\s*$/$1/;
|
|
#print "$state, $level, $skip_blanks (blanks = $blank_lines), unended = $unended_operator : '$trimmed_line'\n";
|
|
|
|
if( not $trimmed_line )
|
|
{
|
|
$blank_lines++ if not $skip_blanks;
|
|
next;
|
|
}
|
|
|
|
if( $InOpenConf ) { Status("$line_number / $NLines"); }
|
|
|
|
my $keyword_match = 0;
|
|
|
|
if( $state eq "module" )
|
|
{
|
|
$keyword_match = 1 if check_proc_begin() or check_if() or check_cycle() or check_try();
|
|
if( $keyword_match and $module_head )
|
|
{
|
|
$FormattedText .= "\n" if $blank_lines;
|
|
$module_head = 0;
|
|
}
|
|
}
|
|
elsif( $state eq "proc" )
|
|
{
|
|
$keyword_match = 1 if check_end_proc() or check_if() or check_cycle() or check_try() or check_proc_begin();
|
|
}
|
|
elsif( $state eq "if_multiline" )
|
|
{
|
|
check_multiline_if();
|
|
$keyword_match = 1;
|
|
}
|
|
elsif( $state eq "if" )
|
|
{
|
|
$keyword_match = 1 if check_if() or check_cycle() or check_elsif() or check_endif() or check_try() or check_proc_begin();
|
|
}
|
|
elsif( $state eq "try" )
|
|
{
|
|
$keyword_match = 1 if check_try() or check_if() or check_cycle();
|
|
}
|
|
elsif( $state eq "cycle" )
|
|
{
|
|
$keyword_match = 1 if check_cycle() or check_endcycle() or check_if() or check_try() or check_proc_begin();
|
|
}
|
|
|
|
if( $keyword_match )
|
|
{
|
|
#$blank_lines = 0;
|
|
$unended_operator = 0;
|
|
next;
|
|
}
|
|
|
|
$unended_operator = 0 if $in_string and $unended_operator == 0;
|
|
|
|
#Message("$line: $state $skip_blanks $blank_lines");
|
|
$FormattedText .= "\n" if $blank_lines;
|
|
$blank_lines = 0;
|
|
if( $unended_operator )
|
|
{ print_line( offset(1), format_expr($trimmed_line) ); }
|
|
else
|
|
{ print_line( format_expr($trimmed_line) ); }
|
|
$skip_blanks = 0;
|
|
|
|
if( not $in_string )
|
|
{
|
|
if( $trimmed_line =~ m/^.*;(\s*$pat_comment)*$/ )
|
|
{$unended_operator = 0;}
|
|
elsif( $trimmed_line =~ m/^$pat_comment$/ )
|
|
{$unended_operator = 0;}
|
|
else
|
|
{$unended_operator++;}
|
|
}
|
|
}
|
|
|
|
if( $InOpenConf ) { Status(""); }
|
|
return $FormattedText;
|
|
}
|
|
|
|
sub BeautifyModule
|
|
{
|
|
my $FName = $_; #File::Find ñêëàäûâàåò â $_ èìÿ òåêóùåãî ôàéëà
|
|
if( $file_name )
|
|
{
|
|
$FName = $file_name;
|
|
}
|
|
else
|
|
{
|
|
return unless $FName =~ m/^(.*)(\.1S)$/i; #íàì íóæíû òîëüêî ôàéëû ñ ðàñøèðåíèåì 1S
|
|
return if $FName =~ m/^(.*)(\.new\.1S)$/i; #íàì íå íóæíû ôàéëû ñ ðàñøèðåíèåì new.1S
|
|
}
|
|
$FName =~ m/^(.*)(\.\S*)$/i;
|
|
my $newFName = "$1.new$2";
|
|
|
|
perror($File::Find::name);
|
|
open IN, "< $FName";
|
|
open OUT, "> $newFName";
|
|
|
|
print OUT _BeautifyModule((<IN>));
|
|
|
|
close OUT;
|
|
close IN;
|
|
if( not $keep_old_files )
|
|
{
|
|
if( !rename($newFName, $FName) )
|
|
{
|
|
print wintodos("Can't move $newFName to $FName: $!\n");
|
|
}
|
|
}
|
|
}
|
|
|
|
sub format_op_spaces
|
|
{
|
|
my $lspace = shift;
|
|
my $op = shift;
|
|
my $rspace = shift;
|
|
|
|
return ("", "") if not $space_around_ops;
|
|
$lspace = " " if not $lspace and $op ne ",";
|
|
$rspace = " " if not $rspace;
|
|
return ($lspace, $rspace);
|
|
}
|
|
|
|
sub format_expr
|
|
{
|
|
my $expr = shift;
|
|
my $formatted = "";
|
|
my $lspace = "";
|
|
my $rspace = "";
|
|
my $op = "";
|
|
|
|
if( $expr =~ m/^(\s+)(.*)$/ )
|
|
{
|
|
$formatted = $1;
|
|
$expr = $2;
|
|
}
|
|
#$expr =~ s/^((.*?)("[^"]*")*)(\s*$pat_comment)*$/$1/;
|
|
#my $eol_comment = $2;
|
|
my $eol_comment = '';
|
|
|
|
while( length($expr) > 0 )
|
|
{
|
|
if( $in_string )
|
|
{
|
|
my $c = substr($expr, 0, 1);
|
|
if( $c eq '"' )
|
|
{
|
|
if( substr($expr, 1, 1) eq '"' )
|
|
{
|
|
$formatted .= '"';
|
|
$expr = substr($expr, 1);
|
|
}
|
|
else
|
|
{
|
|
$in_string = 0;
|
|
}
|
|
}
|
|
$formatted .= $c;
|
|
$expr = substr($expr, 1);
|
|
}
|
|
elsif( substr($expr, 0, 1) eq '"' )
|
|
{
|
|
$formatted .= $lspace . '"';
|
|
$expr = substr($expr, 1);
|
|
$in_string = 1;
|
|
}
|
|
elsif( substr($expr, 0, 1) eq '/' and substr($expr, 1, 1) eq '/') #EOL comment
|
|
{
|
|
$eol_comment = $expr;
|
|
$expr = '';
|
|
}
|
|
elsif( $expr =~ m/^\s*;(.*)$/i ) #ending ';'
|
|
{
|
|
$expr = $1;
|
|
$formatted .= ";";
|
|
($lspace, $rspace) = ("", "");
|
|
}
|
|
elsif( $expr =~ m/^(=|\(|\+|Return|Âîçâðàò)(\s*)-\s*(.*)$/i ) #unary minus
|
|
{
|
|
$op = $1;
|
|
$rspace = $2;
|
|
$expr = $3;
|
|
($lspace, $rspace) = format_op_spaces($lspace, $op, $rspace);
|
|
#Message("'$lspace' '$op' '$rspace' '$expr'");
|
|
$formatted .= $lspace . $op . $rspace . "-";
|
|
|
|
($lspace, $rspace) = ("", "");
|
|
}
|
|
elsif( $expr =~ m/^(<>|<=|>=|,|=|\+|-|\*|\/|%|<|>)(\s*)(.*)$/i )
|
|
{
|
|
$op = $1;
|
|
$rspace = $2;
|
|
$expr = $3;
|
|
|
|
($lspace, $rspace) = format_op_spaces($lspace, $op, $rspace);
|
|
$rspace = "" if $op eq "," and substr($expr, 0, 1) eq ","; #2 çàïÿòûå ïîäðÿä - áåç ïðîáåëà
|
|
|
|
$formatted .= $lspace . $op . $rspace;
|
|
|
|
($lspace, $rspace) = ("", "");
|
|
}
|
|
elsif( $expr =~ m/^(\)\s*)(È|AND|ÈËÈ|OR)(\s*\()(.*)$/i )
|
|
{
|
|
$op = uc($2);
|
|
$lspace = substr($1, 1);
|
|
$rspace = substr($3, 0, length($3) - 1);
|
|
($lspace, $rspace) = format_op_spaces($lspace , $op, $rspace);
|
|
|
|
$formatted .= ")" . $lspace . $op . $rspace . "(";
|
|
$expr = $4;
|
|
|
|
$lspace = "";
|
|
$rspace = "";
|
|
}
|
|
elsif( not $formatted and $expr =~ m/^(È|AND|ÈËÈ|OR)(\s*\()(.*)$/i )
|
|
{
|
|
$op = uc($1);
|
|
$rspace = substr($2, 0, length($2) - 1);
|
|
($lspace, $rspace) = format_op_spaces($lspace , $op, $rspace);
|
|
|
|
$formatted .= $op . $rspace . "(";
|
|
$expr = $3;
|
|
|
|
$lspace = "";
|
|
$rspace = "";
|
|
}
|
|
elsif( $expr =~ m/^(\)\s*)(È|AND|ÈËÈ|OR)$/i )
|
|
{
|
|
$op = uc($2);
|
|
$lspace = substr($1, 1);
|
|
$rspace = "";
|
|
($lspace, $rspace) = format_op_spaces($lspace , $op, $rspace);
|
|
|
|
$formatted .= ")" . $lspace . $op;
|
|
$expr = "";
|
|
|
|
$lspace = "";
|
|
$rspace = "";
|
|
}
|
|
elsif( $expr =~ m/^(\s+)(.*)$/ )
|
|
{
|
|
$rspace = $1;
|
|
$expr = $2;
|
|
}
|
|
else
|
|
{
|
|
$formatted .= $lspace;
|
|
$formatted .= substr($expr, 0, 1);
|
|
$expr = substr($expr, 1);
|
|
$rspace = "";
|
|
}
|
|
|
|
$lspace = $rspace;
|
|
}
|
|
$formatted .= $rspace;
|
|
$formatted .= $eol_comment;
|
|
|
|
return $formatted;
|
|
}
|
|
|
|
sub check_proc_begin
|
|
{
|
|
if( $trimmed_line =~ m/^($pat_proc)(\s+(\S+)\(.*\)\s*)(Ýêñïîðò|Export)*(.*)($pat_endproc)(\s*)($pat_comment)*$/i )
|
|
{
|
|
perror(" Ñèíòàêñè÷åñêèå îøèáêè â ïðîöåäóðå '$proc_name'") if $level > 0;
|
|
$proc_name = "";
|
|
$proc_start = 0;
|
|
print_line(ucfirst($1), format_expr($2), ucfirst($4), $5, ucfirst($6), $7, $8);
|
|
$level = 0;
|
|
$unended_operator = 0;
|
|
return 1;
|
|
}
|
|
elsif( $trimmed_line =~ m/^($pat_proc)(\s+)(\S+)(\s*\(.*\))((\s+(Ýêñïîðò|Export|Äàëåå|Forward))*)(;*)(\s*$pat_comment)*$/i )
|
|
{
|
|
perror(" Ñèíòàêñè÷åñêèå îøèáêè â ïðîöåäóðå '$proc_name'") if $level > 0;
|
|
$proc_name = $3;
|
|
$proc_start = $line_number;
|
|
$level = 0;
|
|
print_line(ucfirst($1), $2, $3, format_expr($4), ucfirst($5), $8, $9);
|
|
if( not $5 =~ m/Äàëåå|Forward/i )
|
|
{
|
|
push @states, $state;
|
|
$state = "proc";
|
|
$level = 1;
|
|
$FormattedText .= "\n" if $blank_after_proc;
|
|
}
|
|
else
|
|
{
|
|
$FormattedText .= "\n" if $blank_after_endproc;
|
|
}
|
|
$skip_blanks = 1;
|
|
$blank_lines = 0;
|
|
$unended_operator = 0;
|
|
return 1;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub check_end_proc
|
|
{
|
|
if( $trimmed_line =~ m/^($pat_endproc)([^\/\s]*)((?:\s*$pat_comment)*)$/i )
|
|
{
|
|
$FormattedText .= "\n" if $blank_before_endproc;
|
|
|
|
perror(" Ñèíòàêñè÷åñêèå îøèáêè â ïðîöåäóðå '$proc_name'") if $level != 1;
|
|
$level = 0;
|
|
my ($endproc, $text_after, $comment) = ($1, $2, $3);
|
|
|
|
if( $procname_after_endproc >= 0 )
|
|
{
|
|
my $proc_lines = $line_number - $proc_start + 1;
|
|
my $need_comment = $proc_lines >= $procname_after_endproc;
|
|
if( !$need_comment and !$text_after and ($comment =~ m/^\s*\/\/\s*($proc_name)?\s*\(?\s*\)?\s*$/i) )
|
|
{
|
|
print_line(ucfirst($endproc));
|
|
}
|
|
elsif( $need_comment and !$text_after and ($comment =~ m/^\s*$/) )
|
|
{
|
|
print_line(ucfirst($endproc), " //$proc_name()");
|
|
}
|
|
else
|
|
{
|
|
print_line(ucfirst($endproc), format_expr($text_after), $comment);
|
|
}
|
|
}
|
|
else
|
|
{
|
|
print_line(ucfirst($endproc), format_expr($text_after), $comment);
|
|
}
|
|
|
|
$state = pop @states;
|
|
$proc_name = "";
|
|
$proc_start = 0;
|
|
$FormattedText .= "\n" if $blank_after_endproc;
|
|
$skip_blanks = 1;
|
|
$blank_lines = 0;
|
|
return 1;
|
|
$unended_operator = 0;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub check_if
|
|
{
|
|
if( $trimmed_line =~ m/^(Åñëè|If)([(\s].*[)\s])(Òîãäà|Then)(\s.*)(ÊîíåöÅñëè|EndIf)(;*.*?)(\s*$pat_comment)*$/i ) #âåñü if â îäíó ñòðî÷êó
|
|
{
|
|
$FormattedText .= "\n" if $blank_lines;
|
|
print_line(ucfirst($1), format_expr($2), ucfirst($3), format_expr($4), ucfirst($5), format_expr($6), $7);
|
|
}
|
|
elsif( $trimmed_line =~ m/^(Åñëè|If)([(\s].*[)\s])(Òîãäà|Then)(\s*[\s;].*?){0,1}(\s*$pat_comment)*$/i )
|
|
{
|
|
$FormattedText .= "\n" if $blank_lines;
|
|
print_line(ucfirst($1), format_expr($2), ucfirst($3), format_expr($4), $5);
|
|
push @states, $state;
|
|
$state = "if";
|
|
$level++;
|
|
$skip_blanks = 1;
|
|
$blank_lines = 0;
|
|
$FormattedText .= "\n" if $blank_after_if;
|
|
}
|
|
elsif( $trimmed_line =~ m/^(Åñëè|If)([(\s].*)$/i ) #then íà äðóãîé ñòðîêå
|
|
{
|
|
$FormattedText .= "\n" if $blank_lines;
|
|
print_line(ucfirst($1), format_expr($2));
|
|
push @states, $state;
|
|
push @states, "if";
|
|
$state = "if_multiline";
|
|
$skip_blanks = 1;
|
|
$blank_lines = 0;
|
|
}
|
|
else
|
|
{
|
|
return 0;
|
|
}
|
|
|
|
$unended_operator = 0;
|
|
return 1;
|
|
}
|
|
|
|
sub check_multiline_if
|
|
{
|
|
if( $trimmed_line =~ m/^$pat_comment$/i )
|
|
{
|
|
$FormattedText .= offset($level + 1) . " " . $trimmed_line . "\n";
|
|
}
|
|
elsif( $trimmed_line =~ m/^(.*[)\s])(Òîãäà|Then)(\s*$pat_comment)*$/i )
|
|
{
|
|
$state = pop @states;
|
|
$FormattedText .= offset($level + 1) . " " . format_expr($1) . "\n" if $1;
|
|
$FormattedText .= offset($level) . ucfirst($2) . "\n" if $2;
|
|
$level++;
|
|
}
|
|
elsif( $trimmed_line =~ m/^(Òîãäà|Then)(\s*$pat_comment)*$/i )
|
|
{
|
|
$state = pop @states;
|
|
$FormattedText .= offset($level) . ucfirst($1) . $2 . "\n";
|
|
$level++;
|
|
}
|
|
else
|
|
{
|
|
$FormattedText .= offset($level + 1) . " " . format_expr($trimmed_line) . "\n";
|
|
}
|
|
$skip_blanks = 1;
|
|
}
|
|
|
|
sub check_elsif
|
|
{
|
|
if( $trimmed_line =~ m/^(针֌|Else)(\s.*?){0,1}(\s*$pat_comment)*$/i )
|
|
{
|
|
$level--;
|
|
$FormattedText .= "\n" if $blank_before_elseif;
|
|
print_line(ucfirst($1), format_expr($2), $3);
|
|
}
|
|
elsif( $trimmed_line =~ m/^(Èíà÷åÅñëè|ElsIf)([(\s].*[)\s])(Òîãäà|Then)(\s.*?){0,1}(\s*$pat_comment)*$/i )
|
|
{
|
|
$level--;
|
|
$FormattedText .= "\n" if $blank_before_elseif;
|
|
print_line(ucfirst($1), format_expr($2), ucfirst($3), format_expr($4), ucfirst($5), $6, $7);
|
|
}
|
|
elsif( $trimmed_line =~ m/^(Èíà÷åÅñëè|ElsIf)([(\s].*)$/i ) #then íà äðóãîé ñòðîêå
|
|
{
|
|
$level--;
|
|
$FormattedText .= "\n" if $blank_before_elseif;
|
|
print_line(ucfirst($1), format_expr($2));
|
|
|
|
push @states, $state;
|
|
$level--;
|
|
$state = "if_multiline";
|
|
}
|
|
else
|
|
{
|
|
return 0;
|
|
}
|
|
|
|
$level++;
|
|
$skip_blanks = 1;
|
|
$blank_lines = 0;
|
|
|
|
return 1;
|
|
}
|
|
|
|
|
|
sub check_endif
|
|
{
|
|
if( $trimmed_line =~ m/^(ÊîíåöÅñëè|EndIf)(;*.*?)($pat_comment)*$/i )
|
|
{
|
|
$level--;
|
|
$FormattedText .= "\n" if $blank_before_endif;
|
|
print_line(ucfirst($1), format_expr($2), $3);
|
|
$state = pop @states;
|
|
$skip_blanks = 0;
|
|
$blank_lines = 0;
|
|
return 1;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub check_cycle
|
|
{
|
|
if( $trimmed_line =~ m/^(Äëÿ|For)(\s.*\s)(Ïî|To)(\s.*\s)(Öèêë|Do)(\s*$pat_comment)*$/i )
|
|
{
|
|
$FormattedText .= "\n" if $blank_lines;
|
|
print_line(ucfirst($1), format_expr($2), ucfirst($3), format_expr($4), ucfirst($5), $6);
|
|
}
|
|
elsif( $trimmed_line =~ m/^(Ïîêà|While)([\s("']*.*?[\s)"'])(Öèêë|Do)(\s*$pat_comment)*$/i )
|
|
{
|
|
$FormattedText .= "\n" if $blank_lines;
|
|
print_line(ucfirst($1), format_expr($2), ucfirst($3), $4);
|
|
}
|
|
else
|
|
{
|
|
return 0;
|
|
}
|
|
|
|
$level++;
|
|
push @states, $state;
|
|
$state = "cycle";
|
|
$skip_blanks = 1;
|
|
$blank_lines = 0;
|
|
$FormattedText .= "\n" if $blank_after_while;
|
|
return 1;
|
|
}
|
|
|
|
sub check_endcycle
|
|
{
|
|
if( $trimmed_line =~ m/^(ÊîíåöÖèêëà|EndDo)(;*.*?)(\s*$pat_comment)*$/i )
|
|
{
|
|
$state = pop @states;
|
|
$level--;
|
|
$FormattedText .= "\n" if $blank_before_wend;
|
|
print_line(ucfirst($1), format_expr($2), $3);
|
|
$blank_lines = 0;
|
|
return 1;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
|
|
sub check_try
|
|
{
|
|
if( $trimmed_line =~ m/^(Ïîïûòêà|Try)(\s*$pat_comment)*$/i )
|
|
{
|
|
$FormattedText .= "\n" if $blank_lines;
|
|
print_line(ucfirst($1), $2);
|
|
$level++;
|
|
push @states, $state;
|
|
$state = "try";
|
|
$skip_blanks = 1;
|
|
$blank_lines = 0;
|
|
return 1;
|
|
}
|
|
elsif( $trimmed_line =~ m/^(Èñêëþ÷åíèå|Except)(\s*$pat_comment)*$/i )
|
|
{
|
|
$level--;
|
|
print_line(ucfirst($1), $2);
|
|
$level++;
|
|
$skip_blanks = 1;
|
|
$blank_lines = 0;
|
|
return 1;
|
|
}
|
|
elsif( $trimmed_line =~ m/^(ÊîíåöÏîïûòêè|EndTry)(;*.*?)(\s*$pat_comment)*$/i )
|
|
{
|
|
$state = pop @states;
|
|
$level--;
|
|
print_line(ucfirst($1), format_expr($2), $3);
|
|
$blank_lines = 0;
|
|
$skip_blanks = 0;
|
|
return 1;
|
|
}
|
|
elsif( $trimmed_line =~ m/^(Èñêëþ÷åíèå|Except)\s+(ÊîíåöÏîïûòêè|EndTry)(;*.*?)(\s*$pat_comment)*$/i )
|
|
{
|
|
$state = pop @states;
|
|
$level--;
|
|
print_line(ucfirst($1), " ", ucfirst($2), format_expr($3), $4);
|
|
$blank_lines = 0;
|
|
$skip_blanks = 0;
|
|
return 1;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
##################################################################
|
|
sub offset
|
|
{
|
|
my $i = shift;
|
|
my $offset = "";
|
|
$offset .= "\t" while $i-- > 0;
|
|
return $offset;
|
|
}
|
|
|
|
sub print_line
|
|
{
|
|
$FormattedText .= offset($level);
|
|
foreach (@_)
|
|
{
|
|
$FormattedText .= $_;
|
|
}
|
|
$FormattedText .= "\n";
|
|
}
|
|
|
|
sub wintodos {
|
|
my $win_chars = "\xA8\xB8\xB9\xC0\xC1\xC2\xC3\xC4\xC5\xC6\xC7\xC8\xC9\xCA\xCB\xCC\xCD\xCE\xCF\xD0\xD1\xD2\xD3\xD4\xD5\xD6\xD7\xD8\xD9\xDA\xDB\xDC\xDD\xDE\xDF\xE0\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA\xEB\xEC\xED\xEE\xEF\xF0\xF1\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA\xFB\xFC\xFD\xFE\xFF";
|
|
my $dos_chars = "\xF0\xF1\xFC\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8A\x8B\x8C\x8D\x8E\x8F\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9A\x9B\x9C\x9D\x9E\x9F\xA0\xA1\xA2\xA3\xA4\xA5\xA6\xA7\xA8\xA9\xAA\xAB\xAC\xAD\xAE\xAF\xE0\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA\xEB\xEC\xED\xEE\xEF";
|
|
$_ = shift;
|
|
return $_ if $^O eq "cygwin";
|
|
eval("tr/$win_chars/$dos_chars/");
|
|
return $_;
|
|
}
|