home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Professional
/
OS2PRO194.ISO
/
os2
/
prgramer
/
rexx
/
rdebug
/
rdxgen.kex
< prev
next >
Wrap
Text File
|
1993-03-25
|
4KB
|
158 lines
/*H* RDXGEN.KEX 02-09-93 10:51*/
trace o?r /*T*/
arg dborigin dbtarget dbpullsay dbfullsw dbmacro? dbtest? dbdfile dbrun dbsize
arg . dbrun2 dbtarget2 dbbbs dbpath
if dbtarget='(PROF' then
parse value dosenv('RDPARMS') with dborigin dbrun2 dbtarget2 dbbbs? dbpath
'@set rdparms=' files.i target dbbbs? drive''directory'\'
Parse Value 'COMMAND SET!COMMAND EXT' With dbcs'!'dbce
Parse Value 'COMMAND!COMMAND SOS!COMMAND X' With dbc'!'dbso '!'dbxx
dbcs 'MSGM OFF'
dbme='rdxGEN'
dbce '/OPSYS'
dbsys=opsys.1
if dbsys='OS/2' then dbsys='OS2' /*O*/
address KEDIT
dbcomment=space('/ * !',0)
select
when dborigin='/CODE' then call dbget_code
when dborigin='/GEN' then do
call dbgen_system dbrun2 dbtarget2 dbbbs?
dbc 'FFILE' dbpath; end
otherwise do
Parse Value rdbvars() with dbtrc dbtrap
if dbtrc=-7 then return -7 dbtrap
interpret dbtrc dbtrap
dbtarget=dbsys
dbpullsay=1
call dbget_code
end
end
exit 0
DBGET_CODE:
dbxx dbrun
dbcs 'MSGM ON'
dbc 'MSG Please wait'
dbc 'REFRESH'
dbcs 'MSGM OFF'
dbc 'BOT'
list=''
if dbsys='DOS' then do
if dbsize < 200 then list=list '\RDEBUG\RDBUI.KEX'
/*
if dbsize < 400 then list=list '\RDEBUG\RDBMENU.KEX'
if dbsize < 600 then list=list '\RDEBUG\RDBTASK.KEX'
*/
if list<>'' then call assemble list
end
if dbsys='OS2' then call assemble ,
' \RDEBUG\RDBCMDS.KEX \RDEBUG\RDBUI.KEX \RDEBUG\RDBUIEXT.os2',
' \RDEBUG\RDBMENU.KEX \RDEBUG\RDBTASK.KEX \RDEBUG\RDBMISC.KEX',
' \RDEBUG\RDBPROF.KEX'
if dbsys<>'CMS' then if dbpullsay then call assemble '\RDEBUG\RDBIO.OS'
if dbtest?=0 then call delete_sys /*?F*/
call deletecode /*?F*/
':0PUT *' dbdfile
Return; DELETECODE:
':'0
dbcs 'MSGM OFF'
if dbtest? then nop
else do
If dbmacro? Then nop
Else Call db72delete '/*M*/'
/* DELETE AFTER TESTING
If dbfullsw=0 Then Call db72delete '/*F*/'
*/
Call db72delete dbcomment
end
dbcs 'MSGM ON'
Return 0; DB72DELETE: Parse Arg tag
dbce '/LINE'
Do Forever
sline=line.1
'-1 LOC `'tag'`'
If rc <> 0 Then Leave;
dbce '/LINE'
If line.1<sline Then Leave;
Else Do
If tag = dbcomment Then Do
dbce '/CURL'
i=pos(tag,curline.3)
If i>3 Then dbc 'REP' substr(curline.3,1,i-1);
Else dbc 'DEL'; End
Else dbc 'DEL'
End
End
':'0
return 0; ASSEMBLE: arg list
dbcs 'WRAP OFF'
dbcs 'MSGM OFF'
do n=1 to words(list)
dbc 'BOT'
dbce '/LINE'
file=word(list,n)
i=lastpos('\',file)
j=lastpos('.',file)
prgm=substr(file,i+1,j-i-1)
ext=substr(file,j+1)
if ext='KEX' then procedure='Procedure Expose dbsize'
else procedure=''
dbc 'INPUT' prgm':' procedure
dbc 'GET' file
':'line.1
dbc 'FIND ERROR:'
if rc=0 then dbc 'DEL *'
end
dbcs 'MSGM ON'
return 0
DBGEN_SYSTEM:
arg dbrun dbtarget dbbbs?
dbce '/FN/FT'
if dbtarget='' then dbtarget=dbsys
dbbbs?=(dbbbs?=1)
if dbbbs?=1 then do
dbfullsw=1
dbtest?=0; end
else do
dbfullsw=1
dbtest?=0; end
dbmacro?=1
if dbtarget='ALL' then nop
else do
call deletecode
call delete_sys; end
Return;
DELETE_SYS:
dbmark=' /*'
select
when dbtarget='ALL' then nop
when dbtarget='OS2' then do
Call db72delete dbmark'C*/'
Call db72delete dbmark'D*/'
Call db72delete dbmark'NO*/'
end
when dbtarget='DOS' then do
Call db72delete dbmark'C*/'
Call db72delete dbmark'O*/'
Call db72delete dbmark'ND*/'
end
when dbtarget='CMS' then do
Call db72delete dbmark'D*/'
Call db72delete dbmark'O*/'
Call db72delete dbmark'NC*/'
end
otherwise
dbc 'EMSG Invalid target system code:' dbtarget ', press any key to abort'
dbc 'READV KEY'
exit
end
Return;