#! /usr/bin/perl
# -*- perl -*-
# util/cimindent.  Generated from cimindent.in by configure.

eval 'exec /usr/bin/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];
    }
}
	



