/**********************************************************************/
/*  Formats comments in REXX program files                            */
/**********************************************************************/
/*                                                                    */
/*  This program formats comments in REXX program files according to  */
/*  a user-defined option and reports any uncommented program lines.  */
/*                                                                    */
/*                                                                    */
/*  2000-07-16 : Bugfix: nested multi-line comments.                  */
/*  2000-07-02 : Removed conversion of TABs to SPACEs.                */
/*               (Trailing whitespace is still removed.)              */
/*               Removed L(eading) option: too cumbersome.            */
/*               T(railing) option renamed to N(ext line)             */
/*  2000-07-01 : The S(trip) option now removes leading whitespace.   */
/*  2000-06-30 : Bugfix: a comment start may now appear in the code.  */
/*               Single-character option switches.                    */
/*  2000-06-29 : Bugfix: a lone comment end now passes without error  */
/*  1999-11-10 : Added Leading and Trailing options.                  */
/*  1999-08-25 : Bugfix: multi-line comments.                         */
/*  1999-07-21 : Cosmetic changes.                                    */
/*  1999-07-07 : Initial program release.                             */
/*                                                                    */
/**********************************************************************/
/*                                                                    */
/* The latest version of this program can be found at                 */
/*               www.degeus.com/rexxcomm                              */
/*                                                                    */
/**********************************************************************/
/*                                                                    */
/* This program is released under the terms of the GNU license, see   */
/*               www.gnu.org/copyleft/gpl.html                        */
/*                                                                    */
/**********************************************************************/
/*                                                                    */
/* (c) 1999-2001 Marcus C. de Geus                                    */
/*               marcus@degeus.com                                    */
/*               www.degeus.com                                       */
/*                                                                    */
/**********************************************************************/
/*                                                                    */
/* Use it if you like it. Don't if you don't. No legalese.            */
/*                                                                    */
/**********************************************************************/

signal on halt  /* handles halt condition */

ResultCode = 1  /* error */

parse arg Action Filespec  /* get the action and file spec */

if (Action >< '') then  /* if we have an Action */
do
 Action = translate(Action)  /* convert to upper case */
 GotAction = (pos(Action,'AUNS') > 0)  /* if it is a valid action, we're O.K. */
end
else  /* if we have no action */
do
 GotAction = 0  /* we're not O.K. */
end

if ((\GotAction) | (Filespec = '')) then  /* if we have no valid action, or no file spec */
do
 parse source . . ProgSpec  /* get ProgSpec */
 say 'Usage = RexxComm option filespec'  /* put out a message */
 say ' Option should be one of the following:'  /* another message line */
 say '  A : trailing comments are vertically Aligned'  /* another message line */
 say '      to match the longest line of code'  /* another message line */
 say '  U : trailing comments are Unaligned'  /* another message line */
 say '      to follow each line of code'  /* another message line */
 say '  N : trailing comments are moved to the Next line'  /* another message line */
 say '      (original file is saved in [filename].ORG)'  /* another message line */
 say '  S : all comments are Stripped from the file'  /* another message line */
 say '      (original file is saved in [filename].ORG)'  /* another message line */
 call Halt  /* and quit */
end

if (\LoadRexxUtils()) then  /* if we cannot load the REXX utilities */
do
 call Halt  /* quit */
end

Filespec = strip(Filespec,'B','"')  /* get rid of any quotes */
Filespec = strip(Filespec,'B',' ')  /* get rid of any spaces */

call sysfiletree Filespec,'Files.','FO'  /* look for the file spec */

if (Files.0 = 0) then  /* if no files were found */
do
 say 'No files found.'  /* report */
 call Halt  /* and quit */
end

Action = substr(Action,1,1)  /* get the first character of Action */

ResultCode = 0  /* all is still well */

do Index = 1 to Files.0  /* take each file */
 ResultCode = bitor(ResultCode,Process(Files.Index,Action))  /* process it, and set the result code if an error occurs */
end

call Halt  /* That's all, folks! */

/**********************************************************************/
Process: procedure  /* processes a file */
/**********************************************************************/

parse arg InFile,Action  /* get the arguments */

if (stream(InFile,'C','OPEN READ') >< 'READY:') then  /* if we cannot open the file for reading */
do
 say 'Cannot open '||InFile  /* report */
 return 1  /* and return */
end

CommStart = d2c(47)||d2c(42)  /* these characters (slash plus asterisk) indicating the start of a REXX comment */
CommEnd = d2c(42)||d2c(47)  /* these characters (asterisk plus slash) indicating the end of a REXX comment */
CRLF = d2c(13)||d2c(10)  /* define CRLF */
Buffer.1 = linein(InFile)  /* read the first line of the file into Buffer.1 */

