home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Professional
/
OS2PRO194.ISO
/
os2
/
prgramer
/
rexx
/
rdebug
/
rdbui.kex
< prev
next >
Wrap
Text File
|
1993-03-26
|
8KB
|
253 lines
/*H* RDBUI.KEX 02-15-93 11:07*/
Arg initcode initmenu initver '!' options
Arg restricted? '!' .
signal on error; signal ON FAILURE; signal on halt
signal ON NOVALUE; signal ON NOTREADY; signal ON SYNTAX
Call db29initial
if initcode='*' then call db30initmenu
if dbtrc=-7 then return -7 dbtrap
LOOP:
Do Forever
If w1 Then Leave
dbc 'READV KEY'
dbw1=readv.1
w1=0
if (readv.2>='A'& readv.2<='Z')|(readv.2 >='a'& readv.2<='z') then do
If menu? Then do
parse value db24second(first readv.2) with dbtrc dbtrap; w1=dbtrc
if dbtrc=-7 then return -7 dbtrap; end
Else 'TEXT' readv.2
iterate; end
dbw1=translate(readv.1,'_','-')
parse value db2cmd(5) with dbtrc dbtrap
if dbtrc=-7 then return -7 dbtrap
If dbtrc Then iterate
If restricted? Then nop
Else do
parse value db2cmd(6) with dbtrc dbtrap
if dbtrc=-7 then return -7 dbtrap
If dbtrc Then iterate
If dbsys ='OS2' then do /*O*/
parse value db2cmd(7) with dbtrc dbtrap /*O*/
if dbtrc=-7 then return -7 dbtrap /*O*/
If dbtrc Then iterate; end /*O*/
End
call db1writekey
End
EXIT:
dbso 'TABC'
dbcs 'INSERTM ON'
dbc 'TEXT NOMSG MSG '
dbso 'EX'
dbce '/LASTM'
signal OFF NOVALUE
parse upper var lastmsg.1 dbcommand rest
w1=0
if dbcommand='' then signal loop
if dbcommand='X' | dbcommand='K' then do
parms='PROF RDPROFIL'
if pos('(',rest)=0 then parms='('parms
lastmsg.1='XEDIT' rest parms; end
if dbtrc=-7 then return -7 dbtrap
dbc 'MSG .'
/*Exit*/ Return lastmsg.1
db1WRITEKEY:
dbcs 'MSGMODE OFF'
signal off error
dbc 'TEXT' readv.2
if rc<>0 then do
dbcs 'MSGMODE ON'
dbc 'EMSG rdbUI Unsupported key:' readv.1; end
dbcs 'MSGMODE ON'
signal on error
Return 0
DB2CMD:
Arg dbn
drop dbcmd
Signal Off Novalue; Signal Off Error; Signal Off Failure
dbcmd=m.dbn.dbw1
if left(dbcmd,2)<>'M.' then do
dbmsg=dbcmd
Interpret dbcmd
src=1; end
else src=0
Signal On Novalue; signal on error; Signal On Failure
if dbtrc=-7 then return -7 dbtrap
Return src
DB21GETMENU:
Arg dir
hor=hor+dir
If hor>words(menus) | hor<1 Then parse value hor-dir with hor
menu=word(menus,hor)
first=menu
parse value rdbmenu('/ME' menu ver options) with dbtrc dbtrap
if dbtrc=-7 then return -7 dbtrap
items=dbtrc dbtrap
ver=1
Return 0; DB22GETITEM:
Arg dir
ver=ver+dir;
if ver< 1 then dbso 'CU'
If ver>words(items) | ver<1 Then parse value ver-dir with ver
parse value db25menu('/ME' menu ver) with dbtrc dbtrap
if dbtrc=-7 then return -7 dbtrap
Return 0; DB23FIRST:
Arg key
Parse Value 0 initver 1 key key With leave? ver menu? first menu
parse value db25menu('/ME' menu ver) with dbtrc dbtrap
if dbtrc=-7 then return -7 dbtrap
Return leave?; DB24SECOND:
Arg code1 code2 .
dbc 'MSG .'
dbc 'REFRESH'
menu?=0
parse value rdbtask( . code1 code2) with dbtrc dbtrap
if dbtrc=-7 then return -7 dbtrap
task=dbtrc dbtrap
if initcode='*' then do
parse value db25menu('/ME' menu ver) with dbtrc dbtrap
if dbtrc=-7 then return -7 dbtrap; end
Return task; DB25MENU:
Arg . m ver .
parse value rdbmenu(. m ver options) with dbtrc dbtrap
if dbtrc=-7 then return -7 dbtrap
items=dbtrc dbtrap
hor=wordpos(m,menus)
Return 0; db27CURSOR:
arg dir inc rtn
dbce '/CURS';if cursor.3<>-1 then do
dbso dir
if menu? Then call db21getmenu 0
End
else if menu? then do
if rtn=21 Then do
ver=1
call db21getmenu inc; end
else call db22getitem inc
end
else dbso dir
Return w1; db28CLEARMENU:
dbce '/LSCR'
if lscreen.3<13 then dbscr=1; else dbscr=2
If dbscr=2 then do
dbso 'TABCMDB'; dbc 'MSG '
dbc 'BOT';
dbso 'TABCMDF'; end
else dbc 'MSG'
Return 0; db30INITMENU:
dbso 'TABC'
menus=initmenu
if initver<>'' then ver=initver
parse value db23first(initmenu) with dbtrc dbtrap
if dbtrc=-7 then return -7 dbtrap
if dbtrc=1 then signal exit
Return 0; DB29INITIAL:
dbc='COMMAND'
parse value dbc 'SET!'dbc 'X!'dbc 'EXT!'dbc 'SOS' With dbcs'!'dbxx'!'dbce'!'dbso
dbce '/OPSYS'
dbme='rdbUI'
dbsys=opsys.1
if dbsys='OS/2' then dbsys='OS2' /*O*/
Parse Value 0 With dbtrc dbtrap dbtrapp dbmsg
if initver='' then initver=1
restricted?=(restricted?=1)
Parse Value 'F 0 1 1 0' With first dbtrc ver hor menu? first menu. task.
Parse Value 'F' 0 '.' With menu w1 items
menus = 'F V R D W C O T H'
select1="parse value db23first(" '"'
select2="parse value db24second(" '"'
suffix='"' ") with dbtrc dbtrap; w1=dbtrc"
cursora="parse value db27cursor(" '"'
cursorb='"'") with dbtrc dbtrap;"
m.5.INS ="dbcs 'INSERTM TOGGLE'"
m.5.DEL ="dbso 'DELC'"
m.5.BKSP ="dbso 'CL';dbso 'DELC';"
m.5.END ="If after() Then 'SOS FIRSTCH'; Else 'SOS ENDC'"
m.5.ESC ="If restricted? then exit 'ESC'; dbso 'QC'; first=''; menu?=0;",
" parse value db28clearmenu() with dbtrc dbtrap;"
m.5.CURL ="interpret cursora" "'CL -1 21'" "cursorb"
m.5.CURR ="interpret cursora" "'CR +1 21'" "cursorb"
m.5.ENTER="dbc 'CF';",
" If menu? Then do; Parse value db24second(menu word(items,ver)) with dbtrc dbtrap;",
" w1=dbtrc; end; Else If command() Then w1=1; Else dbso 'CD'"
m.5.F1 ="parse value rdbHELP('/PANEL' word(items,ver) 'H'first menu?) with dbtrc dbtrap ;",
" if dbtrc=-7 then return -7 dbtrap; ",
" initver=ver; ",
" if dbtrc<>0 then do; w1=1;dbso 'QCMND';",
" dbc 'TEXT SAY' dbtrap; end; ",
" else if menu? then parse value db23first(menu) with dbtrc dbtrap;"
m.5.F12 ="rgtleft"
m.5.C_F12="w1=1; dbso 'QCMND'; dbc 'TEXT ABORT'"
m.5.C_DEL="dbso 'DELL'"
m.5.C_INS="dbso 'LINEA MARGINL'"
m.6.PGUP ="dbc 'BA'"
m.6.PGDN ="dbc 'FO'"
m.5.CURU ="interpret cursora" "'CU -1 22'" "cursorb"
m.5.CURD ="interpret cursora" "'CD +1 22'" "cursorb"
m.6.HOME ="dbso 'TABC'"
m.6.TAB ="interpret cursora" "'CR +1 21'" "cursorb"
m.6.A_C =select1 'C' suffix
m.6.A_D =select1 'D' suffix
m.6.A_F =select1 'F' suffix
m.6.A_H =select1 'H' suffix
m.6.A_O =select1 'O' suffix
m.6.A_R =select1 'R' suffix
m.6.A_V =select1 'V' suffix
m.6.A_W =select1 'W' suffix
m.6.A_T =select1 'T' suffix
m.6.S_F5 =Select2 'R S' suffix
m.6.S_F3 =Select2 'W B' suffix
m.6.C_F4 =Select2 'V R' suffix
m.6.S_F4 =Select2 'W T' suffix
m.6.S_TAB ="interpret cursora" "'CL -1 21'" "cursorb"
m.6.F2 ="menu?=(menu?=0); dbso 'QC'; first='';",
" if menu?=0 then do;",
" dbso 'CD';",
" parse value db28clearmenu() with dbtrc dbtrap; End;",
" else do;",
" dbso 'TABC';",
" parse value db23first(menu) with dbtrc dbtrap;",
" if dbtrc=1 then signal exit; end"
m.6.F3 ="w1=1; dbso 'QCMND'; dbc 'TEXT QUIT'"
m.6.F4 =Select2 'V O' suffix
m.6.F5 =Select2 'R C' suffix
m.6.F6 =Select2 'V S' suffix
m.6.F7 =Select2 'R G' suffix
m.6.F8 =Select2 'D S' suffix
m.6.F9 =Select2 'D B' suffix
m.6.F10 =Select2 'D P' suffix
m.6.C_CURD ="dbso 'RETRIEVEF'"
m.6.C_CURU ="dbso 'RETRIEVEB'"
m.7 = "nop"
if dbsys='DOS' then return 0 /*D*/
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