home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 18 REXX
/
18-REXX.zip
/
rdebug21.zip
/
RDBEND.KEX
< prev
next >
Wrap
Text File
|
1993-03-25
|
7KB
|
225 lines
/*H* RDBEND.KEX 02-10-93 12:22*/
parse arg origin path dfile'!'uc size macro? alt source'!'prgm'!'invoke'!'fileid'!'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!COMMAND INPUT' With cs'!'ce'!'ci
Parse Value 'COMMAND!COMMAND SOS!COMMAND X' With c'!'so'!'xx
ce '/OPSYS'
dbme='rdbEND'
dbsys=opsys.1
if dbsys='OS/2' then Parse Value 'CMD' 'OS2' With dbcommand dbsys /*O*/
address KEDIT /*NC*/
dbeditor='KEDIT' /*NC*/
Parse Value 0 With dbtrc dbtrap dbtrapp dbmsg
if origin='?' then return tell(dbme);
source=strip(source)
parse var source prgm'.'ft; /*NC*/
Parse Value 0 path'SESSION.LOG' With src session msg
xx path''dfile '(PROF RDPROFIL'
parse value 0 '' with src msg
Parse Value 0 With dbtrc dbtrap dbtrapp dbmsg dbtcode
if origin='' then origin='/EXIT'
select
when origin='/RS' then call option_restart
when origin='/OP' then call option_open
when origin='/SAVE' then do
Call save
src=1; end
when origin='/SAVEAS' then do
Call save
src=1; end
when origin='' then do
Call get_parms
if dbtrc=-7 then return -7 dbtrap
Call save
src=1; end
when origin='/EXIT' then call option_exit
otherwise nop
end
if dbtrc=-7 then return -7 dbtrap
if src=0 then call close
if dbtrc=-7 then return -7 dbtrap
/*exit*/ return src msg;
OPTION_RESTART:
parse value modified() with dbtrc dbtrap
if dbtrc=-7 then return -7 dbtrap
if dbtrc then do
Call save
if dbtrc=-7 then return -7 dbtrap
Call invoke 1
end
parse value rdbtask('* P 3' parms) with dbtrc dbtrap
if dbtrc=-7 then return -7 dbtrap
parse value dbtrc dbtrap with dialog.2 dialog.1
parms=dialog.1;
Call invoke 1
return; OPTION_OPEN:
parse value rdbtask('* P 7') with dbtrc dbtrap
if dbtrc=-7 then return -7 dbtrap
parse value dbtrc dbtrap with dialog.2 dialog.1
if (dialog.1='')+(dialog.1='OK')+(dialog.2='CANCEL') then src=1
else do
prgm=dialog.1
dbi=pos('.',prgm) /*NC*/
if dbi>1 then do /*NC*/
dbft=substr(prgm,dbi+1) /*NC*/
prgm=left(prgm,dbi-1) /*NC*/
dblist='REX 0 CMD 0 KEX 1 EXEC 0 XEDIT 1' /*NC*/
dbmacro?=word(dblist,wordpos(dbft,dblist)+1) /*NC*/
end /*NC*/
parse value modified() with dbtrc dbtrap
if dbtrc=-7 then return -7 dbtrap
if dbtrc then do
Call save
if dbtrc=-7 then return -7 dbtrap
end
parse value rdbtask('* P 6') with dbtrc dbtrap
if dbtrc=-7 then return -7 dbtrap
parse value dbtrc dbtrap with dialog.2 dialog.1
parms=dialog.1;
src=0
Call invoke 1
end
return; OPTION_EXIT:
mrc=modified()
if dbtrc=-7 then return -7 dbtrap
src=mrc
if mrc=10 then do
src=0
c 'msg' rdbmsg(220)
Call save; end
return; CLOSE:
/* check out further
signal on syntax name ok
call vexit
ok:
*/
xx path''session '(NOPROF'
c 'FFILE'
xx fileid '(NOPROF'
if macro? then cs ' SCR 1'
else 'QQUIT'
xx path'include.log' '(NOPROF'; 'QQUIT'
xx path''invoke '(NOPROF'
if origin='/SAVE' then do
cs 'SCR 1'
return; end
else do
if dbsys='OS2' & origin='/RS' then 'QQUIT' /*O*/
ce '/NBF'
if nbfile.1>0 then c 'MSG' rdbmsg(190 nbfile.1 'remaining files')
end
return 0; INVOKE:
arg module
if macro? then parse value 'MACRO' with host w1
else parse value 'MACRO' 0 with host w1
/* if module=1 then parse value 'rDEBUG' 'queue' host with module host*/
if module=1 then parse value 'rDEBUG' host with module host
else parse value 'D'left(prgm,7) with module host w1 prgm
msg=host module w1 prgm parms;
return 0; MODIFIED:
mrc=0
ce '/ALT';
if alt.1>alt then do;
mrc=1
end;
if origin<>'/EXIT' then return 1
if prgm='DEMO' then return 0
parse value rdbtask('* P 2') with dbtrc dbtrap
if dbtrc=-7 then return -7 dbtrap
dialog.2=dbtrap
if dialog.2="YES" then mrc=10
if dialog.2="NO" then mrc=0
if dialog.2="CANCEL" then mrc=1
return mrc; SAVE:
ce '/FN/FT'
table.=''
if dbsys='CMS' then back=strip(prgm)' BACKUP'
else back=strip(prgm)'.BAK'
signal off error
':1SSAVE' path''dfile
xx path''source '(NOPROF'
c 'SSAVE' path''back
':0DEL *'
':0 GET' path''dfile 1 size
cs 'LINEN OFF'
cs 'ARBCH ON ~'
cs 'MSGM OFF'
cs 'WRAP OFF'
":1CH! /*Exit*/ Return ! Exit !**"
":1CH!Call DBSAY!Say!**"
call db8change "!/*trace!trace!"
call db8change "!Call DBPULL 'pu!Parse Upper Pull!"
call db8change "!Call DBPULL 'pp!Parse Pull!"
call db8change "!Call DBPULL 'p!Pull!"
address value dbeditor
dbcodes='B E S D' /!1 see below*/
':1EXT /CURL'
i=pos(' 1:', curline.3)
j=pos(';;;', curline.3)
if j-i-3>0 then c 'REP' substr(curline.3,i+3,j-i-3)
do x=2 to size
c '+1EXT /CURLINE'
parse upper var curline.3 call opt .
curline.3=substr(curline.3,uc)
opt=left(opt,5)
c 'REP' curline.3
if (opt='DEBUG')+(call<>'CALL')>0 then iterate
no=x%42+1
opt=substr(curline.3,6,1)
if pos(opt,dbcodes)>0 then table.no=table.no x opt
end;
c ":1CH!;;;DB~!!**"
c ":1CH! ; !;!**"
cs 'MSGM ON'
cs 'WRAP OFF'
c 'FFILE' source
msg=rdbmsg(982 source)
signal on error
return 0; db8CHANGE:
parse arg string
parse arg '!' target '!' new '!'
parse arg . key .
c ':0'
do Forever
c 'LOC !'target
if rc<>0 then leave
c 'CH' string
if key = 'DBPULL' then c "CH !'!!" /*NC*/
if string= '!/*trace!trace!' then c "CH !*/!!"
'+1'
if rc<>0 then leave
end
return 0; GET_PARMS:
Parse Value rdbvars() with dbtrc dbtrap
if dbtrc=-7 then return -7 dbtrap
interpret dbtrc dbtrap
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