if (substr(Buffer.1,1,2) >< CommStart) then  /* if it is not a REXX comment, this is not a REXX program file */
do
 call stream InFile,'C','CLOSE'  /* close the file */
 say InFile||' is not a REXX program file'  /* report */
 return 1  /* and return */
end

say InFile  /* put out the name of the file we're processing */

NonComm. = ''  /* start with no uncommented lines */
NonCommNumber = 0  /* the number of uncommented lines; start at 0 */
LineCount = 1  /* we've already collected the first line, remember? */
MaxLength = 0  /* this will eventually contain the longest program line length (without the comment); start at 0 */

do while (lines(InFile))  /* as long as we have lines left in the file */
 LineCount = LineCount + 1  /* up the line counter */
 Buffer.LineCount = linein(InFile)  /* read the next line into Buffer */
end

Buffer.0 = LineCount  /* store the total line count in Buffer.0 */
call stream InFile,'C','CLOSE'  /* close the file */

CommBlock = 0  /* we're not in a multi-line comment block yet */

do LineCount = 1 to Buffer.0  /* run through the number of lines we collected in Buffer */

 if (CommBlock = 0) then  /* if the line is not part of a multi-line comment block */
 do

  CommentPos = pos(CommStart,Buffer.LineCount)  /* look for the start of a comment */

  if (CommentPos > 0) then  /* if we think we found a comment */
  do

   if (CommentPos > 1) then  /* if we have a trailing comment */
   do

    if (pos(substr(Buffer.LineCount,CommentPos-1,1),' '||d2c(09)) > 0) then  /* if we found a real trailing comment, i.e. it is preceded by a space or a TAB char */
    do
     CodeBit.LineCount = substr(Buffer.LineCount,1,CommentPos-1)  /* the bit before the slash-asterisk part is the code */
     Comment.LineCount = substr(Buffer.LineCount,CommentPos)  /* the rest is comment */
    end
    else  /* if it is not preceded by a space or TAB, it must be part of the code, so */
    do
     CodeBit.LineCount = Buffer.LineCount  /* assume the whole lot is code */
     Comment.LineCount = ''  /* and just assume there is no comment part !!!! THIS BIT NEES TO BE FIXED: GO ON LOOKING FOR A COMMENT !!!! */
    end

   end

   else  /* if we found a comment at the start of the line */

   do
    CodeBit.LineCount = ''  /* there is no program line part */
    Comment.LineCount = Buffer.LineCount  /* it is all comment */
   end

   if (pos(CommEnd,Buffer.LineCount) = 0) then  /* if no comment end is found, this is the start of a multi-line comment block */
   do
    CommBlock = CommBlock + 1  /* up the CommBlock counter */
   end

  end

  else  /* if no comment start was found in this line */

  do
   CodeBit.LineCount = Buffer.LineCount  /* the entire line must be code */
   Comment.LineCount = ''  /* there is no comment part for this one */
   BufLine = strip(Buffer.LineCount,'B',' ')  /* copy the contents of Buffer.LineCount into BufLine, removing leading and trailing blanks */

   if (BufLine >< '') then  /* if the line is not empty */
   do

    if (wordpos(BufLine,CommEnd||' do end') = 0) then  /* if the line is not the end of a comment block, and contains not just "do" or "end" */
    do
     NonCommNumber = NonCommNumber + 1  /* up NonCommNumber to show we've got another line that needs a comment */
     NonComm.NonCommNumber = LineCount  /* store the line number for later use */
    end

   end

  end

 end

 else  /* if the line is part of a multi-line comment block */

 do

  if (CommentPos > 1) then  /* if this is a trailing comment block */
  do
   CodeBit.LineCount = '_'  /* we need a symbolic program line part to create an indent later */
  end
  else  /* if this is not a trailing comment block */
  do
   CodeBit.LineCount = ''  /* there is no program line part */
  end

  Comment.LineCount = '   '||subword(Buffer.LineCount,1)  /* use real text as the comment, preceded by three blank spaces */

  if (pos(CommStart,Buffer.LineCount) > 0) then  /* if a comment start is found */
  do
   CommBlock = CommBlock + 1  /* up the counter */
  end

  if (pos(CommEnd,Buffer.LineCount) > 0) then  /* if a comment end is found */
  do
   CommBlock = CommBlock - 1  /* lower the counter */
  end

 end

 if (CodeBit.LineCount >< '') then  /* if we have a program code bit */
 do while (pos(substr(CodeBit.LineCount,length(CodeBit.LineCount),1),d2c(9)||d2c(32)) > 0)  /* as long as the last character of the program bit is a tab or space */
  CodeBit.LineCount = strip(CodeBit.LineCount,'T',d2c(9))  /* strip off any tab characters */
  CodeBit.LineCount = strip(CodeBit.LineCount,'T',d2c(32))  /* strip off any space characters */
 end

 if (Comment.LineCount >< '') then  /* if we have a comment bit */
 do while (pos(substr(Comment.LineCount,length(Comment.LineCount),1),d2c(9)||d2c(32)) > 0)  /* as long as the last character of the program bit is a tab or space */
  Comment.LineCount = strip(Comment.LineCount,'T',d2c(9))  /* strip off any tab characters */
  Comment.LineCount = strip(Comment.LineCount,'T',d2c(32))  /* strip off any space characters */
 end
    
 if (CommentPos >< 1) then  /* if this is not a lone comment */
 do

  LineLength.LineCount = length(CodeBit.LineCount)  /* store the length of the program line bit in LineLength */

  if (LineLength.LineCount > MaxLength) then  /* if the program part of the line is longer than the previous longest one */
  do
   MaxLength = LineLength.LineCount  /* adjust MaxLength to reflect the current longest line */
  end

 end

 drop Buffer.LineCount  /* we don't need this anymore */

