home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / rexx / rdebug / rdbui.kex < prev    next >
Encoding:
Text File  |  1993-03-26  |  7.4 KB  |  253 lines
  1. /*H* RDBUI.KEX 02-15-93 11:07*/
  2. Arg initcode initmenu initver '!' options
  3. Arg restricted? '!' .
  4. signal on error;   signal ON FAILURE;  signal on halt
  5. signal ON NOVALUE; signal ON NOTREADY; signal ON SYNTAX
  6. Call db29initial
  7. if initcode='*' then call db30initmenu
  8. if dbtrc=-7 then return -7 dbtrap
  9.  
  10. LOOP:
  11. Do Forever
  12.   If w1 Then Leave
  13.   dbc 'READV KEY'
  14.   dbw1=readv.1
  15.   w1=0
  16.   if (readv.2>='A'& readv.2<='Z')|(readv.2 >='a'& readv.2<='z') then do
  17.     If menu? Then do
  18.       parse value     db24second(first readv.2) with dbtrc dbtrap; w1=dbtrc
  19.       if dbtrc=-7 then return -7 dbtrap; end
  20.     Else 'TEXT' readv.2
  21.     iterate; end
  22.   dbw1=translate(readv.1,'_','-')
  23.   parse value     db2cmd(5) with dbtrc dbtrap
  24.   if dbtrc=-7 then return -7 dbtrap
  25.   If dbtrc Then iterate
  26.   If restricted? Then nop
  27.   Else do
  28.     parse value     db2cmd(6) with dbtrc dbtrap
  29.     if dbtrc=-7 then return -7 dbtrap
  30.     If dbtrc Then iterate
  31.     If dbsys ='OS2' then do                          /*O*/
  32.       parse value     db2cmd(7)   with dbtrc dbtrap  /*O*/
  33.       if dbtrc=-7 then return -7 dbtrap              /*O*/
  34.       If dbtrc Then iterate; end                     /*O*/
  35.  
  36.   End
  37.   call db1writekey
  38. End
  39. EXIT:
  40. dbso 'TABC'
  41. dbcs 'INSERTM ON'
  42. dbc  'TEXT NOMSG MSG '
  43. dbso 'EX'
  44. dbce '/LASTM'
  45. signal OFF NOVALUE
  46. parse upper var lastmsg.1 dbcommand rest
  47. w1=0
  48. if dbcommand='' then signal loop
  49. if dbcommand='X' | dbcommand='K' then do
  50.   parms='PROF RDPROFIL'
  51.   if pos('(',rest)=0 then parms='('parms
  52.   lastmsg.1='XEDIT' rest parms; end
  53. if dbtrc=-7 then return -7 dbtrap
  54. dbc 'MSG .'
  55. /*Exit*/ Return lastmsg.1
  56.  
  57. db1WRITEKEY:
  58. dbcs 'MSGMODE OFF'
  59. signal off error
  60. dbc 'TEXT' readv.2
  61. if rc<>0 then do
  62.   dbcs 'MSGMODE ON'
  63.   dbc 'EMSG rdbUI Unsupported key:' readv.1; end
  64. dbcs 'MSGMODE ON'
  65. signal on error
  66. Return 0
  67.  
  68. DB2CMD:
  69. Arg dbn
  70. drop dbcmd
  71. Signal Off Novalue; Signal Off Error; Signal Off Failure
  72. dbcmd=m.dbn.dbw1
  73. if left(dbcmd,2)<>'M.' then do
  74.   dbmsg=dbcmd
  75.   Interpret dbcmd
  76.   src=1; end
  77. else src=0
  78. Signal On Novalue; signal on error; Signal On Failure
  79. if dbtrc=-7 then return -7 dbtrap
  80. Return src
  81.  
  82. DB21GETMENU:
  83. Arg dir
  84. hor=hor+dir
  85. If hor>words(menus) | hor<1 Then parse value hor-dir with hor
  86. menu=word(menus,hor)
  87. first=menu
  88. parse value     rdbmenu('/ME' menu ver options) with dbtrc dbtrap
  89. if dbtrc=-7 then return -7 dbtrap
  90. items=dbtrc dbtrap
  91. ver=1
  92.  
  93. Return 0;   DB22GETITEM:
  94. Arg dir
  95. ver=ver+dir;
  96. if ver< 1 then dbso 'CU'
  97. If ver>words(items) | ver<1 Then parse value ver-dir with ver
  98. parse value     db25menu('/ME' menu ver) with dbtrc dbtrap
  99. if dbtrc=-7 then return -7 dbtrap
  100.  
  101. Return 0;   DB23FIRST:
  102. Arg key
  103. Parse Value 0 initver 1 key key With leave? ver menu? first menu
  104. parse value     db25menu('/ME' menu ver) with dbtrc dbtrap
  105. if dbtrc=-7 then return -7 dbtrap
  106.  
  107. Return leave?;    DB24SECOND:
  108. Arg code1 code2 .
  109. dbc 'MSG .'
  110. dbc 'REFRESH'
  111. menu?=0
  112. parse value     rdbtask( . code1 code2) with dbtrc dbtrap
  113. if dbtrc=-7 then return -7 dbtrap
  114. task=dbtrc dbtrap
  115. if initcode='*' then do
  116.   parse value     db25menu('/ME' menu ver) with dbtrc dbtrap
  117.   if dbtrc=-7 then return -7 dbtrap; end
  118.  
  119. Return task;     DB25MENU:
  120. Arg . m ver .
  121. parse value    rdbmenu(. m ver options) with dbtrc dbtrap
  122. if dbtrc=-7 then return -7 dbtrap
  123. items=dbtrc dbtrap
  124. hor=wordpos(m,menus)
  125.  
  126. Return 0;    db27CURSOR:
  127. arg dir inc rtn
  128. dbce '/CURS';if cursor.3<>-1 then do
  129.   dbso dir
  130.   if menu? Then call db21getmenu 0
  131. End
  132. else if menu? then do
  133.   if rtn=21 Then do
  134.     ver=1
  135.     call db21getmenu inc; end
  136.   else           call db22getitem inc
  137. end
  138. else dbso dir
  139.  
  140. Return w1;   db28CLEARMENU:
  141. dbce '/LSCR'
  142. if lscreen.3<13 then dbscr=1; else dbscr=2
  143. If dbscr=2 then do
  144.   dbso 'TABCMDB'; dbc 'MSG '
  145.   dbc 'BOT';
  146.   dbso 'TABCMDF'; end
  147. else dbc 'MSG'
  148.  
  149. Return 0;   db30INITMENU:
  150. dbso 'TABC'
  151. menus=initmenu
  152. if initver<>'' then ver=initver
  153. parse value    db23first(initmenu)     with dbtrc dbtrap
  154. if dbtrc=-7 then return -7 dbtrap
  155. if dbtrc=1 then signal exit
  156.  
  157. Return 0;   DB29INITIAL:
  158. dbc='COMMAND'
  159. parse value dbc 'SET!'dbc 'X!'dbc 'EXT!'dbc 'SOS' With dbcs'!'dbxx'!'dbce'!'dbso
  160. dbce '/OPSYS'
  161. dbme='rdbUI'
  162. dbsys=opsys.1
  163. if dbsys='OS/2' then dbsys='OS2'     /*O*/
  164. Parse Value 0 With dbtrc dbtrap dbtrapp dbmsg
  165. if initver='' then initver=1
  166. restricted?=(restricted?=1)
  167. Parse Value 'F 0 1 1 0' With first dbtrc ver hor menu? first menu. task.
  168. Parse Value 'F' 0 '.'  With menu w1 items
  169. menus  = 'F   V   R D W C O T H'
  170. select1="parse value db23first(" '"'
  171. select2="parse value db24second(" '"'
  172. suffix='"' ") with dbtrc dbtrap; w1=dbtrc"
  173. cursora="parse value db27cursor(" '"'
  174. cursorb='"'") with dbtrc dbtrap;"
  175.  
  176. m.5.INS  ="dbcs 'INSERTM TOGGLE'"
  177. m.5.DEL  ="dbso 'DELC'"
  178. m.5.BKSP ="dbso 'CL';dbso 'DELC';"
  179. m.5.END  ="If after() Then 'SOS FIRSTCH'; Else 'SOS ENDC'"
  180. m.5.ESC  ="If restricted? then exit 'ESC'; dbso 'QC'; first=''; menu?=0;",
  181. "  parse value    db28clearmenu()     with dbtrc dbtrap;"
  182. m.5.CURL ="interpret cursora" "'CL -1 21'" "cursorb"
  183. m.5.CURR ="interpret cursora" "'CR +1 21'" "cursorb"
  184. m.5.ENTER="dbc  'CF';",
  185. "  If menu? Then do; Parse value db24second(menu word(items,ver)) with dbtrc dbtrap;",
  186.   "  w1=dbtrc; end; Else If command() Then w1=1; Else dbso 'CD'"
  187. m.5.F1   ="parse value rdbHELP('/PANEL' word(items,ver) 'H'first menu?) with dbtrc dbtrap ;",
  188. " if dbtrc=-7 then return -7 dbtrap; ",
  189. " initver=ver; ",
  190. " if dbtrc<>0 then do; w1=1;dbso 'QCMND';",
  191.   " dbc 'TEXT SAY' dbtrap; end; ",
  192. " else if menu? then parse value db23first(menu) with dbtrc dbtrap;"
  193. m.5.F12  ="rgtleft"
  194. m.5.C_F12="w1=1; dbso 'QCMND'; dbc 'TEXT ABORT'"
  195. m.5.C_DEL="dbso 'DELL'"
  196. m.5.C_INS="dbso 'LINEA MARGINL'"
  197.  
  198. m.6.PGUP ="dbc  'BA'"
  199. m.6.PGDN ="dbc  'FO'"
  200. m.5.CURU ="interpret cursora" "'CU -1 22'" "cursorb"
  201. m.5.CURD ="interpret cursora" "'CD +1 22'" "cursorb"
  202. m.6.HOME ="dbso 'TABC'"
  203. m.6.TAB ="interpret cursora" "'CR +1 21'" "cursorb"
  204. m.6.A_C  =select1 'C' suffix
  205. m.6.A_D  =select1 'D' suffix
  206. m.6.A_F  =select1 'F' suffix
  207. m.6.A_H  =select1 'H' suffix
  208. m.6.A_O  =select1 'O' suffix
  209. m.6.A_R  =select1 'R' suffix
  210. m.6.A_V  =select1 'V' suffix
  211. m.6.A_W  =select1 'W' suffix
  212. m.6.A_T  =select1 'T' suffix
  213. m.6.S_F5 =Select2 'R S' suffix
  214. m.6.S_F3 =Select2 'W B' suffix
  215. m.6.C_F4 =Select2 'V R' suffix
  216. m.6.S_F4 =Select2 'W T' suffix
  217. m.6.S_TAB ="interpret cursora" "'CL -1 21'" "cursorb"
  218. m.6.F2   ="menu?=(menu?=0); dbso 'QC'; first='';",
  219. "  if menu?=0 then do;",
  220.   "    dbso 'CD';",
  221.   "    parse value    db28clearmenu()     with dbtrc dbtrap; End;",
  222. "  else do;",
  223.   "    dbso 'TABC';",
  224.   "    parse value    db23first(menu)     with dbtrc dbtrap;",
  225.   "    if dbtrc=1 then signal exit; end"
  226.   m.6.F3   ="w1=1; dbso 'QCMND'; dbc 'TEXT QUIT'"
  227.   m.6.F4   =Select2 'V O' suffix
  228.   m.6.F5   =Select2 'R C' suffix
  229.   m.6.F6   =Select2 'V S' suffix
  230.   m.6.F7   =Select2 'R G' suffix
  231.   m.6.F8   =Select2 'D S' suffix
  232.   m.6.F9   =Select2 'D B' suffix
  233.   m.6.F10  =Select2 'D P' suffix
  234.   m.6.C_CURD ="dbso 'RETRIEVEF'"
  235.   m.6.C_CURU ="dbso 'RETRIEVEB'"
  236.   m.7 = "nop"
  237.  
  238.  
  239.  
  240.   if dbsys='DOS' then return 0   /*D*/
  241. ERROR:    return db9trap(sigl 80e) sourceline(sigl)
  242. FAILURE:  return db9trap(sigl 80f) sourceline(sigl)
  243. HALT:     return db9trap(sigl 80h)
  244. NOTREADY: return db9trap(sigl 80r) sourceline(sigl)
  245. NOVALUE:  return db9trap(sigl 80v)
  246. SYNTAX:   return db9trap(sigl 80e) errortext(rc)'~'sourceline(sigl)
  247. db9TRAP:
  248. if dbtrc=-7 then dbtrapp=dbtrap
  249. parse arg dbsigl dbtcode dbtrest
  250. dbtrap = 0 dbme dbsigl dbtcode dbmsg rdbmsg(dbtcode dbme dbsigl) dbtrest
  251. dbtrc=-7
  252. return -7 dbtrapp'~'dbtrap
  253.