/*REXX Do not move the following comments */
/*
    This macro pairs )SEL and )ENDSEL statements in an ISPF skeleton.

    Parameters:    (defaults are marked with an asterisk)

       LABel     - insert labels to match )SEL and )UNSEL statements.
                   The labels are of the form .Sxxxx and .Exxxx where .S
                   labels are the )SEL statements and .E labels are the
                   corresponding )ENDSEL statements.  The xxxx portion
                   of the label is the same for matched statements.
                   .Qxxx labels are unmatched )ENDSEL statements.

       UNLabel   - Remove labels from )SEL and )ENDSEL statements.

   *   NOLabel   - Do not change any labels.

       COMment   - Add comments to all matched )ENDSEL statements.

       UNComment - Remove comments from all )ENDSEL statements.

   *   NOComment - Do not change comments on )ENDSEL statements.
   */
/* AUTHOR : DOUG NADEL
            NADEL AT US.IBM.COM
*/
Address 'ISPEXEC'
'ISREDIT MACRO (PARM)'
Signal on Novalue
Upper parm
label_level=1
comment=0
Do While words(parm)>0
  Parse Var parm opt parm
  Select
    When(opt='?') Then Call tell
    When(abbrev('LABEL',    opt,3)) Then label_level=0
    When(abbrev('NOLABEL',  opt,3)) Then label_level=1
    When(abbrev('UNLABEL',  opt,3)) Then label_level=2
    When(abbrev('NOCOMMENT',opt,3)) Then comment = 0
    When(abbrev('COMMENT',  opt,3)) Then comment = 1
    When(abbrev('UNCOMMENT',opt,3)) Then comment = 2
    Otherwise
        Do
          Parse Source . . me .
          opt=space(right(opt,9))
          zedsmsg='INVALID OPTION'
          zedlmsg=''''opt''' is an invalid parm for the 'me' command.'
          zedlmsg=zedlmsg 'Use ? to view parameters.'
          'SETMSG MSG(ISRZ001)'
          Exit 12
        End
  End
End
'ISREDIT (STATE) = USER_STATE'
'ISREDIT X ALL'
'ISREDIT F '')SEL'' ALL 1'
'ISREDIT F '')ENDSEL'' ALL 1'
'ISREDIT CAPS OFF'
sellines=''
endlines=''
sels=0
ends=0
loc='FIRST'
Do Until findrc>0
  'ISREDIT FIND '')SEL'' 1 ' loc
  findrc=rc
  If findrc=0 Then
    Do
      'ISREDIT (SELLINE) = LINENUM .ZCSR'
      sels=sels+1
      sellines=sellines selline
    End
    loc='NEXT'
End
loc='FIRST'
Do Until findrc>0
  'ISREDIT FIND '')ENDSEL'' 1 ' loc
  findrc=rc
  If findrc=0 Then
    Do
      'ISREDIT (ENDLINE) = LINENUM .ZCSR'
      ends=ends+1
      endlines=endlines endline
    End
    loc='NEXT'
End
str=''
lines = ''
number_of_sels=words(sellines)
number_of_endsels=words(endlines)
Do Until words(sellines)=0 ³ words(endlines)=0
  If word(sellines,1) < word(endlines,1) Then
    Do
      str=str³³'S'
      Parse Var sellines line sellines
      lines=lines line
    End
  Else
    If word(sellines,1) > word(endlines,1) Then
      Do
        str=str³³'E'
        Parse Var endlines line endlines
        lines=lines line
      End
End
lines=lines sellines
str=str³³copies('S',words(sellines))
lines=lines endlines
str=str³³copies('E',words(endlines))
sels=0
ends=0
sel_label.=0
labelnum=0
unmatched=0
max_depth=0
Do a=1 to length(str)
  If substr(str,a,1) = 'S' Then
    Do
      sels=sels+1
      max_depth=max(max_depth,sels)
      labelnum=labelnum+1
      If sels>8 Then Say 'Depth is 'sels' at line 'subword(lines,a,1)+0
      g='.S'getlabel(labelnum)
      sel_label.sels=g
      line_num.sels=word(lines,a)
      'ISREDIT (COND) = LINE 'line_num.sels
      Parse Var cond . cond
      condition.sels=cond
    End
  Else
    Do
      If sels>0 Then
        Do
          g=overlay('E',sel_label.sels,2)
         'ISREDIT (COND) = LINE 'word(lines,a)
          cond=')ENDSEL    '
          If comment=1 Then
             cond=cond³³center(' 'space(condition.sels)' from line '³³,
             0+line_num.sels' ',58,'-')
          If comment>0 Then
            'ISREDIT LINE 'word(lines,a)' = (COND)'
          sels=max(0,sels-1)
        End
      Else
        Do
          unmatched=unmatched+1
          g='.Q'getlabel(unmatched)
          cond=')ENDSEL    '
          If comment=1 Then
             cond=cond³³center(' Mismatched )ENDSEL ',58,'?')
          If comment>0 Then
            'ISREDIT LINE 'word(lines,a)' = (COND)'
        End
    End
  If label_level<2 Then
    'ISREDIT LABEL 'word(lines,a)' = 'g label_level
  Else
    'ISREDIT LABEL 'word(lines,a)' = '' '' 0'
End
'ISREDIT USER_STATE = (STATE)'
'ISREDIT RESET'
zedsmsg=''
zedlmsg='Number of )SELs :'number_of_sels
zedlmsg=zedlmsg '  )ENDSELs :'number_of_endsels
zedlmsg=zedlmsg ' Maximum depth: 'max_depth
zedlmsg=zedlmsg ' Mismatched )ENDSELs: 'unmatched
'SETMSG MSG(ISRZ001)'
Exit
getlabel:Procedure
  Arg a
  a=a-1
  alf='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
  lalf=length(alf)
  b=substr(alf,(a-lalf*(a%lalf))+1,1)
  a=a%lalf
  b=substr(alf,(a-lalf*(a%lalf))+1,1)³³b
  a=a%lalf
  b=substr(alf,(a-lalf*(a%lalf))+1,1)³³b
  a=verify(b,'A')
  If a=0 Then a=3
  b=substr(b,a)
Return space(b)
tell: procedure
  Parse Source . . me .
  a=3
  Say 'TUTORIAL 'centre(' EDIT MACRO: 'me' ',60,'-')' TUTORIAL'
  Say
  b=sourceline(a)
  Do While pos('*/',b)=0
    Say b
    a=a+1
    b=sourceline(a)
  End
  Say
  msg=' Please address comments to Doug Nadel (NADEL at US.IBM.COM) '
  Say center(msg,78,'*')
  Exit 0
Novalue:
  Parse Source . . me .
  Say 'Novalue condition raised in macro 'me' at line 'sigl
  Say copies('-',78)
  Say sourceline(sigl)
  Say copies('-',78)
  Exit 20