/****************************** Module Header *******************************
*
* Module Name: rexxkeys.e
*
* Copyright (c) Netlabs EPM Distribution Project 2002
*
* $Id$
*
* ===========================================================================
*
* This file is part of the Netlabs EPM Distribution package and 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, in version 2 as it comes in the "COPYING" file of the
* Netlabs EPM Distribution.  This library 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.
*
****************************************************************************/

compile if not defined( SMALL)  -- If compiled separately
   EA_comment 'This defines macros for REXX coding styles and syntax expansion.'

define
   INCLUDING_FILE = 'REXXKEYS.E'

   include 'stdconst.e'
const
   tryinclude 'mycnf.e'
const
 compile if not defined( NLS_LANGUAGE)
   NLS_LANGUAGE = 'ENGLISH'
 compile endif
   include NLS_LANGUAGE'.e'
compile endif

; ---------------------------------------------------------------------------
; Syntax expansion
; ---------------------------------------------------------------------------

; ---------------------------------------------------------------------------
; Convert case of a string, word by word. Keep spaces and Tabs.
defproc RexxKeywordCase
   universal keyword_case

   InStr = arg( 1)
   OutStr = InStr
   p = verify( OutStr, ' '\t, 'N')                   -- find first word
   startp = p
   i = 0
   do while p > 0
      pb = verify( OutStr, ' '\t, 'M', startp + 1)   -- find next blank
      p = 0
      if pb > 0 then
         p = verify( OutStr, ' '\t, 'N', pb + 1)     -- find next word
      endif
      if p = 0 then
         next = substr( OutStr, startp)              -- rest
      else
         next = substr( OutStr, startp, p - startp)  -- next word incl. trailing blanks
      endif

      KeywordCase = upcase( leftstr( keyword_case, 1))

      if KeywordCase = 'L' then
         next = lowcase( next)
      elseif KeywordCase = 'U' then
         next = upcase( next)
      elseif KeywordCase = 'M' then
         next = lowcase( next)
         next = upcase( substr( next, 1, 1))''substr( next, 2)
      endif
      OutStr = overlay( next, OutStr, startp)
      if pb = 0 then
         leave
      endif
      startp = p
   enddo
   return OutStr

; ---------------------------------------------------------------------------
defc RexxFirstExpansion
   rc = RexxFirstExpansion( arg( 1))  -- (rc = 0) = processed

; This is not executed with a literal. See KEYS.E:"defproc ExpandKey"
defproc RexxFirstExpansion
   universal indent
   universal if_adds_else
   universal comment_end
   universal force_keyword_case

   fForce = wordpos( 'FORCE', upcase( arg( 1)))

   retc = 0  -- 0 = processed, otherwise 1 is returned
             -- (exchanged compared to standard EPM)

   do once = 1 to 1
      if not .line then
         retc = 1
         leave
      endif

      if comment_end = 1 then
         END_DO     = ' /* do */'
         END_SELECT = ' /* select */'
      else
         END_DO     = ''
         END_SELECT = ''
      endif

      TabWidth = word( .tabs, 1)
      Case     = 0

      getline LineStr
      StripLineStr = StripBlanks( LineStr, 'T')
      LeftLineStr  = leftstr( LineStr, .col - 1)  -- Split LineStr into two parts at cursor
      Wrds         = strip( translate( LineStr, ' ', \9))
      UpWrds       = upcase( Wrds)
      if Case = 0 then
         pWrds     = pos( UpWrds, upcase( LineStr))
      else
         pWrds     = pos( Wrds, LineStr)
      endif
      pAfterWrds   = pWrds + length( Wrds)

      Spc          = leftstr( LineStr, Max( 0, pWrds - 1))  -- Indent of line with tabs and spaces
      fChanged = 0  -- Unused, but required for TabExpandStr
      ExpSpc       = TabExpandStr( Spc, TabWidth, fChanged)
      ExpSpcLen    = length( ExpSpc)
