home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / blkos207.zip / BLKOS2.CMD < prev    next >
OS/2 REXX Batch file  |  1993-05-19  |  39KB  |  1,445 lines
  1. /*BLKOS2.CMD*/
  2. /*copyright(c) C>BLACK, B.Stone,KUTEK 1993*/
  3. /*all rights reserved*/
  4. /*beta ver 0.1.7*/
  5. '@echo off'   
  6. /**********************CONFIGURE BLOCK*******************/
  7.  
  8. PATHER='F:'    /*THE PATH FOR THE BLKOS2 AUXILIARY FILES */
  9. logon=1            /*1 FOR LOG  ON, 0 FOR LOG OFF DEFAULT*/
  10. limtt=1000         /* THE LENGTH OF THE HISTORY BUFFER,ARBITRARY*/
  11. SKIP='D: J:'      /* place capitalized drive letters WITH COLONS here to exclude from global search)*/
  12. totdrv=1            /*0 sets searches to curr dir and below,1 searches entire drive in selector*/
  13. prpt=35            /* standard ansi foreground color designator  for prompt color*/
  14. /******************************************************************/
  15. ert= pather'\history'
  16. SIGNAL ON HALT name RESTORE 
  17. if rxfuncquery(sysloadfuncs) then do
  18. say 'LOADING REXXUTIL'
  19. call RxFuncAdd 'SysLoadFuncs' , 'Rexxutil' , 'SysLoadFuncs'
  20. call SysLoadFuncs
  21. end
  22. parse value systextscreensize() with rowm colm
  23. call opencc
  24. call sysmkdir(ert)
  25. restor=0
  26. opcomm.='';florn=0;keymax=0;keytmp=0;frob=0;row=0;keyn=0;alnum=0;select=0;gof=0
  27. entrd=0;chaout='';bk.0='';o=0;huy=0;blou=0;show=0;col=1;nxx=0;nxxx=0
  28. hnu=1;done=0;pos=0;cnt=0;rowm=0;colm=0;comenv='cmd';selecmod=0;
  29. stpo=0;selecrun=0;opndr=0;replace=0;lev=0;nexus=0;nomatch=0;rename=0;
  30. narmal=0;horiz=60;vert=18;wid=20;table=4;incr=5;omce=0;df=0;ent=0;sh=0;
  31. zep=0;cdr='0A 0D 08 09 1B 01 0F';once=0;ent=1;topoo=1;hh=0;listlen.=''
  32. dcfr=0;shh=1;movch=0;lener='';ov=0;joog=0;atts='';pr='';dddd=0;ddde=0;ddds=0
  33. ddda=0;gtv.='';sholne=0;later=0;early=0;gook=0;recur=0;dhnu=1;dsh=1;dbk.='';dtopoo=1
  34. ec=x2c(1b)
  35. parse value syscurpos() with row col
  36. call sessid
  37. call loadals
  38. call syscls
  39. /*MAINLINE*/
  40. do forever
  41.  key='';cv=x2c(1b5b)'1;'prpt'm';cve=x2c(1b5b)'0m'
  42. parse value systextscreensize() with rowm colm
  43. call main
  44. end /*THE END*/
  45. MAIN:
  46. do forever
  47. if blou\=1 then do
  48. if movch\=1 then q=syscurpos(row,0)
  49. cur=directory()||'>'
  50. sta=length(cur)
  51. cur=cv||directory()||'>'cve
  52. col=sta+pos
  53. if selecmod\=1&movch\=1 then s=charout(,cur)
  54. if movch\=1 then q=syscurpos(row,col)
  55. end
  56. ro=0
  57. xx=sysgetkey('noecho')
  58. nxx=c2x(xx)
  59. if nxx=00|nxx=e0 then do  
  60. xxx=sysgetkey('noecho')
  61. nxxx=c2x(xxx)
  62. ro=1
  63. end
  64. if blou\=1 then do
  65.    if ro=0 then key=nxx
  66.    else key=nxx||nxxx
  67. if al.key=1 then do
  68. chaout=key||' '||chaout
  69. call chkals
  70. end
  71. end
  72. if (nxx||nxxx\=E048)&(nxx||nxxx\=E050|nxx||nxxx=E084) then do;ent=1;once=0;end
  73. if huy=1 then call keyhex
  74. else if selecmod\=1 then
  75. select
  76.     when ro=1 then select
  77. when nxx=00 then select
  78. when nxxx=1F then do;if totdrv=1 then totdrv=0;else if totdrv=0 then totdrv=1;end
  79. when nxxx=3B then call help
  80. when nxxx=3f then sholne=1
  81. when nxxx=5E then do;attir=1;
  82. entrd=0;shh=1;call chkals;blou=0;if scner=1 then call vidrest;return;end
  83. when nxxx=5F then do;if logon=1 then logon=0;if logon=0 then logon=1;end
  84. when nxxx=1C then do
  85. opndr=1;opcomm.1=chaout;call chkals;call adj;end
  86. when nxxx=44 then do;z=1;opcomm.1=chaout; call sethist;call adj;end
  87. when (nxxx=9B|nxxx=94)&pos\=0 then call wdbeg 
  88. when nxxx=9d then call nxtwd 
  89. when nxxx=A2 then do;if ov=1 then ov=0;else if ov=0 then ov=1;end
  90. when nxxx=3E then call listals  
  91. when nxxx=42 then call removals                                  
  92. when nxxx=40 then do;form=chaout;rename=1;call removals;end      
  93. when nxxx=85 then nexus=1     
  94. when nxxx=41 then call killals
  95. when nxxx=3D then call LOADALS
  96. when nxxx=29 then do;z=1;opcomm.z=chaout;call sethist;call INT;end
  97. when nxxx=0F&movch\=1 then do;if pos-8 >0 then pos=pos-8;else pos=0;end
  98. when nxxx=86 then huy=1        
  99. when nxxx=3C then call ALIAS
  100. otherwise nop
  101. end /*select*/
  102. when nxx=E0 then select
  103. when nxxx=91 then do;call dinn;friz=1;call sethist;call doutt;sd=directory(strip(chaout,'B'));call adj;friz=0;end
  104. when nxxx=8D then do;friz=1;
  105. dfff=chaout;if dfff\='' &dfff\=prev then df=1;else df=0;call dinn;call shiftB;call doutt/*;friz=0*/;end
  106. when (nxxx=48|nxxx=50) then do
  107. dfff=chaout;if dfff\='' &dfff\=prev then df=1;else df=0;call shiftB;end
  108. when nxxx=49 then do;dfff=chaout;call DISPHIST;end
  109. when nxxx=73&pos\=0 then call wdbeg
  110. when nxxx=74&pos<79 then call nxtwd
  111. when nxxx=75|nxxx=77 then call deltoend
  112. when nxxx=4d then call RIGHTT
  113. when nxxx=4b then call LEFTT
  114. when nxxx=47 then pos=0
  115. when nxxx=4f then do;rrr= length(chaout);pos=rrr;end
  116. when nxxx=53 then call DELCH
  117. otherwise nop
  118. end  /*select*/
  119. otherwise nop
  120. end  /*1select */
  121.    when ro=0 then select
  122. when wordpos(nxx,cdr)=0 then call ADDCH
  123. when nxx=08 then call BACKDEL
  124. when nxx=09 then call TAB
  125. when  nxx=1B&blou=1 then do
  126. blou=0;chaout='';lener='';frob=0;if movch=1 then do
  127. lev=1;done=1;selecmod=0;movch=0
  128. movch=0;lener='';attir=0;nexus=0;end;pos=0;
  129. if scner=1 then call vidrest;return;end
  130. when  nxx=1B then call ESC
  131. when  (nxx=0d|nxx=01|nxx=0A)&blou\=1 then do
  132. if nxx=0A then normal=1
  133. entrd=0;shh=1;if scner=1 then call vidrest;
  134. if friz=1 then do;s=directory(chaout);call adj;friz=0;return;end
  135. call chkals
  136. return
  137. end
  138. when  nxx=0d&blou=1 then do
  139. liner=substr(chaout,sta+1)
  140. return
  141. end  /* Do */
  142. otherwise do;lev=0;leave;end
  143. end  /*0select*/
  144. otherwise call beep2
  145. end /*MASTER*/
  146. if frob=1&lev\=1 then return
  147. end/*forever*/
  148.  
  149. DISPHIST:
  150. if florg\=1 then do
  151. leest=0
  152. dedede=1
  153. call vidsave
  154. selecmod=1;initc=2;marker=1;listle.='';listlen.='';mark.=''
  155. horiz=45;vert=3;wid=25;table=5;end
  156. jjj=hnu-1
  157. do ki=jjj to 1 by -1
  158. call goo;end
  159. do ki=topoo to jjj+1 by -1
  160. call goo;end
  161. if florg=1 then do;if nax\=1 then listlen.='';nax=0;  return;end
  162. listlen.0=leest;gof=1;nomatch=0;indi1=1;
  163. aax1=6;bbx1= 29;ccx1=3;ddx1=43;az.1='blk';az.2= 'blk';az.3='magb';az.4='blk'
  164. call bx 
  165. call menu;if ghuy=1 then do;frob=1;call main;friz=0;end
  166. selecrun=0;formark='';lev=0;call chkals;gof=0;
  167. if scner=1 then call vidrest
  168. dedede=0;ghuy=0;listle.='';listlen.='';nax=0
  169. return
  170.  
  171. goo:
  172. if dff='' then return
  173. else if substr(bk.ki,1,length(dfff))\=dfff then return
  174. nax=1
  175. if bk.ki='BK.'ki then return
  176. leest=leest+1
  177. if friz\=1 then listlen.leest=bk.ki
  178. if friz=1 then listlen.leest=dbk.ki
  179. return
  180.  
  181. LEFTT:
  182. if (col>sta|blou=1)&pos>0&movch\=1 then do
  183.  pos=pos-1
  184. if col>=0 then qa=syscurpos(row,pos);end
  185. if movch=1 then  do;pos=pos-1;uu=startx+pos;row=starty
  186. if col>0 then qa=syscurpos(row,uu);end
  187. return
  188.  
  189. RIGHTT:
  190.  if pos<79&pos\=length(chaout) then do
  191. pos=pos+1
  192. if movch=1 then do; po=startx+pos;qa=syscurpos(starty,po);end
  193. else qa=syscurpos(row,pos)
  194. end
  195. return
  196.  
  197. OPENDIR:
  198. if chaout\=''|opcomm.z\='' then do
  199. if mxi=0 then mxi=1
  200. do z=1 to mxi
  201. parse var opcomm.z aa bb
  202. vi='open=default;'
  203. if bb='s' then vi='open=settings'
  204. f=SysSetObjectData(aa,vi )
  205. end
  206. opndr=0
  207. selecrun=0
  208. opcomm.='';
  209. call adj;end
  210. return
  211.  
  212. INT:
  213. /*INTERPRET    on alt-`  */
  214. touahc=chaout;call adj
  215. if logon=1&touahc\='' then do;z=1;opcomm.z=touahc;call logz;end
  216. interpret touahc
  217. call adj
  218. return
  219.  
  220. DELCH:
  221.   /*DELETE CHARACTER*/
  222. chaout=delstr(chaout,pos+1,1)
  223. if movch\=1 then a=overlay(' ',aa,1,79-sta)
  224. else a=overlay(' ',aa,1,lener)
  225. if movch\=1 then qa=syscurpos(row,sta)
  226. else qa=syscurpos(starty,startx)
  227. s=charout(,a)
  228. if movch\=1 then qa=syscurpos(row,sta)
  229. else qa=syscurpos(starty,startx)  
  230. s=charout(,chaout)
  231. if movch\=1 then qa=syscurpos(row,pos)
  232. else do;uu=pos+startx;qa=syscurpos(starty,uu);end
  233. return
  234.  
  235. ADJ2:
  236. if movch=1 then return
  237. xx=length(chaout)
  238. w=copies(' ',79-sta)
  239. q=syscurpos(row,sta)
  240. s=charout(,w)
  241. q=syscurpos(row,sta)
  242. s=charout(,chaout)
  243. q=syscurpos(row,0)
  244. pos=xx
  245. return
  246.  
  247. SHIFTB:
  248. /*COMMAND RECALL SHIFT FORWARD/BACK*/
  249. if friz\=1&chaout=''&bk.1='BK.1' then return
  250. if friz=1&chaout=''&dbk.1='DBK.1' then return
  251.  if df=1|(once=0&ent=1) then do
  252. leest=0;ent=0
  253. florg=1;call disphist;florg=0
  254. if once=0 then do
  255. if shh>1 then shh=shh-1
  256. else shh=leest;end
  257. once=1
  258. end
  259. if shh<leest+1&(nxxx=48|nxxx=98) then shh=shh+1
  260. if shh>leest then shh=1
  261. if shh\=0&nxxx=50 then do
  262. if shh>1 then shh=shh-1
  263. else shh=leest
  264. end;
  265. if shh=1 then do
  266. oo= beep(1500,40)
  267. end
  268. chaout=listlen.shh
  269. if chaout\='' then prev=chaout
  270. call adj2
  271. return
  272.  
  273. wdbeg:
  274. if entrd=0 then do; comp.='';io=0;end
  275. if pos=0 then return
  276. in=pos
  277. ps=pos;pes=pos
  278. if pos\=1 then do
  279.  if substr(chaout,ps,1)=' ' then do until re\=' '
  280. ps=ps-1; if ps=0 then leave
  281.  re=substr(chaout,ps,1);end;vup=ps
  282. if ps>1 then if substr(chaout,ps-1,1)\=' ' then do until re=' '
  283.  ps=ps-1;if ps=0 then leave
  284. re=substr(chaout,ps,1);end
  285. if ps=in|vup=ps then ps=ps-1
  286. if ps>0 then pes=ps;else pes=0
  287. end
  288. if pos=1 then do;pes=0;ps=0;len=1;end
  289. if nxxx=9B then do; call dele;end
  290. if nxxx=94 then do
  291. if entrd=1&pos\=zep-1 then entrd=0
  292. io=io+1     
  293. len=in-pes-1
  294. inp=substr(chaout,pes+1,len+1)
  295. if entrd=0 then  s=sysfiletree(inp'*',comp,)
  296. if comp.0\=0&io<comp.0+1 then do
  297. parse var comp.io z1 z2 z3 z4 z5
  298. z5=strip(z5,'B')
  299. frw=length(z5)
  300. if pos(' ',z5,1)<frw&pos(' ',z5,1)>0 then z5='"'z5'"'
  301. if entrd=0 then do
  302. call dele
  303. pws=pes-1;chot=chaout;end
  304. if z5\='Z5' then chaout=insert(z5||' ',chot,pws)
  305. call nxtwd;pes=pis;zep=pis
  306. hin=inp
  307. end
  308. else do;pes=pis;call beep1;end
  309. end
  310. call shoow
  311. if pes>0 then pos=pes-1
  312. if nxxx\=94 then pos=pes;entrd=1
  313. qa=syscurpos(row,pos);return
  314.  
  315. dele:
  316.  pes=ps+1
  317. chaout=chaout||' '
  318.  len=in-pes+1
  319. if pes=0 then pes=1
  320. if substr(chaout,pes,len-1)=''&pes=1&in\=1 then len=len-1
  321. chaout=delstr(chaout,pes,len)
  322. if nxxx\=94 then  pes=pes-1
  323. return
  324.  
  325. nxtwd:
  326. if chaout=''|pos>length(chaout) then return
  327. if pos=0 then do;tic=1;pus=1;end
  328. else pus=pos
  329. if substr(chaout,pos+1,1)\=' ' then do until rew=' '
  330. if pos>length(chaout) then leave
  331. pos=pos+1
  332. rew=substr(chaout,pos,1);end;pis=pos
  333. do until re\=' '
  334. if pos>length(chaout) then leave
  335. pos=pos+1
  336. re=substr(chaout,pos,1);end
  337. pas=pos-1
  338. if nxxx=94 then return
  339. if nxx=00& nxxx=9D then do
  340. lend=pas-pus
  341. if tic=1 then do; pus=0;lend=lend+1;end
  342. chaout=delstr(chaout,pus+1,lend)
  343. call shoow
  344. if tic=1 then pos=0;else pos=pus
  345. qa=syscurpos(row,pos)
  346. end
  347. else do
  348. if pos\=length(chaout) then pos=pos-1
  349. qa=syscurpos(row,pos)
  350. end
  351. tic=0
  352. return
  353.  
  354. deltoend:
  355. if pos=0&nxxx=77 then return
  356. if nxxx=77 then chaout=substr(chaout,pos+2)
  357. else chaout=substr(chaout,1,pos)
  358. call shoow
  359. if nxxx=77 then do;pos=0;
  360. qa=syscurpos(row,0);end;return
  361.  
  362. shoow:
  363. se=copies(' ',79-sta)
  364. qa=syscurpos(row,sta)
  365. sa=charout(,se)
  366. qa=syscurpos(row,sta)
  367. xs=charout(,chaout)
  368. return
  369.  
  370. ADDCH:
  371.  /*ADD NEW CHAR TO STRING */
  372. if joog=1 then return
  373. if blou=1 then sta=0
  374. if ov\=1 then chaout=insert(xx,chaout,pos)
  375. else chaout=overlay(xx,chaout,pos+1,1)
  376. if lener=''&movch\=1 then do
  377.  qa=syscurpos(row,sta)
  378. e=charout(,chaout)
  379.  pos=pos+1
  380. if pos>1  then qa=syscurpos(row,pos);end
  381. if movch=1 then do
  382.   chaout=substr(chaout,1,lener)  
  383.  qa=syscurpos(starty,startx) 
  384. if pos<=lener then pos=pos+1
  385. if startx\='STARTX' then uu=pos+startx    
  386. e=charout(,chaout)   
  387.  if pos>1 then qa=syscurpos(starty,uu)
  388. end
  389. return
  390.  
  391. BACKDEL:
  392.    /*BACKSPACE DELETE*/
  393. IF pos>0&movch\=1  then do
  394. if chaout\='' then chaout=delstr(chaout,pos,1)
  395. if pos>0 then pos=pos-1
  396. a=overlay(' ',aa,1,79-sta)
  397. qa=syscurpos(row,sta)
  398. s=charout(,a)
  399. qa=syscurpos(row,sta)
  400. s=charout(,chaout)
  401.  qa=syscurpos(row,pos)
  402. end
  403. if pos>0&movch=1 then do
  404. if chaout\='' then chaout=delstr(chaout,pos,1)
  405. if pos>0 then pos=pos-1;uu=pos+startx
  406. a=overlay(' ',aa,1,lener);qa=syscurpos(starty,startx);s=charout(,a)
  407. qa=syscurpos(starty,startx);s=charout(,chaout);qa=syscurpos(starty,uu);end
  408. return
  409.  
  410. TAB:
  411. if col<72 then do
  412. if movch\=1 then pos=pos+8
  413. if movch\=1 then qa=syscurpos(row,pos)
  414. if movch=1 then do;pos=pos+startx;qa=syscurpos(starty,pos)
  415. end
  416. return
  417.  
  418. ESC:
  419. /*ESCAPE*/
  420. friz=0;shh=1;once=0
  421. s=copies(' ',79-sta)
  422. chaout=''
  423. qa=syscurpos(row,0)
  424. s=charout(,s)
  425. q=syscurpos(row,0)
  426. pos=0;entrd=0
  427. return
  428.  
  429. COMMAND:
  430.  /*COMMAND OUT  */
  431. if scner=1 then do;scner=0;call vidrest;end
  432. if (chaout=''|row>rowm-1) then do
  433. nxt=x2c(0d)
  434. if nxx\=1b then say nxt
  435. end
  436. s=lineout(,'')
  437.   do z=1 to mxi
  438. xsw=words(opcomm.z)
  439. do e=1 to xsw
  440.    x.e=word(opcomm.z,e)
  441. end /* do */
  442. if sholne=1 then do;chaout=opcomm.z;call adj2;sholne=0;return;end
  443. if selecrun=1 then say x2c(1b)'[1;33m' opcomm.z x2c(1b)'[0m'
  444. if logon=1&opcomm.z\='' then call logz
  445. address cmd 'call' opcomm.z
  446. end
  447. selecrun=0;opcomm.='';v.='';x.='';show=0;call adj;done=1;movch=0;lener=''
  448. return
  449.  
  450. keyhex:
  451. if ro=1 then zzq=nxx||nxxx
  452. else zzq=nxx
  453. say zzq
  454. call adj
  455. huy=0
  456. return
  457.  
  458. CHKALS:
  459. mxi=0;nomatch=0;cnnt=0;florn=0;out='';done=0;tagnum=0;sti='';list=0
  460. do; z=1;opcomm.1=chaout;if chaout\='' then call sethist;opcomm.1='';z=0;end
  461. num=words(chaout)
  462. norp=chaout
  463. offs=0
  464.  do qqwq=1 to num
  465. v.qqwq=word(norp,qqwq)
  466. if left(v.qqwq,1)='"'|left(v.qqwq,2)='["' then do
  467. vxv='';ryt=0
  468. tep=qqwq
  469. do while ryt\=1
  470. v.qqwq=word(norp,qqwq)
  471. if right(v.qqwq,1)='"' then ryt=1
  472. vxv=vxv||' '||v.qqwq
  473. qqwq=qqwq+1
  474. end
  475. v.tep=strip(vxv,'B')
  476. trw=num-(qqwq-tep)+1
  477. do xy=qqwq to num
  478. tep=tep+1 
  479. v.tep=word(norp,xy);end
  480. num=trw
  481. end
  482. if lev=1 then do;frob=0;selecrun=0;selecmod=0;lev=0;replace=0
  483. listlen.='';attir=0;nexus=0;movch=0;return;end
  484. if  substr(v.qqwq,1,1)=']' then do; list=1;
  485. parse var v.qqwq ']' sti '[' v.qqwq;v.qqwq='['||v.qqwq;end
  486. if left(v.qqwq,1)='['  then do
  487. replace=1;selecmod=1;if dedede\=1 then do; call vidsave;dedede=1;end                                                                                                                                                      
  488. tagnum=tagnum+1
  489. tagg.tagnum=qqwq;tagg=qqwq
  490. florn=1;if attir=1 then call attri;lener=''
  491. call complete;nexus=0;pr=''
  492. if list=1 then do;cnnt=1;v.tagg.1=sti||ert'\blklst.'qqwq;list=0;end
  493. v.tagg.0=cnnt
  494. if cnnt>mxi then mxi=cnnt;cnnt=0
  495. if nomatch=1  then do
  496. movch=0;selecmod=0;lener=''
  497. nomatch=0;florn=0;done=1;s=syscurstate(on);
  498. cnnt=0;selecrun=0;lev=1;if scner=1 then call vidrest;
  499. call adj
  500. say ec'[1;31m NO MATCH FOUND FOR AT LEAST ONE TERM' ec'[0m'
  501. call adj
  502. return;end
  503. end  
  504. end
  505. douy=''
  506. do qer=1 to num
  507. if qer=1 then douy=strip(v.qer,'B','[')
  508. else douy=douy||' '||strip(v.qer,'B','[')
  509. end  
  510. opcomm.1=douy
  511. if replace=1&lev\=1 then do
  512.   do z=1 to mxi
  513. do wqaz =1 to tagnum
  514. tagg=tagg.wqaz
  515. if opcomm.z=''&wqaz=1 then opcomm.z=opcomm.1
  516.   replpos=wordindex(opcomm.z,tagg)
  517.  if replpos>0 then replpos=replpos-1
  518. opcomm.z=delword(opcomm.z,tagg,1);
  519. if z> v.tagg.0 then v.tagg.z=v.tagg.1
  520. opcomm.z= insert(v.tagg.z||' ',opcomm.z,replpos)
  521. end
  522. end
  523. replace=0
  524. end
  525. else do; opcomm.1=douy;mxi=1;end
  526. v.tagg.='' 
  527. florn=0
  528. blou=0;attir=0
  529. if opndr=1 then do; v.tagg.0=mxi
  530. call opendir;lev=0;opndr=0;selecmod=0;chaout='';opcomm.='';return;end
  531. zxsa=word(opcomm.1,1)
  532. if scner=1 then do;scner=0;call vidrest;end
  533. if (datatype(zxsa,'A')\=1|(al.zxsa\=1&al.zxsa\=2)|normal=1|sholne=1)&(lev\=1|ghuy=1) then do
  534. call command;normal=0;lev=0;return;end
  535. else if lev\=1 then do
  536. call adj3
  537. do z=1 to mxi
  538. say x2c(1b)'[1;33m' opcomm.z x2c(1b)'[0m'   
  539. if logon=1&opcomm.z\='' then call logz
  540. xsw=words(opcomm.z)
  541. do ee=1 to xsw
  542.    x.ee=word(opcomm.z,ee)
  543. if left(x.ee,1)='"' then do
  544. vxv='';ryt=0
  545. tep=ee
  546. do while ryt\=1
  547. x.ee=word(opcomm.z,ee)
  548. vxv=vxv||' '||x.ee
  549. if right(x.ee,1)='"' then ryt=1
  550. ee=ee+1
  551. end
  552. x.tep=strip(vxv,'B')
  553. trw=num-(ee-tep)+1
  554. do xy=ee to xsw
  555. tep=tep+1
  556. x.tep=word(opcomm.z,xy);end
  557. xsw=trw
  558. end
  559. end 
  560. do xzqq=1 to value(al.zxsa.0)
  561. out=out||al.zxsa.xzqq||';'          
  562. end
  563. call adj
  564. interpret  out
  565. call adj
  566. out='';x.=''
  567. end;end
  568. call adj
  569. florn=0;V.='';lev=0;replace=0;dedede=0;selecrun=0;opcomm.='';show=0
  570. return
  571.  
  572. logz:
  573. lo=idd'   'time()'  ' date()'  ' opcomm.z
  574.  sazz=lineout(pather'\blk.log',lo)
  575. s=stream(pather'\blk.log','c','close')
  576. return
  577.  
  578. complete:
  579. ddk=''
  580. globabc=0
  581. if selecmod=1 then call syscls
  582. initc=2
  583. posit=1
  584. listlen.=''
  585. mark.=''
  586. marker=1
  587. say
  588. if right(v.qqwq,2)='[[' then recur=1
  589. if right(v.qqwq,1)='['|recur=1 then ddk='ds'
  590. abc=strip(v.qqwq,'B','[')
  591. if recur=1 &right(abc,1)\='\'  then ddk='fs'
  592. if ddk\='ds'&ddk\='fs' then ddk ='bs'
  593. head=abc
  594. cab=translate(abc)
  595. if nexus=1&pos(':',abc)=2 then do
  596. cab=translate(substr(cab,3))
  597. abc=substr(abc,1,2)
  598. end  /* Do */
  599. else if nexus=1 then do;cab=translate(abc);abc='';end
  600. if pos(':',abc)=2&substr(abc,3,1)\='\' then abc=insert('\',abc,2)
  601. curr=directory()
  602. if totdrv=1&recur\=1  then '@CD\'
  603. if attir=1 then  pr='t'
  604. if lev=1 then return
  605. if recur\=1 then abc=abc'*'
  606. if substr(v.qqwq,1,2)='[[' then call global
  607. else rc= sysfiletree(abc,listlen,ddk||pr,atts)
  608. if nexus=1 then do
  609. clu=0
  610. do wwer=1 to listlen.0
  611.    listlen.wwer=translate(listlen.wwer)
  612. if attir \=1 then parse var listlen.wwer z1 z2 z3 z4 z5
  613. if attir=1 then  parse var listlen.wwer z1 z2 z3 z4
  614. if attir\=1& pos(cab,z5)=0 then iterate
  615. if attir=1&pos(cab,z4)=0 then iterate
  616. if (attir=1&pos(cab,z4)\=0)|(attir\=1&pos(cab,z5)\=0) then do
  617. clu=clu+1
  618. listlen.clu=listlen.wwer
  619. end
  620. end
  621. listlen.0=clu
  622. end
  623. if attir=1 then call filter
  624. if listlen.0=0 then do
  625. frob=0;selecmod=0;nomatch=1
  626. curr=directory(curr)
  627. return
  628. end
  629. if lev=1 then return
  630. if recur=1 then do;do i=1 to listlen.0+1
  631. u=listlen.0-i+1
  632. if attir\=1 then  parse var listlen.u  zz1 zz2 zz3 zz4 zz5
  633. if attir=1 then parse var listen.u zz1 zz2 zz3 zz4
  634. if attir\=1 then v.tagg.i=zz5;if attir=1 then v.tagg.u=zz4;end;
  635. cnnt=listlen.0
  636. v.tagg.cnnt=abc;recur=0;return;end
  637. qa=syscurpos(0,0)
  638. xds=ec'[1;36mSEARCH PATTERN: 'ec'[33m'head
  639. say xds
  640. qa=syscurpos(0,50)
  641. xda=ec'[32mMATCHES FOUND:'ec'[33m'listlen.0 ec'[0m'
  642. say xda
  643. horiz=0;vert=0;wid=75;table=rowm-3;call menu;movch=0
  644. if list=1&lev\=1 then do;'call del' ert'\blklst.*';do ix=1 to v.tagg.0
  645. s=lineout(ert||'\blklst.'qqwq,v.tagg.ix)
  646. end;s=stream(ert||'\blklst.'qqwq,'c','close');end
  647. if lev=1 then return 
  648. curr=directory(curr)
  649. return
  650.  
  651. menu:
  652. per=listlen.0//table
  653. if per\=0 then top=(listlen.0%table)*table
  654. else top=listlen.0-table
  655. loww=1
  656. highh=table
  657. do forever
  658.    if lev=1 then  leave
  659.        do i=loww to highh
  660.           if i>listlen.0 then listlen.i=''
  661. rrd=i-loww+2+vert
  662. listle.i=substr(listlen.i,1+stpo,wid-initc)
  663. swex=''listle.i''
  664.     if mark.i=1 then say ''rrd';'horiz+2'H'swex
  665. else say ''rrd';'horiz+2'H'listle.i
  666.   if i=highh then do
  667. call syscurstate(off)
  668. call selector
  669. call syscurstate(on)
  670. if nomatch=1|lev=1 then return 
  671. end
  672. end
  673. cnnt=0
  674. if lev\=1 then do
  675. do i=1 to listlen.0
  676. if mark.i=1 then do
  677. cnnt=cnnt+1
  678. if attir\=1 then parse var listlen.i x1 x2 x3 x4 x5
  679. if attir=1 then parse var listlen.i x1 x2 x3 x4
  680. if attir\=1&words(x5)>1 then x5='"'strip(x5,'B')'"'
  681. if attir=1&words(x4)>1 then x4='"'strip(x4,'B')'"'
  682. if attir\=1 then v.tagg.cnnt=x5
  683. if attir=1 then v.tagg.cnnt=x4
  684. end
  685. end
  686. v.tagg.0=cnnt
  687. if cnnt=0 then do
  688. cnnt=1
  689. if attir\=1 then parse var listlen.marker x1 x2 x3 x4 x5
  690. if attir=1 then parse var listlen.marker x1 x2 x3 x4
  691. if attir\=1&words(x5)>1 then x5='"'strip(x5,'B')'"'
  692. if attir=1&words(x4)>1 then x4='"'strip(x4,'B')'"'
  693. if attir\=1 then v.tagg.1=x5
  694. if attir=1 then  v.tagg.1=x4
  695. end
  696. end
  697. lener=''
  698. if selecrun=1 then return
  699. end
  700.  
  701.  
  702. selector:
  703. selecrun=0
  704. call adj
  705. frob=1
  706. call disp
  707. do forever
  708. if frob=0 then return
  709. call main
  710. if nxx=0d|nxx=0A then do
  711. if nxx=0A then normal=1
  712. if gof=1 then chaout=listlen.marker
  713. else do
  714. parse var listlen.marker x1 x2 x3 x4 x5
  715. v.tagg.1=x5;end
  716. selecrun=1  
  717. selecmod=0
  718. frob=0;gof=0
  719. return
  720. end  
  721. else
  722. if nxx=00&nxxx=1C then do
  723. parse var listlen.marker x1 x2 x3 x4 x5
  724. v.tagg.z=x5
  725. selecrun=1
  726. selecmod=0
  727. frob=0
  728. opndr=1;s=syscurstate(on);return;end
  729. else
  730. select
  731. when nxx=00&nxxx=9B then do
  732. do  iii=1 to listlen.0
  733.  if mark.iii=1 then mark.iii=''
  734. else if mark.iii\=1 then mark.iii=1
  735. end
  736. return
  737. end
  738. when nxx=00&nxxx=43 then do;call vidrest
  739. chaout=listlen.marker;call adj2;ghuy=1;
  740. frob=0;selecmod=0;selecrun=0; lev=1;return;end
  741. when nxx=E0&nxxx=8D then do; mark.=1;return;end
  742. when nxx=E0&nxxx=91 then do; mark.='';return;end
  743.  when nxx=E0&nxxx=49&i>table then do
  744. call hilomin;return; end  
  745. when marker=loww&marker>1&nxx=E0&nxxx=48 then do
  746. call hilomin;return;end  
  747. when nxx=1B then do
  748. if gof\=1 then do;say 'PROCESS CANCELLED';call adj;end;
  749. frob=0;lev=1;chaout='';done=1;blou=0
  750. selecmod=0;attir=0;movch=0;s=directory(curr)
  751. selecrun=1;opcomm.='';v.='';v.tagg.='';if scner=1 then call vidrest;return;end
  752. when nxx=E0&nxxx=51&i<listlen.0-table&listlen.0-highh>table then do
  753. indi1=1;call hiloplus;return;end
  754. when nxx=E0&nxxx=51&listlen.0-highh<(table+1)&i<listlen.0 then do
  755. indi1=1;call lim;return;end  
  756. when marker=highh&nxx=E0&(nxxx=50|nxxx=4B)&listlen.0-highh>table then do
  757. indi1=1;if nxxx=4B then mark.highh=1;call hiloplus;return;end  
  758. when marker=highh&nxx=E0&(nxxx=50|nxxx=4B)&listlen.0-highh<table+1 then do
  759. indi1=i;if nxxx=4B then mark.i=1;call lim;return;end
  760. when marker>1&nxx=E0&nxxx=48 then do
  761. marker=marker-1;call disp;end
  762. when marker<listlen.0&nxx=E0&nxxx=50 then do
  763. marker=marker+1;call disp;end
  764. when nxx=E0&nxxx=4B &marker<listlen.0+1 then do
  765. mark.marker=1;
  766. if marker=listlen.0 then xcz=beep(900,40);
  767. else marker=marker+1;call disp;end
  768. when nxx=E0&nxxx=4D then do
  769.  mark.marker=' ';call disp;end
  770. when nxx=E0&nxxx=47&marker\=1 then do
  771. marker=1;loww=1;highh=table;return;end
  772. when nxx=E0&nxxx=4F&marker\=listlen.0 then do
  773. marker=listlen.0;
  774. loww=top+1;highh=top+table;trig=1;return;end
  775. when nxx=E0&nxxx=73&stpo>incr-1 then do   
  776. stpo=stpo-incr;return;end
  777. when nxx=E0&nxxx=74&stpo<101 then do    
  778. stpo=stpo+incr;return;end
  779. otherwise call beep1
  780. end/*select*/
  781. end
  782.  
  783. HILOMIN:
  784. indi1=1;loww=loww-table;highh=loww+(table-1);marker=highh;trig=1;call disp;return
  785.  
  786. HILOPLUS:
  787. loww=loww+table;highh=loww+table-1;
  788. indi1=1;marker=loww;trig=1;call disp;return
  789.  
  790. LIM:
  791. loww=top+1;highh=top+table;marker=loww;trig=1;call disp;return
  792.  
  793. DISP:
  794. if indi1=1 then do;indi1=0; return;end
  795. else
  796.  posit=marker-loww +2+vert
  797.  if datatype(formark,'W')&trig\=1 then do
  798.  qa=syscurpos(positf,0)
  799. uuf=formark
  800. parse var listlen.uuf x1 x2 x3 x4 x5
  801. if mark.uuf=1 then do
  802. blom= ''listle.uuf''
  803. say ''positf';'horiz+2'H'blom
  804. end
  805. else do
  806.  brom='' listle.uuf
  807. say ''positf';'horiz+1'H'brom
  808. end
  809. end
  810. uu=marker
  811. parse var listle.uu x1 x2 x3 x4 x5
  812. if mark.uu\=1 then lout= ''listle.uu''
  813. else  lout= ''listle.uu''
  814. say ''posit';'horiz+2'H'lout
  815. formark=marker
  816. positf=posit
  817. trig=0
  818. return
  819.  
  820. beep1:
  821. call beep 900,40
  822. return
  823.  
  824. beep2:
  825. call beep 1100,30
  826. return
  827.  
  828. global:
  829. 'cd\'
  830. aafin=0
  831. dri=sysdrivemap()
  832. ne=0
  833. do until dri=''
  834. ne=ne+1
  835. parse var dri djd.ne dri
  836. end
  837. do i=1 to ne
  838.   if pos(djd.i,skip)\=0 then iterate
  839. s=directory(djd.i'\')
  840. dr=sysfiletree(djd.i||abc||'*',vt,(ddk)||pr,atts)
  841. if vt.0\=0 then do f=1 to vt.0
  842. aafin=aafin+1
  843. listlen.aafin=vt.f
  844. end
  845. end
  846. listlen.0=aafin
  847. return
  848.  
  849. adj:
  850. if friz=1 then do;chaout='';say x2c(0d);end
  851. if florn\=1 then chaout=''
  852. pos=0
  853. if scner=1 then do; row=tow;col=tol;end
  854. else parse value syscurpos() with row col
  855. if (chaout=''|row>rowm-1) then do
  856. nxt=x2c(0d)
  857. if nxx\=1b then say nxt
  858. end
  859. return
  860.  
  861. adj3:
  862. pos=0
  863. parse value syscurpos() with row col
  864. col=col-sta
  865. if (chaout=''|row>rowm-1) then do
  866. nxt=x2c(0d)
  867. if nxx\=1b then say nxt
  868. end
  869. return
  870.  
  871. sethist:
  872. if (opcomm.z=''&chaout=''&op='') then return
  873. if friz\=1 then op=opcomm.z
  874. if restor=0 then restor=1
  875. if hnu<=limtt&hh\=1 then topoo=hnu
  876. if hnu>limtt then do
  877.  hnu=1;sh=1;topoo=limtt;hh=1;end
  878. if friz=1 then dbk.hnu=op
  879. else bk.hnu=op
  880. if hnu=1 then s=lineout(pather'\history\'idd'hist.qqq',bk.hnu,1)
  881. else s=lineout(pather'\history\'idd'hist.qqq',bk.hnu)
  882. s=stream(pather'\history\'idd'hist.qqq','c','close')
  883. hnu=hnu+1
  884. ticc=hnu-1
  885. return
  886.  
  887. dinn:
  888. ctopoo=topoo;topoo=dtopoo
  889. ltmtt=limtt;limtt=20;chnu=hnu;hnu=dhnu;
  890. cshh=shh;shh=dsh
  891. op=directory();return
  892.  
  893. doutt:
  894. dtopoo=topoo;topoo=ctopoo;dsh=shh;shh=cshh
  895. limtt=ltmtt;dhnu=hnu;hnu=chnu;/*friz=0*/;return
  896.  
  897. killals:
  898. r=chaout
  899. al.r=0
  900. call adj
  901. say 'ALIAS' r 'REMOVED FROM MEMORY';call adj;v.=''
  902. return
  903.  
  904. LOADALS:
  905. comm.='';
  906. keymax=0;keyn=0
  907. say
  908. filer.2=pather'\master.als'
  909. FILER.1=PATHER'\history\'idd'REST.TPP'
  910. swe=stream(filer.1,'C','QUERY EXISTS')
  911. do g=2 to 1 by -1
  912. if restor=1&g=1 then iterate
  913. do until lines(filer.g)=0
  914. line=linein(filer.g)
  915. if line='' then iterate
  916. select
  917. when left(line,1)='@' then do
  918. key=substr(line,2)
  919. keyn=keyn+1
  920. key.keyn=key
  921. if g=1 then al.key=2;else al.key=1
  922. end
  923. when substr(line,1,4)='$$$$' then do
  924.           al.key.0=cnt
  925.           cnt=0
  926. if keyn\=1 then r=value(key.keyn)
  927. else r=strip(key.1,'B')
  928. comm.r=substr(line,5)
  929. end
  930. otherwise do
  931. cnt=cnt+1
  932. al.key.cnt=line
  933. end
  934. end/*select*/
  935. end
  936. ww=stream(filer.g,'c','close')
  937. end
  938. call adj
  939. keymax=keyn
  940. keyn=0
  941. if restor=0 then do 
  942. restor=1
  943. lop=pather'\history\'idd'hist.qqq'
  944. ds=stream(lop,'C','query exists')
  945. if ds\='' then do
  946. fex=0
  947. do until lines(lop)=0
  948.   fex=fex+1
  949. bk.fex=linein(lop)
  950. if fex>limtt then leave
  951. end  
  952. s=stream(lop,'C','close')   
  953. hnu=fex+1
  954. end
  955. end
  956. else sdc=sysfiledelete(lop)
  957. /*end*/
  958. call adj
  959. return
  960.  
  961. ALIAS:
  962. blou=1
  963. say x2c(1b5b)'1;32mALIAS CREATION MODE'x2c(1b5b)'0m'
  964. say 'input alias keyname, alpha numeric chars ONLY'
  965. say 'ESC to abort alias creation,/k for key alias'
  966. call adj
  967. do 
  968. call main;if blou=0 then return
  969. key=strip(liner,'B')
  970. call adj
  971. if al.key=1 then say'ALIAS KEYNAME USED-THIS ALIAS WILL BE OVERWRITTEN '
  972. if key='/k' then do
  973. call adj
  974. say 'HIT A KEY or VALID KEY COMBINATION'
  975. frob=1
  976. call adj
  977. call main;if blou=0 then return
  978. if ro=1 then key=nxx||nxxx
  979. else key=nxx
  980. say key
  981. frob=0
  982. end
  983. if datatype(key,'A')\=1 then do
  984.    say 'NON ALPHA-NUMERIC CHARS NOT ALLOWED IN KEY'
  985. say 'REINPUT ALIAS KEY'
  986. call adj
  987. end  
  988. end
  989. al.key=1
  990. keyn=keymax+keytmp+1
  991. key.keyn=key
  992. do
  993.      call adj
  994. say 'INPUT ALIAS DESCRIPTION/COMMENT'
  995. call adj
  996. call main;if blou=0 then return
  997. r=value(key.keyn)
  998. comm.r=liner
  999. call adj
  1000. end
  1001. 'epm' pather'\'key'.bls'
  1002. '@pause'
  1003. i=0
  1004. do while lines(pather'\'key'.bls')\=0
  1005. rkl=linein(pather'\'key'.bls')
  1006. if rkl='' then iterate
  1007. i=i+1
  1008. al.key.i=rkl
  1009. end
  1010. al.key.0=i
  1011. w=stream(pather'\'key'.bls','c','close')
  1012. say 'SAVE THIS ALIAS TO MASTER FILE? (Y/N)'
  1013. pull resp
  1014.  do
  1015. if resp='Y' then do;iu=1;sxx=pather'\master.als';end
  1016. else do;sxx=pather'\history\'idd'rest.tpp';iu=0;end
  1017. n=lineout(sxx,'@'key)
  1018. do i=1 to al.key.0
  1019.    if al.key.i='' then iterate
  1020.      n=lineout(sxx,al.key.i)
  1021. end
  1022. n=lineout(sxx,'$$$$'comm.r)
  1023.  ss=stream(sxx,'c','close')
  1024. if iu=1 then say 'ALIAS ' key 'SAVED TO MASTER FILE'
  1025. keymax=keymax+1
  1026. end
  1027. if iu=0 then do;keytmp=keytmp+1;al.key=2;end
  1028. s=sysfiledelete(pather'\'key'.bls')
  1029. say 'ALIAS' key' ACTIVE'
  1030. blou=0
  1031. call adj
  1032. return
  1033.  
  1034. vidsave:
  1035. parse value syscurpos() with tow tol
  1036. xdxx.=''
  1037. zz=x2c(0A)
  1038. bb=x2c(0d)
  1039. say x2c(1b)'[s'
  1040. qa=syscurpos(0,0)
  1041. do i=1 to rowm
  1042. xdxx.i=systextscreenread(i,0,78)
  1043. xdxx.i=strip(xdxx.i,'b',bb)
  1044. xdxx.i=strip(xdxx.i,'B',zz)
  1045. scner=1
  1046. end
  1047. return
  1048.  
  1049. vidrest:
  1050. s=syscurstate(off)
  1051. qa=syscurpos(0,0)
  1052. do i=1 to rowm
  1053. d=charout(,xdxx.i)
  1054. qa=syscurpos(i,0)
  1055. end
  1056. qa=syscurpos(tow,tol)
  1057. scner=0;dedede=0
  1058. s=syscurstate(on)
  1059. return
  1060.  
  1061. opencc:
  1062. call syscls
  1063. oy=rowm%2-3;ox=colm%2-14
  1064. dd.1= 'BLKOS2  (c) 1992,1993'
  1065. dd.2='C>BLACK,B.STONE,KUTEK '
  1066. dd.3 =' all rights reserved'
  1067. do i=1 to 3
  1068.   qa=syscurpos((oy+i-1),ox)
  1069. xx=lineout(,x2c(1b5b)'1;35m' dd.i x2c(1b5b)'0m')
  1070. end
  1071. return
  1072.  
  1073. REMOVALS:
  1074. if chaout='' then do;say 'ALIAS NAME REQUIRED-TRY AGAIN';return;end
  1075. ppp=pather||'master.als';ddd=pather||'123'
  1076. re=0;wwe=0;ewew=0;form=''
  1077. sw=strip(chaout);swl=length(sw)
  1078. form=sw
  1079. vv='@'||sw
  1080. do until lines(ppp)=0
  1081. dfdf=linein(ppp)
  1082. if dfdf=vv then ewew=1
  1083. end /* do */
  1084. qq=stream(ppp,'c','close')
  1085. if ewew\=1 then do 
  1086. call adj;say  sw 'IS NOT A STORED ALIAS';call adj;return;end
  1087. if rename=1 then do forever
  1088. call adj;blou=1;say ' INPUT NEW NAME';call adj;call main;
  1089. sw=strip(liner);blou=0;
  1090.   if al.sw=1 then do;sw='';call adj;say 'ALIAS NAME ALREADY USED';end
  1091. else leave
  1092. end 
  1093. if sw\='' then do until lines(ppp)=0
  1094. sd=linein(ppp)
  1095. if rename\=1&substr(sd,1,1)='@'&substr(sd,2,swl)=form then
  1096. do forever
  1097. sd=linein(ppp)
  1098. if substr(sd,1,1)='@'|sd='' then leave
  1099. end
  1100. do
  1101. re=re+1
  1102. if rename=1&sd='@'form then sde.re='@'sw
  1103. else sde.re=sd
  1104. end
  1105. end
  1106. test=0
  1107. do i=1 to re
  1108. s=lineout(ddd,sde.i)
  1109. test=test+s
  1110. end
  1111. s=stream(ddd,'c','close')
  1112. s=stream(ppp,'c','close')
  1113. if test=0 then do
  1114. al.form=0;al.form.=''
  1115. call sysfiledelete(ppp)
  1116. 'ren' ddd 'master.als'
  1117. call sysfiledelete(ddd)
  1118. call adj
  1119. if rename=1 then say 'ALIAS 'form' RENAMED TO 'sw
  1120. else say 'ALIAS ' sw 'REMOVED FROM MASTER FILE'
  1121. end
  1122. else say ec'[1;31mPROCESS FAILED->MASTER IS UNCHANGED' ec'[0m'
  1123. if rename=0 then do;al.sw=0;al.sw.='';end;rename=0;call adj
  1124. call loadals
  1125. return
  1126.  
  1127. listals:
  1128. call vidsave
  1129. call syscls
  1130. selecmod=1;initc=2;marker=1;listle.='';listlen.='';mark.=''
  1131. lstnum=1
  1132. do xi=1 to keytmp+keymax
  1133. rrrr=key.xi
  1134. if xi\=1 then x=value(key.xi)
  1135. else x=key.xi
  1136. if al.rrrr=0 then iterate
  1137. listlen.lstnum=rrrr
  1138. listlen.lstnum=insert(comm.x,listlen.lstnum,15)
  1139. lstnum=lstnum+1
  1140. end
  1141. listlen.0=lstnum
  1142. qa=syscurpos(0,0)
  1143. say ec'[1;36mLIST OF ACTIVE ALIASES'ec'[0m'
  1144. horiz=0;vert=0;wid=75;table=15;initc=1;lev=0;call menu
  1145. if lev\=1 then chaout=key.marker
  1146. call vidrest;call chkals;chaout='';listlen.='';listle.=''
  1147. return
  1148.  
  1149. restore:
  1150. return
  1151.  
  1152. bx:
  1153. pp=''
  1154. sent=''
  1155. call colors
  1156. xx=d2c(186)/*vert block*/
  1157. yy=d2c(0)/* space*/
  1158. zz=d2c(205)/*upper block*/
  1159. zza=d2c(201)/*upper left corn*/
  1160. zzb=d2c(187)/*upper right cor*/
  1161. zzc=d2c(200)/*lower left corner*/
  1162. zzd=d2c(188)/*low rght cor*/
  1163. d=syscurpos(ccx1,ddx1)
  1164. s=copies(zz,bbx1-2)
  1165. nn=copies(zz,bbx1-2)
  1166. say (zyzy)(zza)(s)(zzb)(pp)
  1167. t= center(sent,bbx1-2)
  1168. do i=1 to aax1
  1169. d=syscurpos(i+ccx1,ddx1)
  1170. q=(zyzy)(xx)(zxzx)(t)(zyzy)(xx)(pp)
  1171. say q
  1172. end
  1173. d=syscurpos(aax1+ccx1,ddx1)
  1174. say (zyzy)(zzc)(nn)(zzd)(pp)
  1175. return
  1176.  
  1177. colors:
  1178. do i=1 to 4
  1179. tt.i=''
  1180. rr.i=''
  1181. as.i=''
  1182. narb= right(az.i,2)
  1183. if pos('f',narb)\=0 then do
  1184. rr.i='5'
  1185. az.i=delstr(az.i,4)
  1186. end
  1187. if pos('b',narb)\=0 then do
  1188. tt.i='1'
  1189. az.i=delstr(az.i,4)
  1190. end
  1191.  
  1192. if az.i='n' then  as.i=pp
  1193. if az.i='blk' then as.i=0
  1194. if az.i='red' then as.i=1
  1195. if az.i='grn' then as.i=2
  1196. if az.i='yel' then as.i=3
  1197. if az.i='blu' then as.i=4
  1198. if az.i='mag' then as.i=5
  1199. if az.i='cya' then as.i=6
  1200. if az.i='whi' then as.i=7
  1201. if az.i='nul' then as.i=''
  1202. end
  1203. zxzx=''rr.1'm'tt.1';3'as.1';4'as.2'm'
  1204. zyzy=''rr.3'm'tt.3';3'as.3';4'as.4'm'
  1205. return
  1206.  
  1207. sessid:
  1208. drop=pather||'okstart'
  1209. do until stream('drop','C','QUERY EXISTS')=''                                               
  1210.    call syssleep 2                                                                             
  1211. end
  1212. aq=rxqueue("create")
  1213. s=rxqueue('set',aq)
  1214. 'pstat /c |rxqueue' aq
  1215. do until queued()=0                                                                            
  1216. pull kjhg                                                                                      
  1217. parse var kjhg c1 c2 c3 c4 c5                                                                  
  1218. if POS('PSTAT.EXE',c4)\=0 then do                                                              
  1219. idd=c2;leave;end                                                                               
  1220. end                                                                                            
  1221.  s=sysfiledelete('drop')                                                                     
  1222. s=rxqueue('delete',aq)
  1223. return
  1224.  
  1225. attri:
  1226. call syscls
  1227. do i=1 to 7;gtv.i='';end;chaout='';nxx=''
  1228. lener=1
  1229. aax1=6;bbx1=41;ccx1=6;ddx1=23;az.1='blk';az.2= 'blk';az.3='cya';az.4='blu'
  1230. call bx
  1231. vv=(zyzy)d2c(196)(zxzx)
  1232. xx.1='Date  (low):         (high):         '
  1233. xx.2='Time  (low):         (high):         '
  1234. xx.3='Size  (low):         (high):         '
  1235. xx.4=copies(vv,39)
  1236. xx.a=center('SEARCH PATTERN 'strip(v.qqwq,'B','['),colm)
  1237. xx.5='Attributes:'
  1238. qa=syscurpos(4,0)
  1239. say x2c(1b5b)'1;33m'xx.a
  1240. do i=1 to 5
  1241. qa=syscurpos((6+i),24)
  1242. say x2c(1b5b)'1;37m'xx.i
  1243. end
  1244. say x2c(1b5b)'0m'
  1245. movch=1;startx=36;starty=7
  1246. qa=syscurpos(7,36);pos=0
  1247. aa=syscurstate(off)
  1248. joog=1
  1249. rek=0
  1250. gty.1=36 7 8
  1251. gty.2=52 7 8
  1252. gty.3=36 8 6
  1253. gty.4=52 8 6
  1254. gty.5=36 9 8
  1255. gty.6=52 9 8
  1256. gty.7=37 11 7
  1257. do forever
  1258. frob=1;blou=1
  1259. select
  1260. when nxx=00&nxxx=85 then nexus=1
  1261. when nxx=00&nxxx=0F then do;if rek\=0 then gtv.rek=chaout
  1262. if rek>0 then rek=rek-1;if rek<=0 then rek=7;chaout=''
  1263. parse var gty.rek startx starty lener                            
  1264. pos=0;aa=syscurstate(on);chaout=gtv.rek;end
  1265. when nxx=09 then do;if rek\=0 then gtv.rek=chaout;chaout=''
  1266. rek=rek+1;if rek=8 then rek=1;
  1267. parse var gty.rek startx starty lener
  1268. pos=0;aa=syscurstate(on)
  1269. qa=syscurpos(starty,startx);chaout=gtv.rek;end
  1270. when nxx=1B then do;movch=0;chaout='';blou=0;lener='';aa=syscurstate(on)
  1271. selecmod=0;attir=0;lev=1;return;end
  1272. when nxx=0d then do;if rek\=0 then gtv.rek=chaout;qa=syscurpos(12,37)
  1273. say ec'[1;32;44m SEARCHING' ec'[0m';call prep; return;end
  1274. otherwise nop
  1275. end  /* select */
  1276. selecmod=0;call main;selecmod=1;joog=0
  1277. end
  1278. return
  1279.  
  1280. prep:
  1281. ds=0;ckt=0;ck=0;szz=0;zop=1;vop=1;sop=1
  1282. if gtv.1\=''|gtv.2\='' then dddd=1
  1283. if pos('=',gtv.1)\=0 then do;gtv.1=substr(gtv.1,1,6);hg=1;end
  1284. if pos('i',gtv.1)\=0 then do;gtv.1=substr(gtv.1,1,6);zop=0;end
  1285. if pos('l',gtv.1)\=0 then do;gook=1;gtv.1=substr(gtv.1,1,6);later=1;end
  1286. if pos('e',gtv.1)\=0 then do;gook=1;gtv.1=substr(gtv.1,1,6);early=1;end
  1287. if gtv.3\=''|gtv.4\='' then ddde=1
  1288. if pos('=',gtv.3)\=0 then do;gtv.3=substr(gtv.3,1,4);gf=1;end
  1289. if pos('i',gtv.3)\=0 then do;gtv.3=substr(gtv.3,1,4);vop=0;end
  1290. if gtv.5\=''|gtv.6\='' then ddds=1
  1291. if pos('=',gtv.5)\=0 then do;parse var gtv.5  gtv.5 '=';sg=1;end
  1292. if pos('i',gtv.5)\=0 then do;parse var gtv.5 gtv.5 'i';sop=0;end
  1293. if gtv.7\='' then do;ddda=1;parse var gtv.7 hu '/' norg;call parattrib;end
  1294. if dddd\=1&ddde\=1&ddds\=1&ddda\=1 then  return
  1295. return
  1296.  
  1297. filter:
  1298. if gook=1 then do;dddd=0;ddde=0;end
  1299. do i=1 to listlen.0
  1300. parse var listlen.i  zc1 zc2 zc3 zc4
  1301. parse var zc1 pp'/'qq'/'rr'/'ss'/'tt
  1302. ck=(pp)(qq)(rr)
  1303. ckt=(ss)(tt)
  1304. szz=zc2
  1305. if gook=1 then do
  1306. day=ck||ckt
  1307. nite=gtv.1||gtv.3
  1308. if later=1&day<nite then iterate
  1309. if early=1&day>nite then iterate
  1310. end
  1311. if dddd=1 then do
  1312. bloog=0
  1313. select
  1314.    when (hg=1)&(gtv.1=ck) then bloog=1
  1315. when hg\=1 then select
  1316. when (gtv.2 \='')&(gtv.1\='') then if (gtv.2-ck>=0)&(gtv.1-ck<=0) then bloog=1
  1317. when (gtv.1='') then if (gtv.2-ck>=0)  then bloog=1
  1318. when (gtv.2='') then if (gtv.1-ck<=0) then bloog=1
  1319. otherwise iterate
  1320. end/*select*/
  1321. otherwise iterate
  1322. end/*select*/
  1323. if bloog\=zop then iterate
  1324. end
  1325. if ddde=1 then do
  1326. boog=0
  1327. select
  1328. when (gf=1)&(gtv.3=ckt) then boog=1
  1329. when (gf\=1) then select
  1330. when (gtv.4 \='')&(gtv.3\='') then if (gtv.4-ckt>=0)&(gtv.3-ckt<=0) then boog=1
  1331. when (gtv.3='') then if (gtv.4-ckt>=0)  then boog=1
  1332. when (gtv.4='') then if (gtv.3-ckt<=0) then boog=1
  1333. end/*select*/
  1334. otherwise iterate
  1335. end/*select*/
  1336. if boog\=vop then iterate
  1337. end
  1338. if ddds=1 then do
  1339. sloog=0
  1340. select
  1341.    when (sg=1)&(gtv.5=szz) then sloog=1
  1342. when sg\=1 then select
  1343. when (gtv.6 \='')&(gtv.5\='') then if (gtv.6-szz>=0)&(gtv.5-szz<=0) then sloog=1
  1344. when (gtv.5='') then if (gtv.6-szz>=0)  then sloog=1
  1345. when (gtv.6='') then if (gtv.5-szz<=0) then sloog=1
  1346. otherwise iterate
  1347. end/*select*/
  1348. otherwise iterate
  1349. end/*select*/
  1350. if sloog\=sop then iterate
  1351. end
  1352.  call ssl
  1353. end
  1354. if dddd=1|ddde=1|ddds=1|later=1|early=1 then listlen.0=ds;gtv.='';
  1355. early=0;blou=0;dddd=0;ddde=0;ddds=0;later=0;hg=0;gf=0;sg=0
  1356. ddda=0;atts='';gook=0
  1357. return
  1358.  
  1359. ssl:
  1360. ds=ds+1
  1361. listlen.ds=listlen.i
  1362. return
  1363.  
  1364. parattrib:
  1365. if norg='m' then atts='-----'
  1366. if norg=''  then atts='*****'
  1367. do i= 1 to 5
  1368.    fgt=substr(hu,i,1)
  1369. fgt=translate(fgt)
  1370. if fgt='H' then atts= overlay('+',atts,3,1)
  1371. if fgt='A' then atts=overlay('+',atts,1,1)
  1372. if fgt='R' then atts=overlay('+',atts,4,1)
  1373. if fgt='S' then atts=overlay('+',atts,5,1)
  1374. if fgt='D' then atts=overlay('+',atts,2,1)
  1375. end /* do */
  1376. return
  1377.  
  1378. help:
  1379. c.1=x2c(1b5b)'1;36m';c.2=x2c(1b5b)'1;33m';c.3=x2c(1b5b)'0m'
  1380. h.1= c.1'F1:'c.2'   HELP'c.3' screen'
  1381. H.2=c.1'F2:'c.2'   CREATE ALIAS'c.3
  1382. h.3= c.1'F3:'c.2'   RELOAD ALIASES'c.3' from master'
  1383. h.4= c.1'F4:'c.2'   LIST'c.3' and select 'c.2'ACTIVE ALIASES'c.3
  1384. h.5=c.1'F5:'c.3'   bring 'c.2'SELECTed terms to CL'c.3' -press BEFORE entering SELECTOR'
  1385. H.6=c.1'F6:'c.2'   RENAME'c.3' an ALIAS'
  1386. H.7=c.1'F7:'c.2'   DEACTIVATE'c.3' an ALIAS '
  1387. H.8=c.1'F8:'c.2'   REMOVE'c.3' ALIAS from master alias file'
  1388. h.9=c.1'F9:'c.3'   place a 'c.2'line from HISTORY box on CL'c.3' for EDITING'
  1389. h.10=c.1'F10:'c.3'  place current 'c.2'command line into HISTORY'c.3
  1390. h.11=c.1'F11:  'c.3'Activate the 'c.2'STRING MATCH FILE SEARCH 'c.3'function'
  1391. h.12=c.1'F12:'c.2'  ACTIVATE KEYHEX 'c.3'for the next key pressed after F12'
  1392. h.13=c.1'CTRL-DOWN ARROW:'c.2' QUICK CHANGE DIR'c.3
  1393. h.14=c.1'CTRL-UP ARROW:   'c.2'DIR HISTORY RECALL'c.3
  1394. h.15=c.1'CTRL -F1:'c.3'  begin 'c.2'SELECTOR with ATTRIBUTE'c.3' search'
  1395. h.16=c.1'CTRL-TAB:'c.2'  FILENAME COMPLETION'c.3
  1396. h.17=c.1'CTRL-ENTER:'c.3'Key on cl 'c.2'NORMAL COMMAND'c.3' instead of alias'
  1397. h.18=c.1'CTRL-F2:'c.2'TOGGLE LOG ON/OFF'c.3
  1398. h.19=c.1'ALT-s:    'c.2'  TOGGLE SEARCH DEPTH'c.3
  1399. h.20=c.1'ALT-~:    'c.2'  REXX interpret'c.3
  1400. h.21=c.1'ALT-INS:  'c.2'  TOGGLE TYPE MODE'c.3
  1401. h.22=c.1'ALT- ENTER:'c.2' OPEN WPS OBJECT'c.3
  1402. h.23=c.1'UP ARROW:'c.2'   RECALL HISTORY'c.3
  1403. h.24=c.1'PAGE UP:'c.2'    HISTORY LIST'c.3
  1404.  
  1405. call vidsave
  1406. call syscls
  1407. do i=1 to 24
  1408.    say h.i;end
  1409. s=sysgetkey()
  1410. call vidrest
  1411. h.=''
  1412. return
  1413.  
  1414.  
  1415.  
  1416. /*notes:
  1417. 4/24 added alt-ins to switch between insert and overwrite modes
  1418. 4/24 added bright and flashing to color control
  1419. fix the select menu not disappearing on F9 and alt enter
  1420. 4/24 fixed select menu not disappearing  on enter
  1421. 4/26 fixed entry from alias list appearing on cl when escaped from
  1422. 4/29 tab and shft tab move forward/backarwds through menu 
  1423. 4/29 ctrl=F2 - all commands issued through blk to a log file
  1424. 5/6 each term has separate attrib select.fixed f11 search
  1425. so that [asasdasd[ with f11 works- separate f11 for each term implemented
  1426. by F11 in attrib select
  1427. log file has commands id'd by session
  1428. add list file for any selection term and individual f11 search capability
  1429. (per term),add start pick list at letter and sort lists.
  1430. generating file list added.
  1431. 5/9addedmultiple skip and fixed problem with not looking at all dirs in gtlobal search.
  1432. fixed attrib field erase problem when tabbing through fields.
  1433. 5/10 f5 gives selector to cl for editing select output
  1434. absolute later than and earlier than functions
  1435. 5/12 added means to specify actions to all sub dir or files therein without displaying a select list ie [[ tail on select term
  1436. rec global(4os2) like command alias for blkos2)
  1437. 5/13-fixed history buffer recall so that entries are not skipped.
  1438. added directory stack -store(pushd- like) via alt ->,recall list by alt up arrow once
  1439. 5/15 major prob with f11 fixed circa lines 567
  1440. fixed prob with screen not being restored if escaping from an attrib search
  1441. 5/16 fixed prob with hpfs being spread over multiple v variables in chkals
  1442. fixed conflict withdelete word to right and the dir hist function.
  1443. 5/18:problem with alias renamefixed
  1444. 5/19 added first  help screen and colorized prompt*/
  1445.