end

if (Action = 'S') then  /* if we're stripping */
do
 CodeBit.1 = CommStart||' '||filespec('N',InFile)||' - stripped by RexxComm '||date('S')||' '||CommEnd  /* add a simple comment line at the top of the file */
end

drop OutLine.  /* clear the outline compound variable */

do LineCount = 1 to Buffer.0  /* take each of the lines stored in Buffer */

 PrevLine = LineCount -1  /* the number of the previous line */

 if (Action = 'S') then  /* if the Action was "S(trip)" */

 do

  if (CodeBit.LineCount = '_') then  /* if we have just an underscore, we're in a trailing multi-line comment block */
  do
   OutLine.LineCount = ''  /* we have no code */
  end
  else  /* if we're not in a multi-line comment block */
  do
   OutLine.LineCount = CodeBit.LineCount  /* use just the code bit */
  end

  if (OutLine.LineCount >< '') then  /* if we have something */
  do while (pos(substr(OutLine.LineCount,1,1),d2c(9)||d2c(32)) > 0)  /* as long as the first character is a tab or space */
   OutLine.LineCount = strip(OutLine.LineCount,'B',d2c(9))  /* strip off any tab characters */
   OutLine.LineCount = strip(OutLine.LineCount,'B',d2c(32))  /* strip off any space characters */
  end

 end

 else  /* if the action was not "S(trip)" */

 do

  if (Comment.LineCount >< '') then  /* if there is a comment */
  do

   if (CodeBit.LineCount >< '') then  /* if there is a program line bit */
   do

    select  /* time to choose */

     when (Action = 'A') then  /* if the Action was "A(lign)" */
     do

      if (CodeBit.LineCount = '_') then  /* if the code bit is just an underscore, we're in a trailing multi-line comment block */
      do
       CodeBit.LineCount = copies(' ',length(CodeBit.PrevLine))  /* create an indent as long as the code bit of the previous line */
      end

      OutLine.LineCount = left(CodeBit.LineCount,MaxLength,' ')||'  '||Comment.LineCount  /* pad the program line bit with trailing spaces to equal the longest program line in length and stick 2 spaces and the comment onto the end */

     end

     when (Action = 'U') then  /* if the Action was "U(nalign)" */
     do

      if (CodeBit.LineCount = '_') then  /* if the code bit is just an underscore, we're in a trailing multi-line comment block */
      do
       CodeBit.LineCount = copies(' ',length(CodeBit.PrevLine))  /* create an indent as long as the code bit of the previous line */
      end

      OutLine.LineCount = CodeBit.LineCount||'  '||Comment.LineCount  /* stick two spaces on the end of the program line, followed by the comment line bit */

     end

     when (Action = 'N') then  /* if the Action was "N(ext line)" */
     do

      if (CodeBit.LineCount >< '') then  /* if we have code */
      do

       if (CodeBit.LineCount = '_') then  /* if the code bit is just an underscore, we're in a trailing multi-line comment block */
       do
        CodeBit.LineCount = ''  /* no code */
       end
       else  /* if the code is real */
       do
        CodeBit.LineCount = CodeBit.LineCount||CRLF  /* add a CRLF */
       end

       OutLine.LineCount = CodeBit.LineCount||Comment.LineCount  /* program code is followed by the comment */

      end

      else  /* if we have no code */

      do
       OutLine.LineCount = Comment.LineCount  /* use the comment */
      end

     end

    end

   end

   else  /* if there is no program line bit */

   do
    OutLine.LineCount = Comment.LineCount  /* use just the comment line bit */
   end

  end

  else  /* if there is no comment */

  do
   OutLine.LineCount = CodeBit.LineCount  /* use the code bit, if any */
  end

 end

 drop CodeBit.PrevLine  /* drop the previous code bit */
 drop Comment.Linecount  /* drop the comment bit */

