home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / kl.zip / KL140L.ZIP / KLDIR.KEX < prev    next >
Text File  |  1997-03-16  |  4KB  |  126 lines
  1. /*  KLDIR:  Subroutine macro of  KL (KEDIT FileList) macro  (Ver 1.4)
  2. *
  3. *   Function: To insert information lines for target files in a current KL list.
  4. *
  5. *   Author: Shintaroh Hori                     ( Yamato Lab. IBM JAPAN )
  6. */
  7.   parse arg new? lvl spec
  8.   if \ LoadRxU() then do; 'MSG Failed to load SysFileTree function of REXXUTIL.'; exit 10;end
  9.   if lvl=0 then lvlopt=''; else lvlopt='/D'lvl
  10.   spec = strip(spec)
  11.   if spec ='' then spec='*.*'
  12.   else do
  13.     if right(spec,1)='\' | right(spec,1)=':' then spec=spec'*.*'
  14.     /* if includes no wild char and it is not a file, then assume it directry */
  15.     else if pos('*',spec)=0 & pos('?',spec)=0 & stream(spec,'c','query exist')=''
  16.             then spec=spec'\*.*'
  17.   end
  18.   'extract /directory'; cdirdrv= left(directory.1,2)
  19.   drv =filespec('DRIVE',spec);if drv ='' then drv =cdirdrv
  20.   path=filespec('PATH', spec)
  21.   if left(path,1)\='\' then do
  22.      if drv=cdirdrv then do
  23.        if right(directory.1,1)='\' then path=substr(directory.1,3) ||    path
  24.                                    else path=substr(directory.1,3) || '\'path
  25.      end
  26.      else do
  27.        'nomsg chdrive' drv;if rc\=0 then do;'MSG Drive' drv 'does not exist.';exit 11;end
  28.        'extract /directory'
  29.        if right(directory.1,1)='\' then path=substr(directory.1,3) ||    path
  30.                                    else path=substr(directory.1,3) || '\'path
  31.        'nomsg chdrive' cdirdrv
  32.      end
  33.   end
  34.   spec = drv || path || filespec('NAME',spec)
  35.  
  36.   'EDITV GETF KLSPEC.0 KLFNLEN KLFELEN KLLFLEN'
  37.  
  38.   if klspec.0 ='' then klspec.0=0
  39.   sid  = klspec.0 + 1
  40.   'EDITV SETLF KLSPEC.0' sid
  41.   'EDITV SETLF KLSPEC.'sid spec lvlopt
  42.   'EDITV SETLF KLSPEC.'sid'.D' drv
  43.   'EDITV SETLF KLSPEC.'sid'.P' path
  44.  
  45.   homedir = filespec('path',spec)
  46.   speclist=spec
  47.   e=0 ; cnt=0
  48.   do i=0 to lvl
  49.     slist=speclist  ; speclist =''
  50.     do n=1 until slist=''
  51.        parse var slist fspec '/' slist
  52.        parse value filespec('path',fspec) with (homedir) subdir
  53.        if i \=0 then do
  54.          'MSG Making a list of files for "'fspec'".   Please wait ....';'refresh'
  55.        end
  56.        parse value PutDFlist(lvl-i,fspec,subdir) with rc num list
  57.        if rc =0 then do; cnt=cnt+num; speclist= speclist || list; end
  58.                 else do;if rc=3 then leave i; e=e+1; err.e =list; end
  59.     end
  60.     if speclist = '' then leave
  61.   end
  62.  
  63.   if rc=0 | rc=2 & lvl >0   then do
  64.      call DispSpec cnt spec'   'lvlopt
  65.      if new? then call TopList    /* for a new FileList */
  66.      if e \=0 then do i=1 to e; 'MSG' err.e;end
  67.      retc= 0
  68.   end
  69.   else do
  70.      if new? then 'QQUIT'
  71.      'MSG' list /* display error msg */
  72.      retc = 3
  73.   end
  74. Exit retc
  75.  
  76. LoadRxU: procedure
  77.   if RxFuncQuery('SysFileTree')=0 then return 1 /* already registered */
  78.   if RxFuncAdd('SysFileTree', 'RexxUtil','SysFileTree') \=0 then Return 0
  79. Return 1
  80.  
  81. PutDFlist: procedure expose sid klfnlen klfelen kllflen
  82.   parse arg m,fspec,subdir
  83.   if SysFileTree(fspec,'FL','BT') \=0 then Return 3 'SysFileTree function failed.'
  84.   if fl.0 =0 then Return 2 '0 No files that meet spec['fspec']'
  85.   dirs=''
  86.   do i=1 to fl.0
  87.      parse var fl.i yy'/'mm'/'dd'/'hh'/'ff  size a fid
  88.      parse value filespec('NAME',fid) with fn'.'fe
  89.      list = copies(' ',8) left(fn,klfnlen)'.'left(fe,klfelen) Attr(a),
  90.             right(size,9) yy'-'mm'-'dd hh':'ff '#'sid subdir
  91.      'input' left(list,kllflen) || list
  92.      if m \=0 & pos('D',a) \=0 then do
  93.         fid = strip(fid)
  94.         dirs=dirs || fid'\*.*' || '/'
  95.      end
  96.   end
  97. Return 0 fl.0 dirs
  98.  
  99. Attr: procedure
  100.   arg a
  101.   if pos('D',a) =0 then do
  102.      attr=' 'left(a,1) || substr(a,3)
  103.      attr= translate(attr,'ahrs','AHRS')
  104.   end
  105.   else attr= '<dir>'
  106. Return attr
  107.  
  108. DispSpec: procedure expose sid klfnlen klfelen kllflen
  109.   parse arg n spec
  110.   'extract /pscreen'
  111.   cnt = n 'Dir/Files '
  112.   'set reserved' sid left('#'sid'='spec,pscreen.2 - length(cnt)-1) cnt
  113.   'set reserved' sid+1 left('Cmd_Area',8) left('FileName',klfnlen),
  114.                        left('Ext',klfelen) 'Attrb' right('Size',9),
  115.                        left('  Date',8) left('Time',5) 'ID RelPath'
  116.   'set alt 0 0'
  117.   'set lineflag nonew nochange all'
  118. Return
  119.  
  120. TopList: procedure
  121.   'EDITV GETF KLSPEC.0'
  122.   'sos tabcmd' ; 'top'
  123.   'extract /curline/'
  124.   dn = curline.2 - klspec.0 -2 ; if dn \=0 then 'down' dn
  125. Return
  126.