/* PFXREXX XEDIT implements XEDIT prefix commands for structured input
   of REXX. The user should have profiles for the appropriate file
   types, e.g., EXEC, XEDIT, that issue the commands:
     SET PREFIX SYNONYM ..     PFXREXX
     SET PREFIX SYNONYM CLINE  PFXREXX
     SET PREFIX SYNONYM CLC    PFXREXX
     SET PREFIX SYNONYM CL     PFXREXX
     SET PREFIX SYNONYM CLO    PFXREXX
     SET PREFIX SYNONYM CLOW   PFXREXX
     SET PREFIX SYNONYM CLOWE  PFXREXX
     SET PREFIX SYNONYM CUC    PFXREXX
     SET PREFIX SYNONYM CU     PFXREXX
     SET PREFIX SYNONYM CUP    PFXREXX
     SET PREFIX SYNONYM CUPP   PFXREXX
     SET PREFIX SYNONYM CUPPE  PFXREXX
     SET PREFIX SYNONYM DO     PFXREXX
     SET PREFIX SYNONYM IF     PFXREXX
     SET PREFIX SYNONYM OTHE   PFXREXX
     SET PREFIX SYNONYM OTHER  PFXREXX
     SET PREFIX SYNONYM RI     PFXREXX
     SET PREFIX SYNONYM RIC    PFXREXX
     SET PREFIX SYNONYM SEL    PFXREXX
     SET PREFIX SYNONYM SELE   PFXREXX
     SET PREFIX SYNONYM SELEC  PFXREXX
     SET PREFIX SYNONYM WHE    PFXREXX
     SET PREFIX SYNONYM WHEN   PFXREXX

   The user can issue GLOBALV commands to override some of the
   indentation defaults:
     GLOBALV SELECT PFXREXX SET Indent_DO     3
     GLOBALV SELECT PFXREXX SET Indent_IF     3
     GLOBALV SELECT PFXREXX SET Indent_label  3
     GLOBALV SELECT PFXREXX SET Indent_SELECT 1
     GLOBALV SELECT PFXREXX SET Indent_WHEN   2
*/

/*
   Variable usage:
   Bump          Adjustment after ADD
   Ccol          Cursor column
   Cline         Cursor line
   Command_name  Name of prefix command
   debug         Requests diagnostic output & trace
   Def_env       Default environment address(); should be THE or XEDIT
   Eline         Line number of end
   Indent        Indentation of inserted text
   Mask          Boilerplate for missing EXTRACT /MASK
   Op_col        Column number of potential keyword
   Op_old        Potential keyword from :Pline
   Pad           Pad for 1st level insertion
   Pd2           Pad for 2nd level insertion
   Pd3           Pad for 3rd level insertion
   Pline         Line number of prefix command
*/

/* Initial housekeeping */

trace n
/* trace ?i */
debug = 0

Def_env = address()
if Def_env = THE then do
   Bump = ''                  /* THE CLP after ADD differs from XEDIT */
   parse upper source opsys calltype path
   parse upper arg Pref Command_name Func Pline Op1 Op2 Op3 .
   Indent_DO     = 3
   Indent_IF     = 3
   Indent_label  = 3
   Indent_SELECT = 1
   Indent_WHEN   = 2
   end
else do
   Bump = '+1'
   parse upper source opsys calltype fn ft fm Command_name Default_any
   parse upper arg Pref Func Pline Op1 Op2 Op3 .
   address CMS GLOBALV SELECT PFXREXX ,
                       GET Indent_DO Indent_IF Indent_SELECT Indent_WHEN
   if Indent_DO     = '' then
      Indent_DO     = 3
   if Indent_IF     = '' then
      Indent_IF     = 3
   if Indent_label  = '' then
      Indent_label  = 3
   if Indent_SELECT = '' then
      Indent_SELECT = 1
   if Indent_WHEN   = '' then
      Indent_WHEN   = 2
   end
if debug then do
   say 'address()='Def_env              ,
       'source='source 'opsys='opsys    ,
       'calltype='calltype 'path='path
   parse version version
   say 'parse version='version
   say 'Pref='Pref 'Command_name='Command_name 'Func='Func 'Pline='Pline 'Op1='Op1 'Op2='Op2 'Op3='Op3
   end
':'Pline COMMAND SET PENDING OFF

if Pref \= Prefix then do
   COMMAND EMSG PFXREXX 'is a prefix macro.'
   exit
   end
