home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / rexx / rdebug / rdbend.kex < prev    next >
Encoding:
Text File  |  1993-03-25  |  6.4 KB  |  225 lines
  1. /*H* RDBEND.KEX 02-10-93 12:22*/
  2.  parse arg origin path dfile'!'uc size macro? alt source'!'prgm'!'invoke'!'fileid'!'parms
  3.  Signal On Error;   Signal On Failure;  Signal On Halt
  4.  Signal on Novalue; Signal On Notready; Signal ON Syntax
  5.  Parse Value 'COMMAND SET!COMMAND EXT!COMMAND INPUT' With cs'!'ce'!'ci
  6.  Parse Value 'COMMAND!COMMAND SOS!COMMAND X' With c'!'so'!'xx
  7.  ce '/OPSYS'
  8.  dbme='rdbEND'
  9.  dbsys=opsys.1
  10.  if dbsys='OS/2' then Parse Value 'CMD' 'OS2' With dbcommand dbsys /*O*/
  11.  address KEDIT            /*NC*/
  12.  dbeditor='KEDIT'         /*NC*/
  13.  Parse Value 0 With dbtrc dbtrap dbtrapp dbmsg
  14.  if origin='?'  then return tell(dbme);
  15.  source=strip(source)
  16.  parse var source prgm'.'ft;                   /*NC*/
  17.  Parse Value 0 path'SESSION.LOG' With src session msg
  18.  xx path''dfile '(PROF RDPROFIL'
  19.  parse value 0 '' with src msg
  20.  Parse Value 0 With dbtrc dbtrap dbtrapp dbmsg dbtcode
  21.  if origin='' then origin='/EXIT'
  22.  select
  23.    when origin='/RS'   then call option_restart
  24.    when origin='/OP'   then call option_open
  25.    when origin='/SAVE' then do
  26.      Call  save
  27.      src=1; end
  28.    when origin='/SAVEAS' then do
  29.      Call  save
  30.      src=1; end
  31.    when origin='' then do
  32.      Call  get_parms
  33.      if dbtrc=-7 then return -7 dbtrap
  34.      Call  save
  35.      src=1; end
  36.    when origin='/EXIT' then call option_exit
  37.    otherwise nop
  38.  end
  39.  if dbtrc=-7 then return -7 dbtrap
  40.  if src=0 then call close
  41.  if dbtrc=-7 then return -7 dbtrap
  42.  /*exit*/ return src msg;
  43.  
  44.  OPTION_RESTART:
  45.  parse value modified() with dbtrc dbtrap
  46.  if dbtrc=-7 then return -7 dbtrap
  47.  if dbtrc then do
  48.    Call  save
  49.    if dbtrc=-7 then return -7 dbtrap
  50.    Call  invoke 1
  51.  end
  52.  parse value  rdbtask('* P 3' parms) with dbtrc dbtrap
  53.  if dbtrc=-7 then return -7 dbtrap
  54.  parse value dbtrc dbtrap  with dialog.2 dialog.1
  55.  parms=dialog.1;
  56.  Call  invoke 1
  57.  
  58.  return; OPTION_OPEN:
  59.  parse value rdbtask('* P 7') with dbtrc dbtrap
  60.  if dbtrc=-7 then return -7 dbtrap
  61.  parse value dbtrc dbtrap with dialog.2 dialog.1
  62.  if (dialog.1='')+(dialog.1='OK')+(dialog.2='CANCEL') then src=1
  63.  else do
  64.    prgm=dialog.1
  65.    dbi=pos('.',prgm)                               /*NC*/
  66.    if dbi>1 then do                                /*NC*/
  67.       dbft=substr(prgm,dbi+1)                      /*NC*/
  68.       prgm=left(prgm,dbi-1)                        /*NC*/
  69.       dblist='REX 0 CMD 0 KEX 1 EXEC 0 XEDIT 1'    /*NC*/
  70.       dbmacro?=word(dblist,wordpos(dbft,dblist)+1) /*NC*/
  71.    end                                             /*NC*/
  72.    parse value modified() with dbtrc dbtrap
  73.    if dbtrc=-7 then return -7 dbtrap
  74.    if dbtrc then do
  75.      Call save
  76.      if dbtrc=-7 then return -7 dbtrap
  77.    end
  78.    parse value  rdbtask('* P 6') with dbtrc dbtrap
  79.    if dbtrc=-7 then return -7 dbtrap
  80.    parse value dbtrc dbtrap  with dialog.2 dialog.1
  81.    parms=dialog.1;
  82.    src=0
  83.    Call invoke 1
  84.  end
  85.  
  86.  return;  OPTION_EXIT:
  87.  mrc=modified()
  88.  if dbtrc=-7 then return -7 dbtrap
  89.  src=mrc
  90.  if mrc=10 then do
  91.    src=0
  92.    c 'msg' rdbmsg(220)
  93.    Call save; end
  94.  
  95.  return;     CLOSE:
  96.  /*  check out further
  97.  signal on syntax name ok
  98.  call vexit
  99.  ok:
  100.  */
  101.  xx path''session '(NOPROF'
  102.  c 'FFILE'
  103.  xx fileid '(NOPROF'
  104.  if macro? then cs ' SCR 1'
  105.  else 'QQUIT'
  106.  xx path'include.log' '(NOPROF'; 'QQUIT'
  107.  xx path''invoke '(NOPROF'
  108.  if origin='/SAVE' then do
  109.    cs 'SCR 1'
  110.    return; end
  111.  else do
  112.    if dbsys='OS2' & origin='/RS' then 'QQUIT' /*O*/
  113.    ce '/NBF'
  114.    if nbfile.1>0 then c 'MSG' rdbmsg(190 nbfile.1 'remaining files')
  115.  
  116.  
  117.  
  118.  end
  119.  
  120.  return 0;     INVOKE:
  121.  arg module
  122.  if macro? then parse value 'MACRO' with host w1
  123.  else parse value 'MACRO' 0 with host w1
  124. /* if module=1 then parse value 'rDEBUG' 'queue' host with module host*/
  125.  if module=1 then parse value 'rDEBUG'           host with module host
  126.  else parse value 'D'left(prgm,7) with module host w1 prgm
  127.  msg=host module w1 prgm parms;
  128.  
  129.  return 0; MODIFIED:
  130.  mrc=0
  131.  ce '/ALT';
  132.  if alt.1>alt then do;
  133.    mrc=1
  134.  end;
  135.    if origin<>'/EXIT' then return 1
  136.    if prgm='DEMO' then return 0
  137.    parse value    rdbtask('* P 2') with dbtrc dbtrap
  138.    if dbtrc=-7 then return -7 dbtrap
  139.    dialog.2=dbtrap
  140.    if dialog.2="YES"    then mrc=10
  141.    if dialog.2="NO"     then mrc=0
  142.    if dialog.2="CANCEL" then mrc=1
  143.  
  144.  return mrc;  SAVE:
  145.  ce '/FN/FT'
  146.  table.=''
  147.  if dbsys='CMS' then back=strip(prgm)' BACKUP'
  148.  else back=strip(prgm)'.BAK'
  149.  signal off error
  150.  ':1SSAVE' path''dfile
  151.  xx path''source '(NOPROF'
  152.  c 'SSAVE' path''back
  153.  ':0DEL *'
  154.  ':0 GET' path''dfile 1 size
  155.  cs 'LINEN OFF'
  156.  cs 'ARBCH ON ~'
  157.  cs 'MSGM OFF'
  158.  cs 'WRAP OFF'
  159.  ":1CH! /*Exit*/ Return ! Exit !**"
  160.  ":1CH!Call DBSAY!Say!**"
  161.  call db8change "!/*trace!trace!"
  162.  call db8change "!Call DBPULL 'pu!Parse Upper Pull!"
  163.  call db8change "!Call DBPULL 'pp!Parse Pull!"
  164.  call db8change "!Call DBPULL 'p!Pull!"
  165.  address value dbeditor
  166.  dbcodes='B E S D'            /!1 see below*/
  167.  ':1EXT /CURL'
  168.  i=pos(' 1:', curline.3)
  169.  j=pos(';;;', curline.3)
  170.  if j-i-3>0 then c 'REP' substr(curline.3,i+3,j-i-3)
  171.  do x=2 to size
  172.    c '+1EXT /CURLINE'
  173.  
  174.    parse upper var curline.3 call opt .
  175.    curline.3=substr(curline.3,uc)
  176.    opt=left(opt,5)
  177.    c 'REP' curline.3
  178.    if (opt='DEBUG')+(call<>'CALL')>0 then iterate
  179.    no=x%42+1
  180.  
  181.    opt=substr(curline.3,6,1)
  182.    if pos(opt,dbcodes)>0 then table.no=table.no x opt
  183.  end;
  184.  c ":1CH!;;;DB~!!**"
  185.  c ":1CH! ; !;!**"
  186.  cs 'MSGM ON'
  187.  cs 'WRAP OFF'
  188.  c 'FFILE' source
  189.  msg=rdbmsg(982 source)
  190.  signal on error
  191.  
  192.  return 0; db8CHANGE:
  193.  parse arg string
  194.  parse arg '!' target '!' new '!'
  195.  parse arg . key .
  196.  c ':0'
  197.  do Forever
  198.    c 'LOC !'target
  199.    if rc<>0 then leave
  200.    c 'CH' string
  201.    if key = 'DBPULL'   then c "CH !'!!"      /*NC*/
  202.    if string= '!/*trace!trace!'  then c "CH !*/!!"
  203.  
  204.    '+1'
  205.    if rc<>0 then leave
  206.  end
  207.  
  208.  return 0; GET_PARMS:
  209.  Parse Value rdbvars() with dbtrc dbtrap
  210.  if dbtrc=-7 then return -7 dbtrap
  211.  interpret dbtrc dbtrap
  212.  return 0
  213.  ERROR:    return db9trap(sigl 80e) sourceline(sigl)'~'
  214.  FAILURE:  return db9trap(sigl 80f) sourceline(sigl)'~'
  215.  HALT:     return db9trap(sigl 80h)
  216.  NOTREADY: return db9trap(sigl 80r)sourceline(sigl)'~'
  217.  NOVALUE:  return db9trap(sigl 80v)
  218.  SYNTAX:   return db9trap(sigl 80e) errortext(rc)'~'sourceline(sigl)'~'
  219.  db9TRAP:
  220.  if dbtrc=-7 then dbtrapp=dbtrap
  221.  parse arg dbsigl dbtcode dbtrest
  222.  dbtrap = 0 dbme dbsigl dbtcode dbmsg rdbmsg(dbtcode dbme dbsigl) dbtrest
  223.  dbtrc=-7
  224.  return -7 dbtrapp dbtrap
  225.