home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 18 REXX
/
18-REXX.zip
/
rdebug21.zip
/
RDBTASK.KEX
< prev
next >
Wrap
Text File
|
1993-03-25
|
7KB
|
264 lines
/*H* RDBTASK.KEX 02-15-93 10:08*/
arg dborigin .
arg . code1 code2 initial
Signal On Error; Signal On Failure; Signal On Halt
Signal On Novalue; Signal On Notready; Signal ON Syntax
call dbtinitial
if dbtrc=-7 then return -7 dbtrap
Parse Value strip(code1)''strip(code2) With code
parse value db3task(code) with dbtrc dbtrap
if dbtrc=-7 then return -7 dbtrap
signal off novalue
job=task.code
signal on novalue
if left(job,5)='TASK.' then do
dbc 'EMSG' rdbmsg(104 code2)
return 0; end
parse var job code code2 statement
if code2 = 'DIALOG' then do
dbce '/VERSION'
if version.2 >= 5.00 then do
signal off error
code2 statement
signal on error
signal off novalue
if dialog.1='DIALOG.1' then dialog.1=''
if (dialog.2="OK")|(dialog.2="YES")|(dialog.2="NO")+(dialog.2="CANCEL")>0
then if dialog.1 <>'' then answer=dialog.1
else answer=dialog.2
else answer=dialog.1
signal on novalue
if dialog.2='CANCEL' then parse value 'CANCEL' 'CANCEL' with code answer
Parse Value answer '' With code2 statement; end
else do
parse value statement with '/' prompt '/' .
'EMSG' prompt
parse value 'NO' with code2 code
parse value rdbui(1) with dbtrc dbtrap
if dbtrc=-7 then return -7 dbtrap
statement=dbtrc dbtrap
if statement<>'' then code2='OK'; end
end
if code = '*' then do
if code2='*' then 'emsg' rdbmsg(999 job statement)
else do
parse var job . statement
interpret statement; end
return 0; end
if code=1 then do
parse var job . . rest
code=''
interpret 'statement='rest
if statement='*' then do;
dbc 'EMSG' rdbmsg(711)
return 0; end
end
answer=code code2 statement
if code1='P' then return answer
if dbtrc=-7 then return -7 dbtrap
dbso 'QCMND'
dbc 'TEXT' answer
/*Exit*/ Return leave?
db3TASK:
arg code
first=left(code,1)
part1=' DIALOG /Enter new value / TITLE /'
partf=' DIALOG /Enter filename / TITLE /'
part2='/ EDITFIELD /' initial '/'
signal off novalue
signal off syntax
signal value 'T'first
signal on novalue
signal on syntax
'EMSG rdbTASK Invalid selection:' right(code,1)
if dbtrc=-7 then return -7 dbtrap
/*Exit*/ Return 0
TF:
task.FN='* * **'
task.FO='OPEN'
/* partf 'File Open ' part2 */
task.FS="SAVE"
task.FA="SAVE",
' ' partf 'save As' part2
task.FP="PRINT"
task.FE="EXIT"
return 0
TV:
dbce '/SCR'
parse var screen.1 . size .
if (size< 13) then
task.VZ="* 'set screen 1'"
else
task.VZ="UNZOOM"
task.VS='* "SOS TABCMDF" '
task.VO="OUTPUT"
task.VM='* "SOS TABCMDF" '
task.VH='* "rgtleft" '
task.VR="REFRESH"
return 0
task.SF='* "/"! Enter function name'
task.SC='* "c/"! Enter item to change'
/* see xui f3
task.SR='* "/"'
*/
return 0
TS:
task.SF='* "/"! Enter function name'
task.SC='* "c/"! Enter item to change'
/* see xui f3
task.SR='* "/"'
*/
return 0
TR:
task.RS='GO 1'
task.RR='RESTART'
dbce '/LINE'
go="GO -2" line.1
task.RG= go
rc='RC'
task.RC='GO'
return 0
TC:
task.CB='BREAK'
task.CE='EXCLUDE'
task.CS='SKIP'
task.CD='DEBUG'
return 0
TD:
task.DS='GO 0'
task.DP="GO -1"
task.DT='TRACE -1'
task.DB='BREAK -1'
task.DA="BREAK 0"
task.DN='NEXT'
return 0
TX:
task.XD='* * * Display... **'
task.XH='* * * Help Path... **'
task.XS='* * * Syntax Checking**'
return 0
TO:
task.OS='Switches'
task.OF='FULL -1'
task.OE='ERROR -1'
task.OL='LOG -1'
task.OT='TRACE -1'
task.OA='TALLY -1'
task.OW='WATCH -1'
task.OC='COUNT',
' DIALOG /Enter new count limit / TITLE / Change Count ' part2
task.OI='WAIT',
' DIALOG /Enter new delay factor / TITLE / Change Wait ' part2
return 0
TW:
task.WA='WATCH',
' DIALOG /Enter variable name / TITLE / Add watch ' part2
task.WB='1 WATCH wordatcursor()'
task.WS='1 SAY wordatcursor()'
task.WT='1 SAY wordatcursor()'
task.WD='DISCARD',
' DIALOG /Enter variable name / TITLE / Drop watch ' part2
task.WS='SHOWWATCH'
task.WE='watch'
task.WR='WATCH -2'
return 0
TT:
task.TC='CASE'
task.TA='DBCALLSTACK'
task.TE='ENV'
task.TF='RING'
task.TI='INDENTATION'
task.TP='PROFILER'
task.TM='MATCH'
task.TS='STRUCTURE'
task.TY='SYNTAX'
task.TX='XREF'
return 0
TH:
helppf="* parse value rdbHELP('/PANEL"
helpsf="1') with dbtrc dbtrap ;"
task.HI=helppf 'I H' helpsf
task.HC=helppf 'C H' helpsf
task.HT=helppf 'T H' helpsf
task.HU=helppf 'U H' helpsf
task.HA=helppf 'A H' helpsf
return 0
T1:
task.1N='NEW' partf 'File New ' part2
task.1O='OPEN' partf 'File Open ' part2
task.1S='SAVE'
task.1A='SAVEAS' partf 'save As ' part2
task.1P='PRINT'
task.1C='DONE'
task.1E='EXIT'
return 0
T2:
task.2N='NEW'
task.2S='SAVE'
task.2A='SAVEAS',
' ' partf 'save As ' part2
task.2P='PRINT'
task.2C='DONE'
task.2R='RERUN'
task.2E='EXIT'
return 0
T3:
task.3N='NEW'
task.3S='SAVE'
task.3P='PRINT'
task.3C='DONE'
task.3E='EXIT'
return 0
T4:
task.4S='SAVE'
task.4A='SAVEAS',
partf 'save As ' part2
task.4C='DONE'
task.4E='EXIT'
return 0
TP:
task.P1='. DIALOG /Enter parameters if necessary / TITLE /',
' Program parameters / EDITFIELD /'
task.P2='. DIALOG /Exit rDEBUG and save changes? / TITLE / Exit? / YESNOCANCEL'
task.P3='. DIALOG /Enter new parameters if necessary / TITLE / Restart' part2
task.P4='. DIALOG /Exit rDEBUG? / TITLE / Exit? / OKCANCEL'
task.P5='. DIALOG /Unable to RERUN - backup of previous source and/or profile missing / TITLE / Rerun? / OK'
task.P6='. DIALOG /Enter parameters if necessary / TITLE / Open' part2
task.P7='. DIALOG /Enter program name / EDITFIELD /'
return 0
WORDATCURSOR:
parse value rhypertx('/RDEBUG') with dbtrc dbtrap
if dbtrc=-7 then return -7 dbtrap
return dbtrc
Return word
dbtINITIAL:
Parse Value 'COMMAND SET!COMMAND X!COMMAND EXT' With dbcs'!'dbxx'!'dbce
Parse Value 'COMMAND!COMMAND SOS' With dbc'!'dbso
Parse Value 0 With dbtrc dbtrap dbtrapp dbmsg
dbce '/OPSYS'
Parse Value 'rdbTASK' opsys.1 With dbme dbsys
if dbsys='OS/2' then dbsys='OS2' /*O*/
Parse Value 0 1 0 With dbtrc leave? menu? selection
if code1='' then Exit tell(dbme)
if dborigin='?' then Exit tell(dbme)
Return 0
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