Count = 1
COMMAND PRESERVE
SET IMPOS OFF

/* Split out leading command count */
select
   when datatype(Op1,W) then do
      Count = Op1
      Op1   = Op2
      Op2   = Op3
      Op3   = ''
      end
   when datatype(left(Op1,1),W) then do
      Count = left(Op1,1)
      Op1   = delstr(Op1,1)
      end
   otherwise
      nop
   end

/* split out leading or trailing numeric operand */
select
   when datatype(Op1,W) then
      nop
   when datatype(left(Op1,1),W) then do
      if Op3 \= '' then
         call Error_msg 'Too many operands for' Command_name Op1 Op2 Op3
      i = verify(Op1,'01223456789')
      Op3 = Op2
      Op2 = substr(Op1,i)
      Op1 = delstr(Op1,i)
      end
   when datatype(right(Op1,1),W) then do
      if Op3 \= '' then
         call Error_msg 'Too many operands for' Command_name Op1 Op2 Op3
      Op3 = Op2
      i = length(Op1) + 1 - verify(reverse(Op1),'01223456789')
      Op2 = substr(Op1,i)
      Op1 = delstr(Op1,i)
      end
   otherwise
      nop
   end

if Def_env = XEDIT then
   'COMMAND          EXTRACT /FLSCREEN /FNAME /MASK /ZONE'
else
   'COMMAND          EXTRACT           /FNAME       /ZONE'

'COMMAND :'Pline 'EXTRACT /CURSOR /CURLINE'

/* calculate indentation based on the presence of a label or statement */
Op_old = word(CURLINE.3,1)
Op_col = wordindex(CURLINE.3,1)
if debug then
   say 'Op_old='Op_old 'Op_col='Op_col
Colon  = verify(Op_old, ':', M)
select
   when Op_old = '' then do
      /* No indent after empty line */
      Op_col = 1
      end
   when Colon  then do
      /* Potential keyword is first word after label */
      /* Don't assume separating blank */
      parse var Op_old . ':' Op_new
      If Op_new = '' then
         /* Indent Indent_label after standalone label */
         Op_col = Op_col + Indent_label
      else do
         /* Indent to first word after label */
         Op_col = verify(CURLINE.3, ' ', N, Op_col + Colon)
         Op_old = strip(Op_new)
         end
      end
   otherwise
      /* indent to nonlabel */
      nop
   end
Indent = Op_col - 1
/* Upper case potential keyword */
Op_old = translate(Op_old)

/* Adjust indentation based on command and statement keyword */
select
   when Op_old = DO     then
      Indent = Indent + Indent_DO
   when Op_old = ELSE   | ,
        Op_old = IF     then
      Indent = Indent + Indent_IF
   when Op_old = OTHERWISE | ,
        Op_old = WHEN      then
      /* indent anything but WHEN or OTHERWISE after a WHEN or OTHERWISE */
      if \abbrev(OTHERWISE,Command_name,4) & ,
         \abbrev(WHEN,     Command_name,3) then
         Indent = Indent + Indent_WHEN
   when Op_old = SELECT then
      Indent = Indent + Indent_SELECT
   otherwise
      if abbrev(WHEN,     Command_name,3) then
         Indent = Indent - Indent_WHEN
   end
Op_col = Indent + 1
Pad    = left('',Indent)

/* Mainline logic */
if debug then trace ?i