;     Spc          = ExpSpc  -- Enable this line if you want to insert spaces only
      SpcPlus1     = Spc''copies( ' ', indent)

      -- Skip expansion when cursor is within a comment
      if InsideComment( GetMode()) then
         retc = 1

      -- Skip expansion when cursor is not at or after line end
      elseif StripBlanks( LeftLineStr, 'T') <> StripLineStr & not fForce then
         retc = 1

      elseif UpWrds = 'IF' then
         call NextCmdAltersText()
         SwitchInsertState( '1')
         if force_keyword_case then
            .col = pWrds
            eraseendline
            keyin RexxKeywordCase( 'if ')
         endif
         .col = pAfterWrds + 1
         eraseendline
         keyin RexxKeywordCase( ' then')
         if if_adds_else = 1 then
            ElseFound = WordWithIndentExists( 'else', ExpSpcLen, 0)
            if not ElseFound then
               insertline Spc''RexxKeywordCase( 'else'), .line + 1
            endif
         endif
         endline
         .col = pAfterWrds + 1

      elseif UpWrds = 'WHEN' then
         call NextCmdAltersText()
         SwitchInsertState( '1')
         if force_keyword_case then
            .col = pWrds
            eraseendline
            keyin RexxKeywordCase( 'when ')
         endif
         .col = pAfterWrds + 1
         eraseendline
         keyin RexxKeywordCase( ' then')
         .col = pAfterWrds + 1

      elseif UpWrds = 'DO' then
         call NextCmdAltersText()
         SwitchInsertState( '1')

         if force_keyword_case then
            .col = pWrds
            eraseendline
            keyin RexxKeywordCase( 'do ')
         endif
         .col = pAfterWrds + 1
         eraseendline
         DoFoundLine  = WordWithIndentExists( 'do',  ExpSpcLen, 0)
         EndFoundLine = WordWithIndentExists( 'end', ExpSpcLen, 0)
         -- if not EndFoundLine then
         if not EndFoundLine | (DoFoundLine > 0 & DoFoundLine < EndFoundLine) then
            insertline Spc''RexxKeywordCase( 'end'END_DO), .line + 1
         endif
         endline

      else
         retc = 1
      endif
   enddo
   return retc

; ---------------------------------------------------------------------------
defc RexxSecondExpansion
   rc = RexxSecondExpansion( arg( 1))  -- (rc = 0) = processed

; This is not executed with a literal. See KEYS.E:"defproc ExpandKey"
defproc RexxSecondExpansion
   universal indent
   universal bracket_placement
   universal auto_terminate_comment
   universal comment_end
   universal force_keyword_case
   universal header_width
   universal header_style

   fForce = wordpos( 'FORCE', upcase( arg( 1)))

   retc = 0  -- 0 = processed, otherwise 1 is returned
             -- (exchanged compared to standard EPM)

   do once = 1 to 1
      if not .line then
         retc = 1
         leave
      endif

      BracketPl = upcase( leftstr( bracket_placement, 1))

      if comment_end = 1 then
         END_DO     = ' /* do */'
         END_SELECT = ' /* select */'
      else
         END_DO     = ''
         END_SELECT = ''
      endif

      TabWidth = word( .tabs, 1)
      Case     = 0

      -- Get current line or previous line until a non-blank line is found
      -- Strip trailing semicolons
      CurLineStr = ''
      do l = .line to 1 by -1
         getline LineStr, l
         if l = .line then
            -- Save first line
            CurLineStr = LineStr
         endif

         -- Strip trailing blanks and semicolons
         StripLineStr = StripBlanks( LineStr, 'T', ' '\9';')
         if StripLineStr <> '' then
            -- Found
            leave
         endif
      enddo

      getline LineStr
      StripLineStr = StripBlanks( LineStr, 'T')
      Wrds         = translate( StripLineStr, ' ', \9)
      FirstWrd     = word( Wrds, 1)
      UpFirstWrd   = upcase( FirstWrd)
      LastWrd      = word( Wrds, Max( 1, words( Wrds)))  -- word needs an int > 0
      UpLastWrd    = upcase( LastWrd)
      if Case = 0 then
         pFirstWrd = pos( UpFirstWrd, upcase( StripLineStr))
         pLastWrd  = pos( UpLastWrd, upcase( StripLineStr))
      else
         pFirstWrd = pos( FirstWrd, StripLineStr)
         pLastWrd  = pos( LastWrd, StripLineStr)
      endif

      Spc         = leftstr( StripLineStr, Max( 0, pFirstWrd - 1))  -- Indent of line with tabs and spaces
      ExpSpc      = TabExpandStr( Spc, TabWidth, junk)
      ExpSpcLen   = length( ExpSpc)
