home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 18 REXX
/
18-REXX.zip
/
rdebug21.zip
/
RDBCMDS.KEX
< prev
next >
Wrap
Text File
|
1993-03-25
|
9KB
|
294 lines
/*H* RDBCMDS.KEX 02-11-93 10:53*/
Signal On Error; Signal On Failure; Signal On Halt
Signal On Novalue; Signal On Notready; Signal ON Syntax
Parse Value 'COMMAND SET!COMMAND X!COMMAND EXT' With dbcs'!'dbxx'!'dbce
Parse Value 'COMMAND!COMMAND SOS' With dbc'!'dbso
dbce '/FN/OPSYS'
Parse Value 'RDBCMDS' opsys.1 With dbme dbsys
if dbsys='OS/2' then dbsys='OS2' /*O*/
parse arg dbw1 dbn dbfullsw dbpath
arg dborigin .
Parse Value 0 With dbtrc dbtrap dbtrapp dbmsg
exitstr="rdbmisc('/EXIT' dbpath dbdfile'!'dbinvoke"
initstr="* parse value RDBINIT('/FI C' dbpath dbsize'!'dblogsw'!'dbuc'!0'",
"'!'dbsession'!'dbdfile'!UNZOOM') with dbtrc dtrap;"
dbstr="* dbstr;"
sourcestr=,
"dbxx dbpath''dbsource '(PROF RDPROFIL' ;"
tools="*" sourcestr "'macro'"
definequit=""
dbprefix="parse value"
dbsuffix="dbstr) with dbtrc dbtrap; if dbtrc=-7 then return -7 dbtrap"
variable= "dbmsg='key =' key"
dbprefixsw= "* parse value rdbprof('/SETSW'"
dbprefixctl="* trace 'o?r'; parse value rdbprof('/SETCTL'"
dbswitches="dbfullsw dberrorsw dblogsw dbtracesw",
" dbtallysw dbwatchsw dblimit dbwait dbwatch "
dbsuffixsw="dbtrigger dbpath dbsize dbdfile'!'dbprof'!'dbuc'!'" dbswitches,
"'!'" dbsuffix "; parse value dbtrap with" dbswitches"'!'dbmsg"
finis=,
" with dborigin . dbw2 dbrem ;",
" if dbw2<>''then dbparms=dbw2 dbrem ;",
" dbsourc=dbsource ;",
" if dborigin='SAVEAS' then dbsourc=dbw2 dbrem ;",
" parse value RDBEND('/'dborigin dbpath dbdfile'!'dbuc dbsize dbmacro? ",
" dbalt dbsourc'!'dbprgm'!'dbinvoke'!'dbfileid'!'dbparms) ",
" with dbtrc dbtrap ;",
" if dbtrc=0 then do ;",
" queue dbtrap ;",
" exit ;end ;",
" dbmsg=dbtrap ;",
";"
dbmsg=''
select
When dborigin='?' then return tell(dbme)
When dborigin<>'' then dbcmdstr= dbcmds( dbw1 dbn dbfullsw)
otherwise return tell(dbme)
end
parse value dbcmdstr with dbtrc dbtrap
if dbtrc=-7 then return -7 dbtrap
if dbmsg<>'' then 'MSG' dbmsg
if dbcmdstr=0 then dbn=''
return dbn dbcmdstr
DBJUMP:
arg dbn
if dbw1< 'G' then part=1
else if dbw1< 'N' then part=2
else if dbw1< 'S' then part=3
else part=4
signal value 'C'dbn''part
DBCMDS:
arg dbw1 dbn dbfullsw .
do 3
call dbjump dbn
if dbtrc=-7 then return -7 dbtrap
if getcmd()=0 then do
if dbtrc=-7 then return -7 dbtrap
dbn=dbn+1
end
end
return dboutput
GETCMD:
if dbn=3
then dbi=wordpos('$'dbw1,dblist.dbn);
else dbi= pos('$'dbw1,dblist.dbn);
if dbi>0 then do
dbcmdstr=substr(dblist.dbn,dbi,pos('$',dblist.dbn,dbi+2)-dbi);
if dbtrc=-7 then return -7 dbtrap
parse var dbcmdstr . dbast dbcmd
if dbast='F' then do
dbfullsw=1 /* test thoroughly & remove this line*/
if dbfullsw then
parse var dbcmdstr . . dbast dbcmd
else dbcmdstr="'dbmsg='dbmsg rdbmsg(998 '-' dbw1)" /*F*/
end
if dbast='F' then dbast='' /* see above */
if dbast='*' then dboutput=dbcmd
else dboutput=dbprefix dbast dbcmd dbsuffix
end
else dboutput=0
return dboutput
C11:
DBLIST.1=,
"$CANCEL F" exitstr "'! 0 QQUIT'",
"$CASE F" tools "'RCASE';" definequit "; ",
"$*****CALL F * call db3show dbcallstack",
"$COUNT " dbprefixctl "'LIMIT'" dbsuffixsw,
"$DISCARD F * parse value rdbmisc('/DROP' dbstr'!'dbwatch) with",
" dbwatch'!'dbmsg",
"$ERROR F" dbprefixsw "'ERROR'" dbsuffixsw,
"$ENVIRONMENT F *" sourcestr "macro rdINFO;",
"$EXIT * do; parse value 'EXIT' dbstr" finis "end",
"$FULL " dbprefixsw "'FULL'" dbsuffixsw,
"$1FFILE " exitstr "'! 1 FILE'",
"$FFILE " exitstr "'! 1 FFILE'",
"$FILE " exitstr "'! 1 FILE'",
"$ "
return 0
C12:
DBLIST.1=,
"$GT * dbgt=(dbgt=0)",
"$HELP rdbhelp( ",
"$INDENTATION F" tools "'RPP';" definequit "; ",
"$KEDIT * dbstr /*NC*/ ",
"$LASTMSG * dbmsg=dblastm",
"$MATCH F" tools "'RMATCH';" definequit "; ",
"$ "
return 0
C13:
DBLIST.1=,
"$OUTPUT F * dbfc?=1; if dbinside? then dbxx dbpath''dbuser '(PROF RDPROFIL';",
" else dbxx dbpath''dbdfile '(PROF RDPROFIL'",
"$PRINT *",
" if dbw2='' then do ;",
" dbw1=db8thisfile() ;",
" dbxx dbpath''dbsession '(PROF RDPROFIL';",
" 'SSAVE' ;",
" dbxx dbpath''dbw1 '(PROF RDPROFIL';",
" dbw2=dbpath''dbsession; end ;",
" 'DOSN COPY' dbw2 dbprinter ;",
"$PROFILER F *" sourcestr ,
" ':0 MSGM OFF';",
" 'PREFIX ON LEFT';",
" 'NUM ON';",
" do dbx=1 to dbsize; '+1 CI' right(db.dbx,4)' ';end;",
" ':1 FT' left(dbdfile,4);",
" ':1 FN PROFILER';" definequit "; ",
"$QQUIT " exitstr "'! 1 QQUIT'",
"$QUIT " exitstr "'! 1 QUIT'",
"$RDEBUG * dbmsg=dbmsg rdbmsg(330);",
"$REFRESH F" initstr ,
"$RING F * dbc 'QUERY RING'",
"$RUN * dbmsg=dbmsg rdbmsg(330);",
"$ "
return 0
C14:
DBLIST.1=,
"$SAVE F * trace o?r; if db8thisfile()<> dbpath''dbdfile then dbc 'SAVE'; ",
" else do; parse value 'SAVE' dbstr" finis "end",
"$SAVEAS F * if db8thisfile()<> dbpath''ddbdfile then dbc 'SAVE' dbw1 dbw2; ",
" else do; parse value 'SAVEAS' dbstr" finis "end",
"$SHOW *" variable ,
"$SHOWWATCH * do dbi=1 to words(dbwatch); db1=word(dbwatch,dbi) ;",
" db1=word(dbwatch,dbi); dbw=db1 ;",
" if left(db1,1)='(' then interpret 'db1=' dbw ;",
" dbmsg=dbmsg dbw'='value(db1)';'; end ;",
"$STRUCTURE F" tools "'RSTRUC'; dbcs 'SHAD OFF';" definequit "; ",
"$SWITCHES * dbmsg='Fullsw' dbfullsw 'Errorsw' dberrorsw 'Logsw'",
" dblogsw 'Tracesw' dbtracesw 'Tallysw' dbtallysw 'Watchsw' dbwatchsw",
"$SYNTAX F" tools "'RSYNTAX';" definequit "; ",
"$TEST db3test(",
"$UNZOOM F" initstr ,
"$WATCH " dbprefixctl "'WATCH'" dbsuffixsw,
"$XEDIT * dbstr",
"$XREF F" tools "'RXREF';" definequit "; ",
"$ "
return 0
C21:
DBLIST.2=,
"$BREAK db4prefix('BREAK'",
"$DEBUG db4prefix('DEBUG'",
"$EXCLUDE db4prefix('EXCLU'",
"$ "
return 0
C22:
DBLIST.2=,
"$GOTO * parse value 1 0 0 with dbw1 dbbreak? dbstep? ;",
" if dbw2='' then dbw1=1 ;",
" else do ;",
" if dbw2<1 then do ;",
" if dbw2=0 then parse value 1 0 dbg with dbbreak? dbstep? dbg dbw2;",
" else if dbw2=-1 then Parse Value 1 1 dbg With dbbreak? dbstep? dbg dbw2;",
" else if dbw2=-2 then Parse Value dbrem 1 With dbresume dbg dbw2;",
" end ;",
" else dbg=dbw2 ;",
" if dbw2<>'' then dbw1=(db3back(dbg,,'G')<>0) ;",
" end ;",
"$LOG " dbprefixsw "'LOG'" dbsuffixsw,
"$ "
return 0
C23:
DBLIST.2=,
"$NEXT * call db3back dbg",
"$OPEN F * do; parse value 'OP' dbstr" finis "end",
"$RESTART F * do; parse value 'RS' dbstr" finis "end",
"$ "
return 0
C24:
DBLIST.2=,
"$SKIP db4prefix('SKIP'",
"$TALLY " dbprefixsw "'TALLY'" dbsuffixsw,
"$TRACE F " dbprefixsw "'TRACE'" dbsuffixsw,
"$WAIT " dbprefixctl "'WAIT'" dbsuffixsw,
"$ "
return 0
C31:
dblist.3=,
"$ADDRESS *" dbstr,
"$ARG *" dbstr,
"$CALL *" dbstr,
"$DO *" dbstr,
"$DROP *" dbstr,
"$EXIT *" dbstr,
"$ "
return 0
C32:
dblist.3=,
"$IF *" dbstr,
"$INTERPRET*" dbstr,
"$ITERATE *" dbstr,
"$LEAVE *" dbstr,
"$NOP *" dbstr,
"$NUMERIC *" dbstr,
"$ "
return 0
C33:
dblist.3=,
"$OPTIONS *" dbstr,
"$PARSE *" dbstr,
"$PULL *" dbstr,
"$PUSH *" dbstr,
"$QUEUE *" dbstr,
"$RETURN *" dbstr,
"$ "
return 0
C34:
dblist.3=,
"$SAY * dbcmsg=dbstr; dbstr",
"$SIGNAL *" dbstr,
"$ "
return 0
C51:
dblist.5=,
"$DB9PREFIX * dbstr.='' ;",
"dbcalls='BREAK EXCLU SKIP';",
" do dbz=1 to 24 ;",
" if dbtbl.dbz=''then iterate ;",
" do dby=1 by 2 to words(dbtbl.dbz) ;",
" dbi=wordpos(word(dbtbl.dbz,dby+1),dbcodes) ;",
" dbstr.dbi=dbstr.dbi word(dbtbl.dbz,dby) ;",
" end dby ;",
" do dbi=1 to 3 ;",
" if dbstr.dbi<>'' then do ;",
" call db43setcall word(dbcalls,dbi) '.' dbstr.dbi ;",
" if dbtrc=-7 then return -7 dbtrap; end ;",
" end dbi ;",
" end dbz ;",
" drop dbcodes dbcalls dbstr. dbi dby dbz ;",
"$ "
return 0
C71:
dblist.7=,
"$DB9SYN * ",
" parse value dbtrap with dbint dbxme dbsigl dbtcode dbtrap ;",
" if dbinside? then dbmsg=dbmsg dbstr ;",
" if dbcallstack<>'' then dbtrap=dbtrap rdbmsg(842 dbcallstack) ;",
" dbmsg=dbmsg dbtrtn dbtrap ;",
" Parse Value 0 With dbtrc dbtrapp 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