home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / rdebug21.zip / RDBINIT.KEX < prev    next >
Text File  |  1993-03-25  |  6KB  |  211 lines
  1. /*H* RDBINIT.KEX 02-04-93 10:17 */
  2.  dbscreens=1   /* controls display of logo & survival guide, set to 0 to cancel */
  3.  arg dborigin parms
  4.  Signal On Error;   Signal On Failure;  Signal On Halt
  5.  Signal On Novalue; Signal On Notready; Signal ON Syntax
  6.  Parse Value 'COMMAND SET!COMMAND EXT' With dbcs'!'dbce
  7.  Parse Value 'COMMAND!COMMAND SOS!COMMAND X' With dbc'!'dbso '!'dbxx
  8.  dbce '/FN/FT/OPSYS'
  9.  dbme='RDBINIT'
  10.  dbsys=opsys.1
  11.  if dbsys='OS/2' then dbsys='OS2'
  12.  if dborigin='?'  then  /*Exit*/ Return tell(dbme)
  13.  dbmsg=''
  14.  Parse Value 0 With dbtrc dbtrap dbtrapp dbmsg
  15.  select
  16.    When dborigin='/FI' then parse value db3files(parms) with dbtrc dbtrap
  17.    When dborigin='/LO' then do
  18.      parse var parms dbsource dbpath dbsize'!'dblogsw'!'dbuc'!'dbtest?'!'dbsession'!'dbdfile'!'dbvars
  19.      thisfile=dbme'.KEX'    /*NC*/
  20.      if dbscreens=1 then parse value     db3logo()  with dbtrc dbtrap
  21.      if dbtrc=-7 then return -7 dbtrap
  22.      parse value     db3guide() with dbtrc dbtrap
  23.      if dbtrc=-7 then return -7 dbtrap
  24.      parse value     db3files(parms) with dbtrc dbtrap; end
  25.    When dborigin='/IN' then parse value db3input(parms) with dbtrc dbtrap
  26.    otherwise
  27.      Parse Value rdbvars() with dbtrc dbtrap
  28.      interpret dbtrc dbtrap
  29.      parse value     db3files('I' dbsize'!'dblogsw'!'dbuc'!'dbtest?,
  30.      '!'dbsession'!'dbdfile'!'dbvars) with dbtrc dbtrap
  31.  end
  32.  if dbtrc=-7 then return -7 dbtrap
  33.  
  34.  /*Exit*/ Return dbtrc dbtrap ;   db3FILES:
  35.  parse arg dbsource dbpath dbsize'!'dblogsw'!'dbuc'!'dbtest?'!'dbsession'!'dbdfile'!'dbvars
  36.  rexxver=''
  37.  dbs='.'
  38.  dbcs 'SCR1'
  39.  dbtest?=strip(dbtest?)
  40.  off='OFF'
  41.  select
  42.    when dbsource='R' then call db3init
  43.    when dbsource='D' then call db3debug
  44.    when dbsource='C' then call db3refresh
  45.    when dbsource='U' then call db3cmds
  46.    when dbsource='I' then call db3xeditscr
  47.    otherwise nop
  48.  end
  49.  
  50.  dbxx dbpath''dbsession '(PROF RDPROFIL'
  51.  
  52.  dbcs 'MSGM' off
  53.  if dbsource='R' then do
  54.    ':1SET CURL ON M'; end
  55.  else do
  56.    ':1SET CURL ON -2'; end
  57.  
  58.  dbce '/RESER/FN/FT'
  59.  dbmenu=''
  60.  dbcs 'PREF OFF'
  61.  signal off error
  62.    dbcs 'STATUSL ON'                    /*NC*/
  63.    if dbsource ='R' then
  64.    dbcs 'RESER 1 REVERSE File    ' left(fname.1''dbs''ftype.1,14),
  65.    'rDEBUG, the REXX Debugger     ' left(dbmenu,20)  'Help'
  66.    else dbcs 'RESER 1 REVERSE   File   View    Run    Debug   Watch   Controls   Options   Tools       Help'
  67.  signal on error
  68.  dbcs 'COLOR F BLACK ON WHI'
  69.  dbcs 'COLOR CU YE ON WHI'
  70.  dbcs 'COLOR C BLA ON WHI'
  71.  dbcs 'COLOR MSGL YE ON WHI'
  72.  dbcs 'COLOR TO BLA ON WHI'
  73.  dbcs 'COLOR A YE ON WHI'
  74.  dbcs 'IMPMAC ON'
  75.  dbcs 'TOFEOF OFF'       /*NC*/
  76.  dbcs 'MSGM ON'
  77.  dbcs 'SCR2'
  78.  dbc 'BOT'
  79.  ':1SOS TABCMDF'
  80.  
  81.  dbxx dbpath''dbdfile '(PROF RDPROFIL'
  82.  
  83.  ':'dbsize+2 'DEL *'
  84.  ':1SET CURL ON M'
  85.  dbcs 'MSGM' off
  86.  dbcs 'AUTOS OFF'
  87.  dbcs 'TOFEOF OFF'                                    /*NC*/
  88.  dbcs 'IMPMAC ON'                                     /*NC*/
  89.  dbce '/LSCR'
  90.  dbcs 'PREF OFF'
  91.  dbcs 'COLOR * DEFAULT'
  92.  dblscr=lscreen.2
  93.  dbcs 'MSGM' off
  94.  dbce '/RESER'                   /*NC*/
  95.    dbcs 'V6' dblscr+6
  96.    dbcs 'STATUSL OFF'            /*NC*/
  97.    dbcs 'RESER -1 REVERSE rDEBUG  F1=Help F4=Output F5=Go F6=Next F7=Go-Cursor F8=Step F9=Tog B/P F10=Proc'
  98.  dbcs 'MSGM ON'
  99.  
  100.  if dblogsw=0 then dbcs 'SCR1'
  101.  
  102.  return 0; dbmsg;
  103.  
  104.  db3cmds:
  105.  
  106.  return 0; db3INIT:
  107.  
  108.  return 0; db3DEBUG:
  109.  
  110.  return 0; db3REFRESH:
  111.  
  112.  return 0; db3XEDITSCR:
  113.  dbce '/STATUSL'                       /*NC*/
  114.  if statusline.1='ON' then dbtest?=0;  /*NC*/
  115.  else dbtest?=1                        /*NC*/
  116.  
  117.  return 0; db3LOGO:
  118.  dbcs 'SCR1'
  119.  dbxx thisfile '(NOPROF'
  120.  dbcs 'RESER 1 .'
  121.  dbcs 'RESER -1 .'
  122.  dbcs 'PREFIX OFF'
  123.  dbcs 'COLOR CU BRI C ON BLU'
  124.  dbcs 'STATUSL OFF'        /*NC*/
  125.  dbcs 'ARR OFF'            /*NC*/
  126.  dbc  'BOT'
  127.  '-20'
  128.  dbcs 'MSGM OFF'
  129.  dbc 'ALTER * 176 11 *'    /*NC*/
  130.  dbcs 'MSGM ON'
  131.  '+9'
  132.  dbc 'REFRESH'
  133.  if dbsys='OS2' then dbc 'READV KEY'
  134.  else
  135.  Do 10
  136.    Call delay '0.5'
  137.    ans=inkey('N')
  138.    If ans==' ' Then Leave
  139.    If ans<>'' Then Leave
  140.  End
  141.  'QQ'
  142.  dbc 'MSG Please wait'
  143.  dbc 'REFRESH'
  144.  
  145.  return 0; CLEARKEY:
  146.  
  147.  return 0; db3GUIDE:
  148.  parse value rdbHELP('/PANEL G S 1') with dbtrc dbtrap
  149.  
  150.  return 0; db3INPUT:
  151.  arg dbinclude
  152.  parse value 0 1 with rc dbread?
  153.  dbinput='2 RESTART 2 MSAVE 2 SAVE 2 READ 1 XEDIT 1 KEDIT 2 OUTPUT'
  154.  signal off notready
  155.  do forever
  156.    If lines(dbinclude)=0 then do; dbread?=0; leave; end
  157.    dbmessage=linein(dbinclude)
  158.    Parse upper var dbmessage db1 dbmessage
  159.    if db1='*' then iterate
  160.    dbi=pos(' 'dbinput,' 'db1)
  161.    if dbi=0 then leave
  162.    if length(db1)<substr(dbinput,dbi-2,1) then leave
  163.  end
  164.  signal on notready
  165.  if dbread?=0 then do
  166.    call lineout(dbpath''dbinclude)
  167.    return 0; end
  168.  else return 1 db1 dbmessage
  169.  
  170.  Return dbrc;
  171.  ERROR:    return db9trap(sigl 80e) sourceline(sigl)
  172.  FAILURE:  return db9trap(sigl 80f) sourceline(sigl)
  173.  HALT:     return db9trap(sigl 80h)
  174.  NOTREADY: return db9trap(sigl 80r) sourceline(sigl)
  175.  NOVALUE:  return db9trap(sigl 80v)
  176.  SYNTAX:   return db9trap(sigl 80e) errortext(rc)'~'sourceline(sigl)
  177.  db9TRAP:
  178.  if dbtrc=-7 then dbtrapp=dbtrap
  179.  parse arg dbsigl dbtcode dbtrest
  180.  dbtrap = 0 dbme dbsigl dbtcode dbmsg rdbmsg(dbtcode dbme dbsigl) dbtrest
  181.  dbtrc=-7
  182.  return -7 dbtrapp dbtrap
  183.  /*
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  
  191.              *********    **********   *********    **      **    *********
  192.              **      **   **           **      **   **      **   **
  193.              **      **   **           **      **   **      **   **
  194.      ** **   **      **   ********     ********     **      **   **   *****
  195.      ****    **      **   **           **      **   **      **   **      **
  196.      ***     **      **   **           **      **   **      **   **      **
  197.      **      **      **   **           **      **   **      **   **      **
  198.      **      *********    **********   *********     ********     ********
  199.  
  200.  
  201.                 an Integrated Development Environment for REXX
  202.  
  203.  
  204.  
  205.        (c) 1992, All rights reserved     J Gil Gagnon & Associates, Inc
  206.            814-25 Glenn Hawthorne, Blvd Mississauga, Ontario L5R 3E6
  207.  
  208.  
  209.        Please press any key to continue
  210.  */
  211.