end

Location = filespec('D',InFile)||filespec('P',InFile)  /* the current directory */
TempFile = systempfilename(Location||'RC_?????.TMP')  /* get a unique filename to act as safety storage while we delete and rewrite the source file */

if (stream(TempFile,'C','OPEN WRITE') >< 'READY:') then  /* if we cannot open the output file */
do
 say 'Cannot open target file for writing'  /* report */
 return 1  /* and return */
end

do LineCount = 1 to Buffer.0  /* get each of the lines in Buffer */

 if (\((OutLine.LineCount = '') & (pos(Action,'S') > 0))) then  /* unless the line contains no text and the Strip action has been set */
 do
  call lineout TempFile,OutLine.LineCount  /* write it to the output file */
 end

end

call stream TempFile,'C','CLOSE'  /* close the output file */

call syssleep 1  /* wait a bit */

if (sysqueryealist(InFile,'EAList.') >< 0) then  /* if we cannot retrieve the EA list of the source file */
do
 say 'Cannot retrieve source file EA name list'  /* report */
 return 1  /* and return */
end

GetIt = 0  /* start at 0 */

do EANo = 1 to EAList.0  /* for each of the EA names in the list */
 GetIt = GetIt + sysgetea(InFile,EAList.EANo,HoldEA.EANo)  /* get it from the source file */
end

if (GetIt > 0) then  /* if the total result exceeds 0 */
do
 say 'Error getting EAs from '||InFile  /* report */
 return 1  /* and go back */
end

PutIt = 0  /* start at 0 */

do EANo = 1 to EAList.0  /* take each of the EA entries */
 PutIt = PutIt + sysputea(TempFile,EAList.EANo,HoldEA.EANo)  /* and attach it to the temp file */
end

if (PutIt > 0) then  /* if the total result exceeds 0 */
do
 say 'Error writing EAs to '||TempFile  /* report */
 return 1  /* and go back */
end

Title = filespec('N',InFile)  /* the name to use for the new file */

call syssleep 1  /* wait a bit */

if (pos(Action,'SN') > 0) then  /* if the comments were stripped or shifted to the next line */
do

 if (\syssetobjectdata(InFile,'Title='||Title||'.ORG')) then  /* if we cannot rename the file */
 do
  say 'Cannot rename original file; results stored in : '||TempFile  /* report */
  return 1  /* and return with an error */
 end

 say 'Original file stored as : '||InFile||'.ORG'  /* report */

end

else  /* if the comments were not stripped */

do

 if (\sysdestroyobject(InFile)) then  /* if we cannot get rid of the original file */
 do
  say 'Cannot delete source file'  /* report */
  return 1  /* and return */
 end

end

if (\syssetobjectdata(TempFile,'Title='||Title)) then  /* if we cannot rename the target file */
do
 say 'Cannot rename target file; results stored in : '||TempFile  /* report */
 return 1  /* and return with an error */
end

Errors = (NonCommNumber > 0)  /* all is well only if we have no uncommented lines */

if (\Errors) then  /* if there are no uncommented program lines */
do
 say ' O.K.'  /* report */
end

else  /* if uncommented lines were found */

do

 say ' Uncommented lines:'  /* report */

 do Number = 1 to NonCommNumber  /* take each of the entries */
  say '  '||right(NonComm.Number,length(NonComm.NonCommNumber),' ')  /* the NCLine number, padded to match the largest number , and preceded by two spaces */
 end

end

return Errors  /* end of Process */

/**********************************************************************/
LoadRexxUtils: procedure  /* loads REXX utility functions if necessary */
/**********************************************************************/

Success = 1  /* all is well to start with */

if (rxfuncquery('SysLoadFuncs') >< 0) then  /* if we have to load the REXX utility functions */
do

 if (rxfuncadd('SysLoadFuncs','RexxUtil','SysLoadFuncs') = 0) then  /* if we can register the general loading function */
 do
  call sysloadfuncs  /* call the general loading function */
  say 'Rexx utility functions loaded'  /* report */
 end
 else  /* if we cannot register the general loading function */
 do
  say  'Cannot load Rexx utility functions'  /* report */
  Success = 0  /* no success */
 end

end

return Success  /* end of LoadRexxUtils */

/**********************************************************************/
Halt:  /* handles halt condition */
/**********************************************************************/

exit ResultCode  /* just quit */
