home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 5 Edit
/
05-Edit.zip
/
kl.zip
/
KL140L.ZIP
/
KLDIR.KEX
< prev
next >
Wrap
Text File
|
1997-03-16
|
4KB
|
126 lines
/* KLDIR: Subroutine macro of KL (KEDIT FileList) macro (Ver 1.4)
*
* Function: To insert information lines for target files in a current KL list.
*
* Author: Shintaroh Hori ( Yamato Lab. IBM JAPAN )
*/
parse arg new? lvl spec
if \ LoadRxU() then do; 'MSG Failed to load SysFileTree function of REXXUTIL.'; exit 10;end
if lvl=0 then lvlopt=''; else lvlopt='/D'lvl
spec = strip(spec)
if spec ='' then spec='*.*'
else do
if right(spec,1)='\' | right(spec,1)=':' then spec=spec'*.*'
/* if includes no wild char and it is not a file, then assume it directry */
else if pos('*',spec)=0 & pos('?',spec)=0 & stream(spec,'c','query exist')=''
then spec=spec'\*.*'
end
'extract /directory'; cdirdrv= left(directory.1,2)
drv =filespec('DRIVE',spec);if drv ='' then drv =cdirdrv
path=filespec('PATH', spec)
if left(path,1)\='\' then do
if drv=cdirdrv then do
if right(directory.1,1)='\' then path=substr(directory.1,3) || path
else path=substr(directory.1,3) || '\'path
end
else do
'nomsg chdrive' drv;if rc\=0 then do;'MSG Drive' drv 'does not exist.';exit 11;end
'extract /directory'
if right(directory.1,1)='\' then path=substr(directory.1,3) || path
else path=substr(directory.1,3) || '\'path
'nomsg chdrive' cdirdrv
end
end
spec = drv || path || filespec('NAME',spec)
'EDITV GETF KLSPEC.0 KLFNLEN KLFELEN KLLFLEN'
if klspec.0 ='' then klspec.0=0
sid = klspec.0 + 1
'EDITV SETLF KLSPEC.0' sid
'EDITV SETLF KLSPEC.'sid spec lvlopt
'EDITV SETLF KLSPEC.'sid'.D' drv
'EDITV SETLF KLSPEC.'sid'.P' path
homedir = filespec('path',spec)
speclist=spec
e=0 ; cnt=0
do i=0 to lvl
slist=speclist ; speclist =''
do n=1 until slist=''
parse var slist fspec '/' slist
parse value filespec('path',fspec) with (homedir) subdir
if i \=0 then do
'MSG Making a list of files for "'fspec'". Please wait ....';'refresh'
end
parse value PutDFlist(lvl-i,fspec,subdir) with rc num list
if rc =0 then do; cnt=cnt+num; speclist= speclist || list; end
else do;if rc=3 then leave i; e=e+1; err.e =list; end
end
if speclist = '' then leave
end
if rc=0 | rc=2 & lvl >0 then do
call DispSpec cnt spec' 'lvlopt
if new? then call TopList /* for a new FileList */
if e \=0 then do i=1 to e; 'MSG' err.e;end
retc= 0
end
else do
if new? then 'QQUIT'
'MSG' list /* display error msg */
retc = 3
end
Exit retc
LoadRxU: procedure
if RxFuncQuery('SysFileTree')=0 then return 1 /* already registered */
if RxFuncAdd('SysFileTree', 'RexxUtil','SysFileTree') \=0 then Return 0
Return 1
PutDFlist: procedure expose sid klfnlen klfelen kllflen
parse arg m,fspec,subdir
if SysFileTree(fspec,'FL','BT') \=0 then Return 3 'SysFileTree function failed.'
if fl.0 =0 then Return 2 '0 No files that meet spec['fspec']'
dirs=''
do i=1 to fl.0
parse var fl.i yy'/'mm'/'dd'/'hh'/'ff size a fid
parse value filespec('NAME',fid) with fn'.'fe
list = copies(' ',8) left(fn,klfnlen)'.'left(fe,klfelen) Attr(a),
right(size,9) yy'-'mm'-'dd hh':'ff '#'sid subdir
'input' left(list,kllflen) || list
if m \=0 & pos('D',a) \=0 then do
fid = strip(fid)
dirs=dirs || fid'\*.*' || '/'
end
end
Return 0 fl.0 dirs
Attr: procedure
arg a
if pos('D',a) =0 then do
attr=' 'left(a,1) || substr(a,3)
attr= translate(attr,'ahrs','AHRS')
end
else attr= '<dir>'
Return attr
DispSpec: procedure expose sid klfnlen klfelen kllflen
parse arg n spec
'extract /pscreen'
cnt = n 'Dir/Files '
'set reserved' sid left('#'sid'='spec,pscreen.2 - length(cnt)-1) cnt
'set reserved' sid+1 left('Cmd_Area',8) left('FileName',klfnlen),
left('Ext',klfelen) 'Attrb' right('Size',9),
left(' Date',8) left('Time',5) 'ID RelPath'
'set alt 0 0'
'set lineflag nonew nochange all'
Return
TopList: procedure
'EDITV GETF KLSPEC.0'
'sos tabcmd' ; 'top'
'extract /curline/'
dn = curline.2 - klspec.0 -2 ; if dn \=0 then 'down' dn
Return