home *** CD-ROM | disk | FTP | other *** search
- /*H* RDBINIT.KEX 02-04-93 10:17 */
- dbscreens=1 /* controls display of logo & survival guide, set to 0 to cancel */
- arg dborigin parms
- Signal On Error; Signal On Failure; Signal On Halt
- Signal On Novalue; Signal On Notready; Signal ON Syntax
- Parse Value 'COMMAND SET!COMMAND EXT' With dbcs'!'dbce
- Parse Value 'COMMAND!COMMAND SOS!COMMAND X' With dbc'!'dbso '!'dbxx
- dbce '/FN/FT/OPSYS'
- dbme='RDBINIT'
- dbsys=opsys.1
- if dbsys='OS/2' then dbsys='OS2'
- if dborigin='?' then /*Exit*/ Return tell(dbme)
- dbmsg=''
- Parse Value 0 With dbtrc dbtrap dbtrapp dbmsg
- select
- When dborigin='/FI' then parse value db3files(parms) with dbtrc dbtrap
- When dborigin='/LO' then do
- parse var parms dbsource dbpath dbsize'!'dblogsw'!'dbuc'!'dbtest?'!'dbsession'!'dbdfile'!'dbvars
- thisfile=dbme'.KEX' /*NC*/
- if dbscreens=1 then parse value db3logo() with dbtrc dbtrap
- if dbtrc=-7 then return -7 dbtrap
- parse value db3guide() with dbtrc dbtrap
- if dbtrc=-7 then return -7 dbtrap
- parse value db3files(parms) with dbtrc dbtrap; end
- When dborigin='/IN' then parse value db3input(parms) with dbtrc dbtrap
- otherwise
- Parse Value rdbvars() with dbtrc dbtrap
- interpret dbtrc dbtrap
- parse value db3files('I' dbsize'!'dblogsw'!'dbuc'!'dbtest?,
- '!'dbsession'!'dbdfile'!'dbvars) with dbtrc dbtrap
- end
- if dbtrc=-7 then return -7 dbtrap
-
- /*Exit*/ Return dbtrc dbtrap ; db3FILES:
- parse arg dbsource dbpath dbsize'!'dblogsw'!'dbuc'!'dbtest?'!'dbsession'!'dbdfile'!'dbvars
- rexxver=''
- dbs='.'
- dbcs 'SCR1'
- dbtest?=strip(dbtest?)
- off='OFF'
- select
- when dbsource='R' then call db3init
- when dbsource='D' then call db3debug
- when dbsource='C' then call db3refresh
- when dbsource='U' then call db3cmds
- when dbsource='I' then call db3xeditscr
- otherwise nop
- end
-
- dbxx dbpath''dbsession '(PROF RDPROFIL'
-
- dbcs 'MSGM' off
- if dbsource='R' then do
- ':1SET CURL ON M'; end
- else do
- ':1SET CURL ON -2'; end
-
- dbce '/RESER/FN/FT'
- dbmenu=''
- dbcs 'PREF OFF'
- signal off error
- dbcs 'STATUSL ON' /*NC*/
- if dbsource ='R' then
- dbcs 'RESER 1 REVERSE File ' left(fname.1''dbs''ftype.1,14),
- 'rDEBUG, the REXX Debugger ' left(dbmenu,20) 'Help'
- else dbcs 'RESER 1 REVERSE File View Run Debug Watch Controls Options Tools Help'
- signal on error
- dbcs 'COLOR F BLACK ON WHI'
- dbcs 'COLOR CU YE ON WHI'
- dbcs 'COLOR C BLA ON WHI'
- dbcs 'COLOR MSGL YE ON WHI'
- dbcs 'COLOR TO BLA ON WHI'
- dbcs 'COLOR A YE ON WHI'
- dbcs 'IMPMAC ON'
- dbcs 'TOFEOF OFF' /*NC*/
- dbcs 'MSGM ON'
- dbcs 'SCR2'
- dbc 'BOT'
- ':1SOS TABCMDF'
-
- dbxx dbpath''dbdfile '(PROF RDPROFIL'
-
- ':'dbsize+2 'DEL *'
- ':1SET CURL ON M'
- dbcs 'MSGM' off
- dbcs 'AUTOS OFF'
- dbcs 'TOFEOF OFF' /*NC*/
- dbcs 'IMPMAC ON' /*NC*/
- dbce '/LSCR'
- dbcs 'PREF OFF'
- dbcs 'COLOR * DEFAULT'
- dblscr=lscreen.2
- dbcs 'MSGM' off
- dbce '/RESER' /*NC*/
- dbcs 'V6' dblscr+6
- dbcs 'STATUSL OFF' /*NC*/
- dbcs 'RESER -1 REVERSE rDEBUG F1=Help F4=Output F5=Go F6=Next F7=Go-Cursor F8=Step F9=Tog B/P F10=Proc'
- dbcs 'MSGM ON'
-
- if dblogsw=0 then dbcs 'SCR1'
-
- return 0; dbmsg;
-
- db3cmds:
-
- return 0; db3INIT:
-
- return 0; db3DEBUG:
-
- return 0; db3REFRESH:
-
- return 0; db3XEDITSCR:
- dbce '/STATUSL' /*NC*/
- if statusline.1='ON' then dbtest?=0; /*NC*/
- else dbtest?=1 /*NC*/
-
- return 0; db3LOGO:
- dbcs 'SCR1'
- dbxx thisfile '(NOPROF'
- dbcs 'RESER 1 .'
- dbcs 'RESER -1 .'
- dbcs 'PREFIX OFF'
- dbcs 'COLOR CU BRI C ON BLU'
- dbcs 'STATUSL OFF' /*NC*/
- dbcs 'ARR OFF' /*NC*/
- dbc 'BOT'
- '-20'
- dbcs 'MSGM OFF'
- dbc 'ALTER * 176 11 *' /*NC*/
- dbcs 'MSGM ON'
- '+9'
- dbc 'REFRESH'
- if dbsys='OS2' then dbc 'READV KEY'
- else
- Do 10
- Call delay '0.5'
- ans=inkey('N')
- If ans==' ' Then Leave
- If ans<>'' Then Leave
- End
- 'QQ'
- dbc 'MSG Please wait'
- dbc 'REFRESH'
-
- return 0; CLEARKEY:
-
- return 0; db3GUIDE:
- parse value rdbHELP('/PANEL G S 1') with dbtrc dbtrap
-
- return 0; db3INPUT:
- arg dbinclude
- parse value 0 1 with rc dbread?
- dbinput='2 RESTART 2 MSAVE 2 SAVE 2 READ 1 XEDIT 1 KEDIT 2 OUTPUT'
- signal off notready
- do forever
- If lines(dbinclude)=0 then do; dbread?=0; leave; end
- dbmessage=linein(dbinclude)
- Parse upper var dbmessage db1 dbmessage
- if db1='*' then iterate
- dbi=pos(' 'dbinput,' 'db1)
- if dbi=0 then leave
- if length(db1)<substr(dbinput,dbi-2,1) then leave
- end
- signal on notready
- if dbread?=0 then do
- call lineout(dbpath''dbinclude)
- return 0; end
- else return 1 db1 dbmessage
-
- Return dbrc;
- ERROR: return db9trap(sigl 80e) sourceline(sigl)
- FAILURE: return db9trap(sigl 80f) sourceline(sigl)
- HALT: return db9trap(sigl 80h)
- NOTREADY: return db9trap(sigl 80r) sourceline(sigl)
- NOVALUE: return db9trap(sigl 80v)
- SYNTAX: return db9trap(sigl 80e) errortext(rc)'~'sourceline(sigl)
- db9TRAP:
- if dbtrc=-7 then dbtrapp=dbtrap
- parse arg dbsigl dbtcode dbtrest
- dbtrap = 0 dbme dbsigl dbtcode dbmsg rdbmsg(dbtcode dbme dbsigl) dbtrest
- dbtrc=-7
- return -7 dbtrapp dbtrap
- /*
-
-
-
-
-
-
-
- ********* ********** ********* ** ** *********
- ** ** ** ** ** ** ** **
- ** ** ** ** ** ** ** **
- ** ** ** ** ******** ******** ** ** ** *****
- **** ** ** ** ** ** ** ** ** **
- *** ** ** ** ** ** ** ** ** **
- ** ** ** ** ** ** ** ** ** **
- ** ********* ********** ********* ******** ********
-
-
- an Integrated Development Environment for REXX
-
-
-
- (c) 1992, All rights reserved J Gil Gagnon & Associates, Inc
- 814-25 Glenn Hawthorne, Blvd Mississauga, Ontario L5R 3E6
-
-
- Please press any key to continue
- */
-