#! @PERL@ # -*- perl -*- # @configure_input@ eval 'exec @PERL@ -S $0 ${1+"$@"}' if 0; # Copyright (C) 1996 Sverre Hvammen Johansen # Department of Informatics, University of Oslo. # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; version 2. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. $indent_level=3; $indent=0; $case="prog"; while (<>) { $nl=chop($_); if ($nl ne "\n") { $_= $_ . $nl;} if (/^(%|#)/) { push(@type,"directive"); push(symb,"$_"); } else { push(@type,"indent"); push(@symb,0); s/^( |\t)*(.*)/$2/; s/^(.*)( |\t)$/$1/; while(/([a-z]\w*|2r[01][01_]*|4r[0-3][0-3_]*|8r[0-7][0-7_]*|16r[\da-f][\da-f_]*|((\d[\d_]*)?\.\d[\d_]*|\d[\d_])?&&?(\+|-)?\d[\d_]*|(\d[\d_]*)?\.\d[\d_]*|\d[\d_]*|\/\/|\*\*|&&|:=|:-|<=|>=|<>|==|=\/=|.)/ogi) { push(@words, $1); } while(@words) { $word=shift(@words); if ($case eq "prog") { if ($word eq "!") { $symb="!"; $case="comment"; } elsif ($word eq "\"") { $symb="\""; $case="text"; } elsif ($word eq "'") { $symb="\'"; $case="char"; } elsif ($word=~/^(activate|after|and|array|at|before|begin|boolean|character|class|delay|do|else|eq|eqv|external|false|for|ge|go|goto|gt|hidden|if|imp|in|inner|inspect|integer|is|label|le|long|lt|name|ne|new|none|not|notext|or|otherwise|prior|procedure|protected|qua|reactivate|real|ref|short|step|switch|text|then|this|to|true|until|value|virtual|when|while)$/oi) { push(type,"prog"); push(@symb,"$word"); } elsif ($word=~/^comment$/i) { $symb="comment"; $case="comment"; } elsif ($word=~/^end$/i) { push(@type,"prog"); push(@symb,"$word"); $symb=""; $case="endcomment"; } elsif ($word=~/^[a-z0-9]/i) { push(@type,"prog"); push(@symb,"$word"); } elsif ($word=~/\S/i) { if ($word eq ";") {$par=0;} elsif ($word eq "(") {$par=$par+1;} elsif ($word eq ")") {$par=$par-1;} if ($word eq ":-" && $par==1) { push(@type,"prog"); push(@symb,":"); push(@type,"prog"); push(@symb,"-"); } else { push(@type,"prog"); push(@symb,"$word"); } } else { push(@type,"comment"); push(@symb,"$word"); } } elsif ($case eq "char") { $symb.=$word; if ($word eq "'") { push(@type,"prog"); push(@symb,"$symb"); $case="prog"; } } elsif ($case eq "text") { $symb.=$word; if ($word eq "\"") { push(@type,"prog"); push(@symb,"$symb"); $case="prog"; } } elsif ($case eq "comment") { if ($word eq ";") { $symb.=$word; push(@type,"comment"); push(@symb,"$symb"); $case="prog"; } else { $symb.=$word; } } elsif ($case eq "endcomment") { if ($word eq ";") { $par=0; push(@type,"comment"); push(@symb,"$symb"); push(@type,"prog"); push(@symb,"$word"); $case="prog"; } elsif ($word=~/^end$/i) { push(@type,"comment"); push(@symb,"$symb"); push(@type,"prog"); push(@symb,"$word"); $symb=""; } elsif ($word=~/^(else|when|otherwise)$/i) { push(@type,"comment"); push(@symb,"$symb"); push(@type,"prog"); push(@symb,"$word"); $case="prog"; } else { push(@type,"comment"); push(@symb,"$word"); } } } } if ($case eq "char" || $case eq "text") { $case="prog"; } if ($case eq "comment" || $case eq "endcomment") { push(@type,"comment"); push(@symb,"$symb"); $symb=""; } push(@type,"comment"); push(@symb,"\n"); } $n=$#symb; @indent_type=(); $spec_level=0; $last_begin_semi_is_symb=";"; $last_prog_symb=";"; for($i=0;$i<=$n;$i++) { if($type[$i] eq "prog") { if($symb[$i]=~/^begin$/i) { if($#indent_type<0 || $indent_type[$#indent_type] eq "begin") { $indent++; } push(@indent_type,"begin"); } elsif($symb[$i]=~/^(if|inspect|while|for)$/i) { $indent++; push(@indent_type,"$symb[$i]"); } elsif($symb[$i]=~/^end$/i) { while($#indent_type>=0 && pop(@indent_type) ne "begin") { $indent--; } if($#indent_type>=0 && $indent_type[$#indent_type] eq "begin") { $indent--; } } elsif($symb[$i]=~/^else$/i) { while($#indent_type>=0 && $indent_type[$#indent_type] ne "begin" && $indent_type[$#indent_type] ne "if") { pop(@indent_type); $indent--; } if($#indent_type>=0 && $indent_type[$#indent_type] eq "if") { $indent_type[$#indent_type]="else"; } else { print STDERR "Unmatched else"; } } elsif($symb[$i]=~/^(when|otherwise)$/i) { while($#indent_type>=0 && $indent_type[$#indent_type] ne "begin" && $indent_type[$#indent_type] ne "inspect" && $indent_type[$#indent_type] ne "when") { pop(@indent_type); $indent--; } if($#indent_type>=0 && $indent_type[$#indent_type] ne "begin") { $indent_type[$#indent_type]=$symb[$i]; } else { print STDERR "Unmatched $symb[$i]"; } } elsif($symb[$i] eq ";") { while($#indent_type>=0 && $indent_type[$#indent_type] ne "begin") { pop(@indent_type); $indent--; } } elsif($symb[$i] eq ":" && $par==0) { if($#indent_type>=0 && $indent_type[$#indent_type] eq "sent") { pop(@indent_type); $indent--; } } else { if($indent_type[$#indent_type] eq "begin") { $indent++; push(@indent_type,"sent"); } } } elsif($type[$i] eq "indent") { $symb[$i]=$indent+$spec_level; $next_prog_symb=""; for($j=$i+1;$j<=$n && $type[$j] ne "prog";$j++) {} if($j<=$n) { $next_prog_symb=$symb[$j];} if($next_prog_symb=~/^(begin|else|when|otherwise)$/i && $indent_type[$#indent_type] ne "begin") { $symb[$i]--; } if($par==0) { for($j=$i+1;$j<=$n && $type[$j] eq "comment" ;$j++) {} if($j<=$n && $type[$j] eq "prog" && $symb[$j]=~/^[a-z]/i) { for($j++;$j<=$n && $type[$j] eq "comment" ;$j++) {} if($j<=$n && $type[$j] eq "prog" && $symb[$j] eq ":") { $symb[$i]--; } } } if($i<$n && $type[$i+1] eq "prog" && $symb[$i+1]=~/^end$/i) { $symb[$i]--; } if($spec_level>0 && $next_prog_symb=~/^begin$/i) { $symb[$i]--; } } if($type[$i] eq "prog") { if($symb[$i] eq "(") {$par++;} elsif($symb[$i] eq ")") {$par--;} elsif($symb[$i] eq ";") {$par=0;} if($symb[$i]=~/^(begin|;|is)$/i){$last_begin_semi_is_symb=$symb[$i];} if($symb[$i]=~/^procedure$/i && $last_begin_semi_is_symb ne "is" || $symb[$i]=~/^class$/i) { $spec_level++; } if($spec_level>0 && $last_prog_symb eq ";") { if($symb[$i]=~/^(integer|real|ref|text|value|name|boolean|procedure|virtual)$/i) { } else { $spec_level--; } } $last_prog_symb=$symb[$i]; if($par==0 && $symb[$i] eq ":") {$last_prog_symb=";";} } } for($i=0;$i<=$n;$i++) { if($type[$i] eq "indent") { for($j=$symb[$i]*$indent_level;$j>0;$j--) {print " ";} } else { print $symb[$i]; } }