;     Spc         = ExpSpc  -- Enable this line if you want to insert spaces only
      SpcPlus1    = Spc''copies( ' ', indent)

      if words( Wrds) > 1 then
         ForeLastWrd   = word( Wrds, words( Wrds) - 1)  -- word needs an int > 0
         UpForeLastWrd = upcase( ForeLastWrd)
         if Case = 0 then
            pForeLastWrd  = pos( UpForeLastWrd, upcase( StripLineStr))
         else
            pForeLastWrd  = pos( ForeLastWrd, StripLineStr)
         endif
      else
          ForeLastWrd   = ''
          UpForeLastWrd = ''
          pForeLastWrd  = 0
      endif

      if pos( '/*', StripLineStr) & auto_terminate_comment then
         call NextCmdAltersText()
         if not pos( '*/', StripLineStr) then
            endline
            keyin ' */'
         endif
         'Newline newline'
         leave

      elseif wordpos( Wrds, '/* /**') then
         call NextCmdAltersText()
         insertline Spc' * ', .line + 1
         down
         endline
         -- Search for closing comment */
         CommentEndFound = WordWithIndentExists( '*/', ExpSpcLen + 1, 1, 200)  -- search only in 200 next lines
         if not CommentEndFound then
            insertline Spc' */', .line + 1
         endif
         leave

      elseif upcase( Wrds) = '/*H' then
         call NextCmdAltersText()
         -- Style 1:
         -- /***************
         -- * |
         -- ***************/
         -- Style 2:
         -- /***************
         --  * |
         --  **************/
         pReplaceLine( '/'copies( '*', header_width - 1))
         if header_style = 1 then
            insertline '* ', .line + 1
            down
            endline
            insertline copies( '*', header_width - 1)'/', .line + 1
         else
            insertline ' * ', .line + 1
            down
            endline
            insertline ' 'copies( '*', header_width - 2)'/', .line + 1
         endif
         leave

      elseif FirstWrd = '*' then
         -- Search for opening comment /*
         fFound = 0
         startl = .line - 1
         do l = startl to 1 by -1
            if l < startl - 200 then  -- search only in 200 previous lines
               leave
            endif
            getline PrevLineStr, l
            StripPrevLineStr = word( translate( PrevLineStr, ' ', \9), 1)
            -- Search for first word
            if StripPrevLineStr = '*' then
               iterate
            elseif substr( StripPrevLineStr, 1, 2) = '/*' then
               fFound = 1
               leave
            else
               leave
            endif
         enddo
         if fFound = 1 then
            call NextCmdAltersText()
            -- Move the part right of the cursor down, after the '* '
            RestLine = strip( substr( StripLineStr, .col), 'L')
            erase_end_line
            insertline Spc'* 'RestLine, .line + 1
            down
            endline
         else
            retc = 1
         endif
         leave

      endif

      -- Skip further expansion when cursor is within a comment
      if InsideComment( GetMode()) then
         retc = 1

      -- Skip expansion when cursor is before the start of first word or in col 1
      elseif .col < pFirstWrd | .col = 1 then
compile if 1
         retc = 1
compile else
         -- Insert an empty line before
         insertline '', l
compile endif

      elseif wordpos( UpLastWrd, 'END') then
         call NextCmdAltersText()
         if force_keyword_case & LastWrd <> RexxKeywordCase( LastWrd) then
            if CurLineStr = LineStr then
               call SearchReplaceLine( LastWrd, RexxKeywordCase( LastWrd), 1, '', .line, pLastWrd)
            endif
         endif
         insertline Spc, .line + 1
         down
         endline

      elseif wordpos( UpForeLastWrd, 'THEN ELSE') & UpLastWrd = 'DO' then
         call NextCmdAltersText()
         if BracketPl = 'A' then
            if force_keyword_case & ForeLastWrd LastWrd <> RexxKeywordCase( ForeLastWrd LastWrd) then
               if CurLineStr = LineStr then
                  call SearchReplaceLine( '', RexxKeywordCase( ForeLastWrd LastWrd), 1, '', .line, pForeLastWrd)
               endif
            endif
            insertline SpcPlus1'', .line + 1
            down
            endline
            do once = 1 to 1
               EndFound = WordWithIndentExists( 'end', ExpSpcLen, 0)
               if EndFound then
                  leave
               endif
               EndFound = WordWithIndentExists( 'end;', ExpSpcLen, 0)
            enddo
            if not EndFound then
               insertline Spc''RexxKeywordCase( 'end'END_DO), .line + 1
            endif
         else
            -- Move DO to the next line. Expand DO line.
            .col = pLastWrd
            SplitWithIndent( Spc)
            retc = RexxSecondExpansion()
            leave
         endif

      elseif wordpos( UpFirstWrd, 'IF WHEN OTHERWISE ELSE') & UpLastWrd <> 'DO' then
         call NextCmdAltersText()
         if force_keyword_case & FirstWrd <> RexxKeywordCase( FirstWrd) then
            if CurLineStr = LineStr then
               call SearchReplaceLine( FirstWrd, RexxKeywordCase( FirstWrd), 1, '', .line, pFirstWrd)
            endif
         endif
         insertline SpcPlus1, .line + 1
         down
         endline

      elseif UpFirstWrd = 'SELECT' then
         call NextCmdAltersText()
         if force_keyword_case & FirstWrd <> RexxKeywordCase( FirstWrd) then
            if CurLineStr = LineStr then
               call SearchReplaceLine( FirstWrd, RexxKeywordCase( FirstWrd), 1, '', .line, pFirstWrd)
            endif
         endif
         -- Always add an (additional) WHEN line when cursor is on a SELECT line
         insertline SpcPlus1''RexxKeywordCase( 'when  then'), .line + 1
         down
         endline
         .col = .col - 5  -- go between WHEN and THEN
         do once = 1 to 1
            EndFound = WordWithIndentExists( 'end', ExpSpcLen, 0)
            if EndFound then
               leave
            endif
            EndFound = WordWithIndentExists( 'end;', ExpSpcLen, 0)
         enddo
         if not EndFound then
            -- Insert END after WHEN line
            insertline Spc''RexxKeywordCase( 'end'END_SELECT), .line + 1
         endif
         OtherwiseFound = WordWithIndentExists( 'otherwise', ExpSpcLen, 0)
         if not OtherwiseFound then
            -- Insert OTHERWISE after WHEN line, maybe before END
            insertline Spc''RexxKeywordCase( 'otherwise'), .line + 1
         endif

      elseif UpFirstWrd = 'DO' then
         lastind = Spc
         nextind = SpcPlus1
         AppendLineNum = 0

         call NextCmdAltersText()
         if wordpos( BracketPl, 'A B') then
            -- Check for previous line with a trailing THEN and get its indent
            if .line > 1 then
               -- Inspect previous line
               -- Don't ignore blank lines here
               getline linel, .line - 1
               if lastword( translate( upcase( linel), ' ', \t)) = 'THEN' then
                  -- Get indent of line before with IF|WHEN|OTHERWISE
                  -- Re-indent DO line: take indent of line before
                  -- or append DO and the rest to THEN line
                  if BracketPl = 'A' then
                     AppendLineNum = .line - 1
                  endif
                  startl = .line - 1
                  do l = startl to 1 by -1
                     if l < startl - 10 then  -- search only 10 last lines
                        leave
                     endif
                     getline linel, l
                     next = word( translate( upcase( linel), ' ', \t), 1)
                     if wordpos( next, 'IF WHEN') then
                        -- Get indent of linel
                        lastind = substr( linel, 1, max( 1, verify( linel, ' '\t)) - 1)
                        nextind = lastind''copies( ' ', indent)
                        leave
                     endif
                  enddo
               elseif wordpos( lastword( translate( upcase( linel), ' ', \t)), 'ELSE OTHERWISE') then
                  -- Get indent of line before with ELSE or OTHERWISE
                  -- Re-indent DO line: take indent of line before
                  -- or append DO and the rest to ELSE line
                  l = .line - 1
                  if BracketPl = 'A' then
                     AppendLineNum = l
                  endif
                  getline linel, l
                  -- Get indent of linel
                  lastind = substr( linel, 1, max( 1, verify( linel, ' '\t)) - 1)
                  nextind = lastind''copies( ' ', indent)
               endif
            endif

            -- Find matching END and re-indent END too
            -- Make END; match too
            do once = 1 to 1
               EndFound = WordWithIndentExists( 'end', ExpSpcLen, 0)
               if EndFound then
                  leave
               endif
               EndFound = WordWithIndentExists( 'end;', ExpSpcLen, 0)
            enddo
            if EndFound then
               EndLineNum = EndFound
               EndLineStr = textline( EndLineNum)
               StripEndLineStr = StripBlanks( EndLineStr)
               pEnd = pos( 'END', translate( StripEndLineStr))
               if pEnd > 0 then
                  -- Re-indent END line
                  if force_keyword_case then
                     next = overlay( RexxKeywordCase( 'end'), StripEndLineStr, pEnd)
                     ReplaceStr = lastind''substr( next, pEnd)
                     call pReplaceLine( ReplaceStr, EndLineNum)
                  else
                     ReplaceStr = lastind''StripEndLineStr
                     call pReplaceLine( ReplaceStr, EndLineNum)
                  endif
               endif
            else
               -- Insert END after DO line
               insertline lastind''RexxKeywordCase( 'end'END_SELECT), .line + 1
            endif
         endif

         if force_keyword_case then
            next = overlay( RexxKeywordCase( 'do'), StripLineStr, pFirstWrd)
         else
            next = StripLineStr
         endif
         if AppendLineNum > 0 then
            -- Append DO line
            .line = AppendLineNum
            -- JoinLines ensures that a space is added between the joined lines.
            -- JoinLines removes spaces itself, but the following handles tabs
            -- correctly. Trailing blanks are removed and tabs of the next
            -- line expanded.
            call pEnd_Line()
            eraseendline
            call TabExpandLine( .line + 1, TabWidth)
            'JoinLines'
         else
            -- Re-indent DO line
            if CurLineStr = LineStr then
               ReplaceStr = lastind''substr( next, pFirstWrd)
               call pReplaceLine( ReplaceStr)
            endif
         endif

         -- Add an empty, indented line after DO line
         insertline nextind, .line + 1
         down
         endline

      else
         retc = 1
      endif
   enddo
   return retc