select
   when Func = SET | Func = SHADOW then do Pass = 1 to Count
      Iline = Pline
      Cline = Pline + 1
      Eline = Cline + 1
      COMMAND SET SCOPE ALL
      Ccol  = Indent + 1
      select
         when Command_name = '..'    | ,
              Command_name = 'CLINE' then do
            Ccol = 0
            call Get_mask
            if CURLINE.5 = NEW & CURLINE.3 = Mask then do
               COMMAND DELETE 1
               leave
               end
            end
         when Command_name = 'CLC' | abbrev('CLOWE',Command_name) then do
            select
               when Op1 = '' then do
                  /* Lower case current zone */
                  COMMAND ':'Pline LOWERCAS Count
                  leave
                  end
               when Op1 = 'C' then do
                  /* Lower case up to cursor */
                  call set_case LOWERCAS, CURSOR.4
                  leave
                  end
               when datatype(Op1,'W') then do
                  /* Lower case up to specified column */
                  call set_case LOWERCAS, Op1
                  leave
                  end
               otherwise
                  call Error_msg 'Invalid column designator' Op1
               end
            end
         when Command_name = 'CUC' | abbrev('CUPPE',Command_name) then do
            select
               when Op1 = '' then do
                  /* Upper case current zone */
                  COMMAND ':'Pline UPPERCAS Count
                  leave
                  end
               when Op1 = 'C' then do
                  /* Upper case up to cursor */
                  call set_case UPPERCAS, CURSOR.4
                  leave
                  end
               when datatype(Op1,'W') then do
                  /* Upper case up to specified column */
                  call set_case LOWERCAS, Op1
                  leave
                  end
               otherwise
                  call Error_msg 'Invalid column designator' Op1
               end
            end
         when Command_name = 'DO' then do
            if debug then trace ?i
            Op_col = Ccol + Indent_DO
            Eline  = Cline + 2
            Pd2    = Pad || left('',Indent_DO)
            call Get_mask
            select
               when Op1 = '' then do
                  DO_string = 'do'
                  Cline  = Cline + 1
                  end
               when abbrev(FOREVER,Op1,1) then do
                  DO_string = 'do while' 1
                  Cline  = Cline + 1
                  end
               when abbrev(UNTIL,Op1) then do
                  DO_string = 'do until .'
                  Ccol = Ccol + 9
                  end
               when abbrev(WHILE,Op1) then do
                  DO_string = 'do while .'
                  Ccol = Ccol + 9
                  end
               otherwise do
                  DO_string = 'do' Op1
                  Ccol = Ccol + 3
                  end
               end
            COMMAND ':'Iline INPUT pad || DO_string
            COMMAND          SET   PENDING ON 'CLINE'
            call Insert_line RI, ''
            COMMAND          INPUT Pd2'end'
            end
         when Command_name = 'IF' then do
            Op_col = Ccol + Indent_IF
            Eline  = Cline + 5
            Pd2    = Pad || left('',Indent_IF)
            call Get_mask
            COMMAND ':'Iline INPUT pad'if . then do'
            COMMAND          SET   PENDING ON 'CLINE'
            call Insert_line RI, ''
            COMMAND          INPUT Pd2'end'
            COMMAND          INPUT pad'else do'
            call Insert_line RI, ''
            COMMAND          INPUT Pd2'end'
            end
         when abbrev(OTHERWISE,Command_name,4) then do
            Cline = Cline + 1
            Op_col = Indent + Indent_WHEN + 1
            Eline  = Cline + 2
            Pd2    = Pad || left('',Indent_WHEN)
            call Get_mask
            COMMAND ':'Iline INPUT pad || 'otherwise then do'
            call Insert_line RIC, ''
            COMMAND          INPUT Pd2'end'
            end
         when Command_name = 'RI' | Command_name = 'RIC' then do
            if CURLINE.5 = NEW & Command_name = 'RIC' then do
               /* Delete unaltered RIC line */
               call Get_mask
               if CURLINE.3 = MASK.1 then do
                  COMMAND DELETE 1
                  Ccol = 0
                  leave
                  end
               end
            Op_col = Ccol
            call Get_mask
            COMMAND ':'Iline SET PENDING ON 'CLINE'
            if Pass = 1 then
               Set_pend = 'RIC'min(Count,99)
            else
               Set_pend = 'CLINE'
            call Insert_line Set_pend, ''
            end
         when abbrev('SELECT',Command_name,3) then do
            /* Place cursor after keyword WHEN */
            Cline  = Cline + 1
            Ccol   = Indent + Indent_SELECT + 6
            Op_col = Indent + Indent_SELECT + Indent_WHEN + 1
            Eline  = Cline + 6
            Pd2    = Pad || left('',Indent_SELECT)
            Pd3    = Pad || left('',Indent_WHEN)
            call Get_mask
            COMMAND ':'Iline INPUT pad || 'select'
            COMMAND          INPUT pd2 || 'when . then do'
            COMMAND          SET   PENDING ON 'CLINE'
            call Insert_line RIC, ''
            COMMAND          INPUT Pd3'end'
            COMMAND          INPUT pd2'otherwise do'
            call Insert_line RI, ''
            COMMAND          INPUT Pd3'end'
            COMMAND          INPUT Pd2'end'
            end
         when abbrev(WHEN,Command_name,3) then do
            /* Place cursor after keyword WHEN */
            Ccol   = Indent + 6
            Op_col = Indent + Indent_WHEN + 1
            Eline  = Cline + 2
            Pd2    = Pad || left('',Indent_WHEN)
            call Get_mask
            COMMAND ':'Iline INPUT pad || 'when . then do'
            call Insert_line RIC, ''
            COMMAND          INPUT Pd2'end'
            end
         otherwise
            call Error_msg 'Unknown prefix subcommand'
         end
      end
   when Func = CLEAR then do
      /* Not needed at this time */
      COMMAND RESTORE
      exit
      end
   otherwise do
      COMMAND EMSG 'Func='Func'? Should be SET, SHADOW or CLEAR.'
      COMMAND RESTORE
      exit
      end
   end

