home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / rdebug21.zip / RPP.KEX < prev    next >
Text File  |  1993-03-25  |  3KB  |  124 lines
  1. /*H* RPP.KEX 02-10-93 14:07*/
  2.  /*      test seperately
  3.  signal on error
  4.  signal on halt
  5.  signal on syntax
  6.  */
  7.  Parse source sys .
  8.  if      sys='OS/2'  then sys='OS2'
  9.  else if sys='PCDOS' then sys='DOS'
  10.  if (sys='DOS') + (sys='OS2')>0 then pc?=1
  11.  trace o?r
  12.  me='rPP'
  13.  If arg(1)='?'  Then Exit tell(me)
  14.  Arg num tab test .
  15.  if pc? then c=''
  16.  else c='COMMAND'
  17.  c 'EXTRACT /FN/LINE/SIZE/FT/LINEND/AUTOSAVE/MSGMODE'
  18.  c 'SET AUTOSAVE OFF'
  19.  /*c 'SET MSGMODE OFF'*/
  20.  c 'MSGLINE ON 3 12 OVERLAY'
  21.  c 'SET LINEND OFF'
  22.  If line.1=0 Then Do
  23.    '+1'
  24.    line.1=1; End
  25.  If (num='')+(num='*')>0 Then num=size.1-line.1+1
  26.  If size.1<line.1+num Then num=size.1-line.1+1
  27.  If datatype('0'num,'w') Then Nop
  28.  Else Exit msg(me,10,'Invalid number:' num)
  29.  If tab='' Then tab=2
  30.  /*
  31.  Do level=1 Until substr(curline.3,tab*level,tab)<>copies(' ',tab)
  32.    c 'EXTRACT /curline'
  33.    If words(curline.3)=0 Then '+1'
  34.  End
  35.  */
  36.  c 'EXTRACT /curline'
  37.  Parse Var curline.3  word .
  38.  level=pos(word,curline.3)
  39.  if level>0 then level=(level)%tab
  40.  '-1'
  41.  select
  42.    When test   <> ''  Then Call test /* To test: rpp * 2 tttt */
  43.    When ftype.1 = 'BAT'   Then Call bat_format
  44.    When ftype.1 = 'C'     Then Call c_format
  45.    When ftype.1 = 'H'     Then Call c_format
  46.    When ftype.1 = 'COBOL' Then Call cobol_format
  47.    otherwise Call rexx_format
  48.  end
  49.  c 'SET AUTOSAVE' autosave.1
  50.  ':'line.1 c 'SET LINEND' linend.1
  51.  Return
  52.  
  53.  REXX_FORMAT:
  54.  xend=' END '; xdo=' DO '; xselect=' SELECT ';
  55.  swthen=0
  56.  Do num Until rc<>0
  57.    '+1 COMMAND EXTRACT /CURLINE'
  58.    str=translate(curline.3,' ',';/')
  59.    Parse Upper Var str wd1 wd2 rest
  60.    level=level-(wd1=xend)
  61.    If ((right(wd1,1)=':') + (level<1)) >0 Then level=1
  62.  
  63.    string=copies(' ',tab*level-2)''strip(curline.3)
  64.    c 'REPLACE' string
  65.    If '!'string<>'!'curline.3 Then c 'REFRESH'
  66.  
  67.    level=level-(pos(xend,' 'wd2 rest' ')>0)+(pos(xdo,' 'wd1 wd2 rest' ')>0)
  68.    level=level+(wd1=xselect)
  69.    If ((right(wd1,1)=':')+ (right(wd2,1)=':'))>0 Then level=1
  70.  End;
  71.  Return
  72.  /*WORDFULL:*/
  73.  /* used because wordpos() doesn't work properly*/
  74.  /*
  75.  trace o?r
  76.  arg needle, haystack
  77.  needle=' 'strip(needle)' '
  78.  i=wordpos(needle,' 'haystack' ')
  79.  if i>0 then do
  80.    j=pos(needle,' 'haystack' ')
  81.    if j=0 then i=0
  82.  end
  83.  return i
  84.    */
  85.  C_FORMAT:
  86.  Do num Until rc<>0
  87.    '+1 COMMAND EXTRACT /CURLINE'
  88.    str=translate(curline.3,' ','09'x)
  89.    Parse Upper Var str wd1 wd2 rest
  90.    If pos('}',str)>0 & pos('{',str)=0 Then level = level-1
  91.    If level<1          Then level=1
  92.  
  93.    string=copies(' ',tab*level-1)''strip(str)
  94.    c 'REPLACE' string
  95.    If '!'string<>'!'curline.3 Then c 'REFRESH'
  96.    If pos('{',str)>0 & pos('}',str)=0 Then level = level+1
  97.  End;
  98.  Return
  99.  
  100.  BAT_FORMAT:
  101.  n=1
  102.  trace o?r
  103.  if level=0 then level=1
  104.  n=num
  105.  Do num=1 to num Until rc<>0
  106.    '+1' c 'EXTRACT /CURLINE'
  107.    str=translate(curline.3,' ','09'x)
  108.    Parse Upper Var str wd1 wd2 rest
  109.    uppstr=wd1 wd2 rest
  110.    If (pos(' IF ',' 'uppstr' ')>0 & pos(' GOTO ',' 'uppstr' ')>0) Then do
  111.      if num=n+1 then level=level-1; end
  112.    If left(wd1,1)=':'  Then level = 1
  113.    If level < 1 Then level = 1
  114.  
  115.    string=copies(' ',tab*level-2)''strip(str)
  116.    c 'REPLACE' string
  117.    If '!'string<>'!'curline.3 Then c 'REFRESH'
  118.    If (pos(' IF ',' 'uppstr' ')>0 & pos(' GOTO ',' 'uppstr' ')>0) Then do
  119.      if num>=n+1 then level=level+1
  120.      n=num; end
  121.    If left(wd1,1)=':'  Then level = 2
  122.  End;
  123.  Return
  124.