home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Professional
/
OS2PRO194.ISO
/
os2
/
prgramer
/
rexx
/
rdebug
/
rdbinit.kex
< prev
next >
Wrap
Text File
|
1993-03-25
|
6KB
|
211 lines
/*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
*/