/* Final housekeeping */

COMMAND RESTORE
if Cline > 0 & Ccol > 0 then do
   if Debug then
      say COMMAND ':'Cline CURSOR FILE Cline Ccol PRIORITY 30
   COMMAND ':'Cline CURSOR FILE Cline Ccol PRIORITY 30
   COMMAND EXTRACT '/'PENDING '*'
   if rc > 0 then do
      COMMAND EMSG 'rc='rc 'in' COMMAND EXTRACT '/'PENDING '*'
      exit
      end
   if Pending.0 > 0 then do
      COMMAND REFRESH                   /* Hack due to XEDIT incompatibity */
      exit
      end
   if Def_env = XEDIT then do
      /* THE doesn't have EXTRACT|QUERY|SET fLSCREEN */
      if Line.1 > Pline then
         Flscreen.1 = Flscreen.1 + Count * (Eline - Iline)
      if Cline < Flscreen.1 | Eline > Flscreen.2 then do
         select
            when abbrev(CURLINE.1,M) then
               Pline = Cline
            when CURLINE.1 < 0 then
               Pline = max(Cline,Eline+3+CURLINE.1)
            otherwise
               nop
            end
         push ':'Pline CURSOR FILE Cline Ccol PRIORITY 70
         end
      end
   end
COMMAND REFRESH
exit

/* Subroutines */

Get_mask:
   procedure expose Def_env Mask MASK.1 Op_col
   /* Insert placeholder for statment and comment delimitors into mask
      if running an editor that supports it                             */
   /* Set variable Mask to simulate masking in THE */
   if Op_col = 0 then
      return
   if Def_env = THE then
      /* THE doesn't have EXTRACT|QUERY|SET MASK     */
      Mask = '_'
   else
      Mask = MASK.1
   Mask = overlay('/*',Mask,40)
   Mask = overlay('*/',Mask,70)
   Mask = overlay('.',Mask,Op_col)
   if Def_env = XEDIT then
      COMMAND SET MASK IMMED MASK.1
   return

Insert_line:
   procedure expose Def_env Mask
   parse arg Set_pend Text
   COMMAND INPUT Text
   if Set_pend \= '' then
      COMMAND SET PENDING ON Set_pend
   if Def_env = THE then do
      COMMAND CLOCATE ':1'
      COMMAND COVERLAY Mask
      end
   return

Set_case:
   procedure expose Count Pline
   /* arg(1) case   is command name LOWERCAS or UPPERCAS */
   /* arg(2) cursor is rightmust column to be upper or lower cased */
   parse upper arg case, cursor
   RZONE = min(cursor,ZONE.2)
   if ZONE.1 > RZONE then
      return
   COMMAND ':'Pline SET ZONE ZONE.1 RZone
   COMMAND          case Count
   return

/* Not currently used */
Set_upper:
   /* Do not change case beyond cursor */
   RZone = min(i,ZONE.2)
   if LZone > RZone then
      return
   Zone_text = substr(CURLINE.3,LZone,RZone-LZone+1)
   if verify(Zone_text, xrange('a','z'), MATCH) \= 0 then do
      COMMAND ':'Pline SET ZONE LZone RZone
      COMMAND          UPPERCAS 1
      end
   return

Error_msg:
   if Count = 1 & \datatype(Op1,W) then
      Text = Command_name Op1
   else
      Text = Count || Command_name Op1
   if datatypw(Op1,'W') \= datatypw(Op2,'W') then
      Text = Text || Op2
   else
      Text = Text    Op2
   Text = left(Text Op3, 6)
   if debug then say arg(1)':' Count Op1 Op2 Op3
   COMMAND EMSG arg(1)':' Count Op1 Op2 Op3
   if Def_env = XEDIT then
      COMMAND ':'Pline SET PENDING ERROR Text
   exit