home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / kl.zip / kldir.kex < prev    next >
Text File  |  1997-03-17  |  4KB  |  122 lines
  1. /* (c) Copyright International Business Machines Corporation 1994, 1997.
  2. *                  All rights Reserved.
  3. *
  4. *   KLDIR:  Subroutine macro of  KL (KEDIT FileList) macro  (Ver 2.10)
  5. *
  6. *   Requirements: KLUTIL.DLL
  7. *
  8. *   Author: Shintaroh Hori                  (Yamato Lab. IBM JAPAN)
  9. */
  10.   parse arg new? lvl spec
  11.   if      lvl=0   then lvlopt=''
  12.   else if lvl=256 then lvlopt='/D'
  13.                   else lvlopt='/D'lvl
  14.  
  15.   call LoadUtil
  16.   signal on syntax
  17.   rc=KLFILEUTIL(spec, 'FSPEC', 'PATH')  /* resolve spec to full spec */
  18.   signal off syntax
  19.   drv =left(path,2)
  20.   path=substr(path,3)
  21.  
  22.   'EDITV GETF KLSPEC.0 KLFNLEN KLFELEN KLLFLEN KLDTLEN KLTMLEN'
  23.  
  24.   if klspec.0 ='' then klspec.0=0
  25.   sid  = klspec.0 + 1
  26.   'EDITV SETLF KLSPEC.0' sid
  27.   'EDITV SETLF KLSPEC.'sid fspec lvlopt
  28.   'EDITV SETLF KLSPEC.'sid'.D' drv
  29.   'EDITV SETLF KLSPEC.'sid'.P' path
  30.  
  31.   parse value GetTempFileID() with tmpdir tmpfile
  32.   if tmpfile='' then Return 3 'KL: Temporary file cannot be created.'
  33.   tmpname= substr(tmpfile, length(tmpdir)+1)
  34.  
  35.   DIR.0=0
  36.   numlist=kllflen klfnlen klfelen (kldtlen<>8) (kltmlen<>5) lvl
  37.   parse value KLFILEUTIL(fspec, numlist, '#'sid, tmpdir, tmpname,'0','DIR.') ,
  38.         with retc num
  39.   if num\=0 then 'nomsg get' tmpfile
  40.   'dosq erase' tmpfile
  41.  
  42.   if retc=0 then do
  43.      call DispSpec num fspec'  'lvlopt
  44.      if new? then call TopList    /* for a new FileList */
  45.   end
  46.   else do
  47.      if new? then 'QQUIT'
  48.      if retc=2       then msg='KL: No files for "'spec'"'
  49.      else if retc=5  then msg='KL: Failed to create a work file in "'tmpdir'". The disk may not have enough space.'
  50.      else if retc\=0 then msg='KL: Fatal error from KLUTIL.DLL (rc='retc
  51.      'MSG' msg  /* display error msg */
  52.      retc = 3
  53.   end
  54. Exit retc
  55.  
  56. DispSpec: procedure expose sid klfnlen klfelen kllflen kldtlen kltmlen
  57.   parse arg n spec
  58.   'extract /pscreen'
  59.   cnt = n 'Dir/Files'
  60.   'set reserved' sid left('#'sid'='spec,pscreen.2 - length(cnt)-1) cnt
  61.   if klfelen=0 then fidl=left('Name&Ext',klfnlen)
  62.              else fidl=left('FileName',klfnlen) left('Ext',klfelen)
  63.   'set reserved' sid+1 left('Cmd_Area',8) fidl 'Attrb' right('Size',9),
  64.                      center('Date',kldtlen) center('Time',kltmlen) 'ID RelPath'
  65.   'set alt 0 0'
  66.   'set lineflag nonew nochange all'
  67. Return
  68.  
  69. TopList: procedure
  70.   'EDITV GETF KLSPEC.0'
  71.   'sos tabcmd' ; 'top'
  72.   'extract /curline/'
  73.   dn = curline.2 - klspec.0 -2 ; if dn \=0 then 'down' dn
  74. Return
  75.  
  76. GetTempFileID: procedure
  77.   'EDITV GET KLTMP'
  78.   fid = 'KL!!????.KL!'
  79.   if kltmp\=''  then do
  80.      tmpfile=kltmp''fid
  81.      if NoSpace(left(kltmp,1)) then kltmp=''
  82.      else do
  83.        tmpfile= SysTempFileName(tmpfile)
  84.        if tmpfile='' then kltmp='' /* use root of local drives ... */
  85.      end
  86.   end
  87.   if kltmp=''   then do
  88.      drvlist= KlFileUtil() SysDriveMap('C','LOCAL')
  89.      do i=1 to words(drvlist)
  90.        drv = word(drvlist,i)
  91.        if NoSpace(drv) then iterate
  92.        kltmp=drv'\'
  93.        tmpfile=kltmp''fid
  94.        tmpfile=SysTempFileName(tmpfile)
  95.        if tmpfile \='' then leave
  96.      end
  97.      'EDITV PUT KLTMP'  /* save for the next use */
  98.   end
  99. Return kltmp tmpfile
  100.  
  101. NoSpace: procedure
  102.   arg drv
  103.   parse value SysDriveInfo(drv) with . free .
  104.   if free\='' & free > 32768 then return 0
  105. Return 1
  106.  
  107.  
  108. LoadUtil: procedure
  109.   /* RxFuncAdd always returns 1. It's a bug. */
  110.   if RxFuncQuery('KLFILEUTIL') then
  111.      rc=RxFuncAdd('KLFILEUTIL', 'KLUTIL','KLFILEUTIL')
  112.   funcs ='SysTempFileName SysDriveMap SysDriveInfo'
  113.   do i=1 to words(funcs)
  114.     f = word(funcs,i)
  115.     if RxFuncQuery(f) then rc=RxFuncAdd(f, 'RexxUtil',f)
  116.   end
  117. Return
  118.  
  119. syntax:
  120.   'MSG KLUTIL.DLL is not loaded under a path in LIBPATH.'
  121. Exit 3
  122.