! sqrsh (sqr shell)
! Copyright (C) 1997 Ray Ontko & Company
!
! 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; either version 2 of the License, or
! (at your option) any later version.
!
! 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
!
!++
!
! pretty
!
! pretty iname oname
!
! beautifies an sqr program or include file.
!
! pretty makes the following formatting changes to your program 
! 
!   o  inserts a divider comment before each begin-procedure,
!      begin-setup, begin-program, begin-report, begin-heading,
!      and begin-footing.
!   o  tags each end-procedure with the name of the procedure
!
! At some point in the future, this should also handle indentation
! for nested IF, WHILE, EVALUATE, etc.  But for now, we just do
! the simple edits described above.
!
!--
!

begin-procedure pretty local
  move 'pretty.tmp' to $tname
  move 'pretty.bak' to $bname
  if isnull( $_p1 )
     input $iname 'Input file'
  else
     move $_p1 to $iname
  end-if

  if isnull( $_p2 )
     input $oname 'Output file'
  else
     move $_p2 to $oname
  end-if

  do pretty_file( $iname , $tname )
  do fixup_files( $tname, $oname, $bname )
end-procedure pretty

begin-procedure pretty_file( $infile , $outfile )
! inserts a comment line for each procedure just above the begin-procedure
! may also handle if/evaluate/while indentation, etc.
!
open $infile as 1 for-reading record={SQRSH_LINE_MAX}:vary
open $outfile as 2 for-writing record={SQRSH_LINE_MAX}:vary
read 1 into $line:{SQRSH_LINE_MAX}
while not #_end-file
   unstring $line by ' ' into $p0 $p1
   lowercase $p0
   evaluate $p0
   when = 'begin-report'
   when = 'begin-program'
   when = 'begin-setup'
   when = 'begin-heading'
   when = 'begin-footing'
      let $s = '!!' || 
               lpad ( ' ' , 72 - length( $p0  ) , '-' ) ||
               $p0
      write 2 from $s
      write 2 from $line
      break
   when = 'begin-procedure'
      unstring $p1 by '(' into $proc_name
      let $s = '!!' || 
               lpad ( ' ' , 72 - length( $proc_name ) , '-' ) ||
               $proc_name
      write 2 from $s
      write 2 from $line
      break
   when = 'end-procedure'
      write 2 from 'end-procedure !! ' $proc_name
      break
   when-other
      if substr($line,1,10) = '!!---------' 
         ! do nothing
      else
         write 2 from $line
      end-if
   end-evaluate
   read 1 into $line:{SQRSH_LINE_MAX}
end-while
close 2
close 1
end-procedure