home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / kl.zip / kl.kex < prev    next >
Text File  |  1997-03-17  |  17KB  |  502 lines
  1. ** (c) Copyright International Business Machines Corporation 1994, 1996.
  2. *                  All Rights Reserved.
  3. *
  4. *          KL (KEDIT FileList) macro     (Version 2.10)
  5. *
  6. *   Function: List files and directory names that match a specified path
  7. *
  8. *   Author: Shintaroh Hori                    (Yamato Lab. IBM JAPAN)
  9. */
  10. trace off
  11.    parse arg spec
  12.    parse value strip(spec) with filespec 1 hdr +1 1 word1 parm
  13.    if hdr ='/' then do
  14.       'EDITV GETF KLIND'
  15.       if klind\=1 then Exit 0 /* Nop for normal file (i.e. Non KL FileList) */
  16.       parse upper var word1 slaopt
  17.       if slaopt ='/ENTER'   then rc=ENTER()
  18.       else if slaopt ='/EX' then do
  19.          if command() | \modifiable() then Exit 0 /* Nop */
  20.          saverc=FLEXE(parm)
  21.          'EDITV GETF KLEDIT'
  22.          if kledit \='' then do;'EDITV SETFL KLEDIT';'kedit "'kledit'"';end
  23.          rc=saverc
  24.       end
  25.       else if slaopt ='/GETCMD' then do
  26.          if command() | \modifiable() then Exit 0  /* Nop */
  27.          call GetAdjCmd parm
  28.       end
  29.       else rc = LfSla(slaopt parm)  /* real slash command */
  30.    end
  31.    else rc = FileList(filespec)
  32. Exit 1
  33. /*--------------------------------------------------------------------------*/
  34. /*       Process /ENTER Action                                              */
  35. /*--------------------------------------------------------------------------*/
  36. Enter: procedure
  37.   'sos saveline current'
  38.   'extract /cmdline/cursor/'
  39.   if cmdline.3 \='' then do; 'sos doprefix execute'; Return 1 ; end
  40.   curl = cursor.3
  41.   proc? =0
  42.  
  43.   'top';'sos topedge leftedge'
  44.   do forever
  45.      'nomsg locate altered' ; if rc \=0 then leave /* no more changed lines */
  46.      parse value ReadCmdStr() with cmdstr 1 cm1 +1
  47.      call ClrLineFlg
  48.      if cmdstr ='' | cm1 ='*' then iterate
  49.      proc?=1
  50.      if cmdstr ='='   then quit? = LfRep()
  51.      else if cm1 ='?' then quit? = LfRtr(cmdstr)
  52.      else if cm1 ='/' then quit? = LfSla(cmdstr)
  53.                       else quit? = LfCmd(cmdstr)
  54.      if quit? then leave
  55.   end
  56.  
  57.   'sos tabcmd' ; 'locate :'curl; 'sos restoreline leftedge'
  58.   if proc?  then do
  59.     'EDITV GETF KLEDIT'
  60.     if kledit \='' then do; 'EDITV SETFL KLEDIT'; 'kedit "'kledit'"'; end
  61.   end
  62.   else 'sos tabcmd doprefix'  /* No Cmd processed */
  63. Return 1 /* Process Comp */
  64.  
  65. ReadCmdStr: procedure
  66.   'EDITV GETF KLLFLEN'
  67.   'extract /curline/'
  68.   list =left(curline.3,kllflen)
  69.   hide =substr(curline.3,kllflen+1,kllflen)
  70.   dl = compare(list,hide)
  71.   if dl=0 then return '' /* no cmd entered */
  72.   'sos firstcol'
  73. * 'text' strip(hide,'T')   /* bug fix for v1.71 */
  74.   'text' hide              /* do not stip trailing blanks! */
  75.   'sos firstcol'
  76.   dh = compare(reverse(list),reverse(hide))
  77.   len = kllflen - (dl-1) -(dh-1)
  78.   cmdstr=substr(list,dl,len)
  79. Return strip(cmdstr)
  80.  
  81. LfRep: procedure
  82.   lcmd = GetCmd(1)
  83.   if lcmd='' then do; 'MSG No previous commands.'; return 1; end
  84.   call PutRsp lcmd' '
  85.   'sos cup' /* move cursor one line up */
  86.   'EDITV SETFL KLCMDNR 1' /* indicate No Cmd Recording */
  87. Return 0
  88.  
  89. LfRtr: procedure
  90.   parse arg +1 n .
  91.   if n='' then n=1
  92.   if datatype(n,'W')=0 then do;'MSG' n 'just after ? should be number';return 1;end
  93.   lcmd = GetCmd(n)
  94.   if lcmd='' then do; 'MSG No commands' n 'times before'; return 1; end
  95.   call PutRsp lcmd' '
  96. Return 0
  97.  
  98. LfSla: procedure
  99.   arg cmd +2 opt
  100.   if      cmd='/N' then do; call LfCmd arg(1) ; Return 0 /* No Quit */ ;end
  101.   call PutCmd cmd || opt
  102.   if      cmd='/S' then call LsSort opt
  103.   else if cmd='/R' then call LsRefresh opt
  104.   else if cmd='/C' then call LsChgForm opt
  105.   else if cmd='/F' then call LsRngFile opt
  106.   else if cmd='/L' then call LsRngList opt
  107.   else if cmd='/Q' then call LsQuit
  108.   else 'MSG Invalid slash command:' arg(1)
  109. Return 1  /* Quit */
  110.  
  111. GetAdjCmd: procedure
  112.   arg n .
  113.   'EDITV GETF KLCMDB KLCMD.0 KLLFLEN'
  114.   if klcmdb = '' then do; 'msg No KL command retrieved.'; Return; end
  115.   if n='+' then klcmdb= klcmdb + 1
  116.            else klcmdb= klcmdb - 1
  117.   if klcmdb =0 then klcmdb = klcmd.0
  118.   if klcmdb > klcmd.0 then klcmdb = 1
  119.   'EDITV GETF klcmd.'klcmdb
  120.   'EDITV PUTF klcmdb'
  121.   'extract /curline/'
  122.   hide =substr(curline.3,kllflen+1,kllflen)
  123.   'sos firstcol'
  124.   'text' strip(hide,'T')
  125.   'sos firstcol'
  126.   call PutRsp klcmd.klcmdb
  127. Return
  128.  
  129. LfCmd: procedure
  130.   call PutCmd arg(1)
  131.   call FLEXE arg(1)
  132. Return 0
  133.  
  134. GetCmd: procedure
  135.   arg n
  136.   'EDITV GETF klcmdl klcmd.0'
  137.   if n > klcmd.0 then Return ''
  138.   n=klcmdl-(n-1)
  139.   if n <= 0 then do; 'EDITV GET KLCMDMAX'; n=klcmdmax+n ;end
  140.   'EDITV GETF klcmd.'n
  141. Return klcmd.n
  142.  
  143. PutCmd: procedure
  144.   parse arg cmd
  145.   'EDITV GETF klcmdnr klcmdl klcmd.0'
  146.   if klcmdnr =1 then do; 'EDITV SETFL KLCMDNR'; return; end
  147.   'EDITV GET  klcmdmax'
  148.   klcmdl = klcmdl  +1
  149.   klcmd.0= klcmd.0 +1
  150.   if klcmdl > klcmdmax then klcmdl=1
  151.   if klcmd.0 <= klcmdmax then 'EDITV PUTF KLCMD.0'
  152.   'EDITV PUTF  KLCMDL'
  153.   'EDITV SETFL KLCMD.'klcmdl cmd
  154.   'EDITV SETFL KLCMDB' klcmdl+1
  155. Return
  156.  
  157. LsSort: procedure
  158.   arg opts . 1 sign +1
  159.   'EDITV GETF KLFLDS'
  160.   w=1 ; srt='Ascending'
  161.   if sign='-' then do;w=2;srt='Descending';end
  162.   else if sign= '+' then w=2
  163.   do i=w to length(opts)
  164.      fld=substr(opts,i,1)
  165.      parse var klflds dmy (fld) s b .
  166.      if b='' then do;'MSG Invalid Sort Field character('fld') specified.';Return;end
  167.      srt=srt s b
  168.   end
  169.   'extract /case/'
  170.   if case.2 ='RESPECT' then do
  171.      oc=case.1 case.2 case.3
  172.      'set case M I R'
  173.   end
  174.   ':0';'SORT *' srt
  175.   if rc=0 then 'set lineflag nonew nochange all'
  176.   if case.2 ='RESPECT' then 'set case' oc
  177.   call TopList
  178. Return
  179.  
  180. LsRngFile: procedure
  181.   arg d .
  182.   if d='+' then d=''
  183.   if d='' | d='-' then do
  184.      'extract /fileid/' ; fid=fileid.1
  185.      do until fileid.1=fid
  186.        'kedit' d
  187.        'EDITV GETF KLIND' ; if klind \=1 then Return /* Target found */
  188.        'extract /fileid/'
  189.      end
  190.      'MSG No files open except KL FileList'
  191.   end
  192.   else 'MSG Invalid Slash command(/F'd') specified.'
  193. Return
  194.  
  195. LsRngList: procedure
  196.   arg d .
  197.   if d='+' then d=''
  198.   if d='' | d='-' then do
  199.      'extract /fileid/' ; fid=fileid.1
  200.      do until fileid.1=fid
  201.        'kedit' d
  202.        'editv getf klind' ; if klind =1 then Return /* Target found */
  203.        'extract /fileid/'
  204.      end
  205.      'MSG No other KL FileList'
  206.   end
  207.   else 'MSG Invalid Slash command(/L'd') specified.'
  208. Return
  209.  
  210. LsRefresh: procedure
  211.   arg glb +1
  212.   if glb='G' then do
  213.     'EDITV GET  KLFNLEN KLFELEN KLDTLEN KLTMLEN'
  214.     'EDITV GETF KLLFLEN'
  215.     call SetScrnFld
  216.   end
  217.   'EDITV GETF KLSPEC.0' ; 'EDITV SETFL KLSPEC.0'
  218.   'top' ; 'DELETE *'
  219.    do i=1 to klspec.0
  220.      'EDITV GETF KLSPEC.'i
  221.       call FileList klspec.i '/ADD'
  222.    end
  223. Return
  224.  
  225. LsChgForm: procedure
  226.   arg glb nl el .
  227.   if glb\='G' then do; el=nl; nl=glb; end
  228.   if nl='' then do
  229.      'EDITV GET KLFNLEN KLFELEN'
  230.      'EDITV GETF KLLFLEN KLDTLEN KLTMLEN'
  231.   end
  232.   else do
  233.      'EDITV GETF KLLFLEN KLFNLEN KLFELEN KLDTLEN KLTMLEN'
  234.      if datatype(nl,'W') then do
  235.         if pos(left(nl,1),'+-')=0 then klfnlen=nl;else klfnlen=klfnlen+nl
  236.      end
  237.      if datatype(el,'W') then do
  238.         if pos(left(el,1),'+-')=0 then klfelen=el;else klfelen=klfelen+el
  239.      end
  240.   end
  241.   call SetScrnFld
  242.   if glb='G' then 'EDITV PUT KLFNLEN KLFELEN KLFLDS'
  243.   call LsRefresh
  244. Return
  245.  
  246. LsQuit: procedure
  247. /*'editv get klln' * ì∞Ä╥: ûxü@ÉTæ╛ÿY */
  248. /*klln=klln-1;if klln < 0 then klln=0 */
  249. /*'editv put klln' */
  250.   'qquit' ; 'cursor home'
  251. Return
  252. /*--------------------------------------------------------------------------*/
  253. /*                                                                          */
  254. /*--------------------------------------------------------------------------*/
  255. FileList: procedure
  256.   parse arg spec '/' opt
  257.   'EDITV GETF KLIND'
  258.   opt = '/' || translate(opt)
  259.   new?=1 ; lvl=0
  260.   if pos('/D',opt)\=0 then do
  261.      parse var opt . '/D' lvl '/' .
  262.      lvl= strip(lvl)
  263.      if lvl = '' then lvl=256
  264.      else if datatype(lvl,'W')=0 then do;'MSG Number must follow /D.';return 2;end
  265.   end
  266.   if wordpos('/ADD',opt)\=0 & klind=1 then new?=0
  267.   if new? then call OpenList /* for a new FileList */ ; else ':*'
  268.   'macro KLDIR' new? lvl spec
  269.   'EDITV GET  KLEXITI'
  270.   if klexiti \='' then do
  271.     'EDITV SETLF KLCMDNR 1'/* No Cmd Recording while executing Exit macro */
  272.     'nomsg' klexiti
  273.     'EDITV SETLF KLCMDNR'  /* Resume Cmd Recording */
  274.     'set alt 0 0'
  275.   end
  276. Return 0
  277.  
  278. OpenList: procedure
  279.   'EDITV GET KLLN KLDIR'
  280.   if klln='' then do /* Initialize KL variables */
  281.      klln=0
  282.      kldir = directory.1()
  283.      if right(kldir,1) \='\' then kldir=kldir'\'
  284.      'EDITV PUT KLLN KLDIR'
  285.      parse value ReadProf() with klfnlen klfelen klrsvln.0 kldtlen kltmlen
  286.   end
  287.   else 'editv get klfnlen klfelen klrsvln.0 kldtlen kltmlen'
  288.   klln  = klln+1
  289.   klfid = kldir'_D_I_R_.'klln
  290.   'KEDIT' klfid '(NOMSG NEW' ;'set msgmode on'; 'set wrap off'
  291.   'set cmdline on'; 'set idline  off'; 'set prefix  off'; 'set inputmode off'
  292.   do i=1 to klrsvln.0; 'editv get klrsvln.'i;'set reserved' klrsvln.i;end
  293.   'extract /pscreen'
  294.   klind = 1
  295.   kllid = klln
  296.   kllflen = 2 * pscreen.2    /* List Field length */
  297.  
  298.   'EDITV PUT  KLLN'
  299.   'EDITV SETF KLCMDL 0 KLCMD.0 0'
  300.   'EDITV PUTF KLIND KLLID KLLFLEN KLFID KLDTLEN KLTMLEN'
  301. SetScrnFld: /* also called from LsChgFrom */
  302.   ne=10+klfnlen-1; es=ne+2; ee=es+klfelen-1; if klfelen=0 then as=es; else as=ee+2
  303.   dtl=kldtlen+kltmlen+1  /* prev: 8+5+1=14 */
  304.   klflds='N 10' ne 'E' es ee 'A' as as+(5-1) 'S' as+6 as+6+(9-1)
  305.   klflds=klflds 'D' as+16 as+16+(dtl-1) 'I' as+16+dtl+1 as+16+dtl+1+(2-1) 'R' as+20+dtl kllflen
  306.   'EDITV PUTF KLFNLEN KLFELEN KLFLDS'
  307. Return
  308.  
  309. TopList: procedure
  310.   'EDITV GETF KLSPEC.0'
  311.   'sos tabcmd' ; 'top'
  312.   'extract /curline/'
  313.   dn = curline.2 - klspec.0 -2 ; if dn \=0 then 'down' dn
  314. Return
  315.  
  316. ClrLineFlg: procedure
  317.   'extract /curline/cursor/'
  318.   diff = curline.2 - cursor.1
  319.   'sos tabcmd'
  320.   'locate :'cursor.3
  321.   'set lineflag nochange' /* This command only worked at cmd line. -> Bug ? */
  322.   if diff > 0 then 'down' diff ; else if diff\=0 then 'up' (-diff)
  323.   'cursor home'
  324. Return
  325.  
  326. PutRsp: procedure
  327.   parse arg rsp,msg
  328.   'sos firstcol'
  329.   'text' rsp
  330.   if msg \='' then do
  331.      'EDITV GETF KLFLDS'
  332.      parse var klflds . 'A' col .
  333.      'sos firstcol'
  334.      'cursor =' col
  335.      'text' msg
  336.   end
  337.   'sos firstcol'
  338. Return
  339. /*--------------------------------------------------------------------------*/
  340. /*       Process /EX function from KL FileList                              */
  341. /*--------------------------------------------------------------------------*/
  342. FLEXE: procedure
  343.   parse arg str
  344.   parse value SlaSubs(str) with dir? svdrv svpath'/'cmd0 str
  345.   cmd = translate(cmd0) /* upper case */
  346.   str = strip(str)
  347.   msg =''; mac=0
  348.   if wordpos(cmd,'X KL K XEDIT KEDIT') \=0 then rc=Edit(dir?,cmd,str)
  349.   else if wordpos(cmd,'DEL ERASE')  \=0 then parse value Erase(dir?,cmd,str) with rc msg
  350.   else if wordpos(cmd,'R REN')      \=0 then parse value Ren(str) with rc msg
  351.   else if wordpos(cmd,'DOS DOSN DOSQ') \=0 then ''cmd str
  352.   else if wordpos(cmd,'MAC MACRO') \=0 then do
  353.     mac=1
  354.     'EDITV GETF KLFID'
  355.     '' str
  356.     'extract /fileid/'; newfid=fileid.1
  357.   end
  358.   else do;
  359.      'editv get klxmode klsyn'
  360.      if klsyn=1  then do
  361.         'EDITV GET KLSYN.'cmd0
  362.         parse value KLSYN.cmd0 with cmd0 subcmd ';' trail
  363.         if cmd0 \='' then ''cmd0 subcmd str trail
  364.         else ''klxmode cmd str
  365.      end
  366.      else ''klxmode cmd str
  367.   end
  368.   if rc=0 then rsp='*'; else rsp='*'rc
  369.   if svdrv\='\\' then do  /* Non-UNC style spec */
  370.     'CHDIR "'svpath'"'  ; 'CHDRIVE' svdrv      /* restore path & drv  */
  371.   end
  372.   if mac & (klfid\=newfid) then do;'kedit' klfid; 'cursor home'; end
  373.   call PutRsp rsp,msg
  374.   call ClrLineFlg
  375.   if mac & (klfid\=newfid) then 'kedit' newfid
  376.  
  377. Return 1
  378. /*---------------------------------------------------------*/
  379. /*                                                         */
  380. /*---------------------------------------------------------*/
  381. SlaSubs: procedure
  382.   'extract /curline/directory'
  383.   'editv getf klflds'
  384.   parse var klflds . ns ne . es ee . as ae . ss se . ds de . is ie . rs re .
  385.   fn=strip(substr(curline.3,ns,ne-ns+1),'T')
  386.   fe=strip(substr(curline.3,es,ee-es+1),'T')
  387.   at=substr(curline.3,as,ae-as+1);if pos('<dir>',at)=0 then dir?=0;else dir?=1
  388.   id=substr(curline.3,is,ie-is+1)
  389.   rpath= strip(substr(curline.3,rs,re-rs+1))
  390.   sid = substr(id,2)
  391.   'EDITV GETF KLSPEC.'sid 'KLSPEC.'sid'.D  KLSPEC.'sid'.P'
  392.   drv  =KLSPEC.sid.D
  393.   hpath=KLSPEC.sid.P  ; path = hpath || rpath
  394.   if fe='' then fnfe= fn ; else fnfe =fn'.'fe
  395.   fulfid = drv || path || fnfe
  396.   slacmd = '/F /N /O /P /H /R /E /D //'
  397.  
  398.   parse arg str
  399.   if pos('/',str)=0 then str = str '/'
  400.   cmd =''
  401.   do forever
  402.      pos = pos('/',str) ;if pos=0 then do; cmd = cmd||str; leave; end
  403.      sla = translate(substr(str,pos,2))  /* upper case */
  404.      if wordpos(sla,slacmd)=0 then do;len=1; sub=fulfid; end
  405.      else do
  406.         len=2
  407.         if      sla='/F' then sub=fnfe  ; else if sla='/N' then sub=fn
  408.         else if sla='/O' then sub=''    ; else if sla='/P' then sub=path
  409.         else if sla='/H' then sub=hpath ; else if sla='/R' then sub=rpath
  410.         else if sla='/E' then sub=fe    ; else if sla='/D' then sub=drv
  411.                          else sub='/'
  412.      end
  413.      pre =  substr(str,1,pos-1)
  414.      str =  substr(str,pos+len)
  415.      cmd = cmd || pre || sub
  416.      if sla = '/O' then do; cmd=cmd || str; leave; end
  417.   end
  418.   if drv='\\' then svdrv=drv   /* UNC spec */
  419.   else do
  420.     svdrv = left(directory.1,2)
  421.     if svdrv \= drv then do
  422.        'ChDrive' drv
  423.        'extract /directory'
  424.     end
  425.     svpath=substr(directory.1,3)
  426.     if path \= '\' then path= left(path,length(path)-1)
  427.     'ChDir "'path'"'  /* chg cur dir */
  428.   end
  429.   drop sub.
  430. Return dir? svdrv svpath || '/' || cmd
  431. /*---------------------------------------------------------*/
  432. /*                                                         */
  433. /*---------------------------------------------------------*/
  434. Edit: procedure
  435.   parse arg dir?,cmd,fileid
  436.   'EDITV GETF KLFID'
  437.   if dir? | cmd='KL' then rc = FileList(fileid)
  438.                      else 'kedit "'fileid'"'
  439.  
  440.   retc=rc ; if rc=0 then open = fileid.1(); else open=''
  441.   'kedit' klfid; 'cursor home' /* get back to original KL FileList */
  442.   'EDITV SETFL KLEDIT' open   /* indicate file(s) opened */
  443. Return retc
  444.  
  445. Erase: procedure
  446.   parse arg dir?,cmd,str
  447.   if dir? then do
  448.     'DOSQ RD "'str'"'
  449.     if rc=0 then rsp='*** Directory Erased'; else rsp=''
  450.   end
  451.   else do
  452.     'DOSQ ERASE "'str'"'
  453.     if rc=0 then rsp='*** File Erased '; else rsp=''
  454.   end
  455. Return rc rsp
  456.  
  457. Ren: procedure
  458.   parse arg str
  459.   'DOSQ REN' str
  460.   if rc=0 then rsp='*** File Renamed'; else rsp=''
  461. Return rc rsp
  462. /*---------------------------------------------------------*/
  463. /*                                                         */
  464. /*---------------------------------------------------------*/
  465. ReadProf: procedure
  466.   klxmode='DOSN';klfnlen=20;klfelen=8;klcmdmax=20;klrsvln.0=0;kltmp=''/* KL defaults */
  467.   klexiti=''; year2k=1;timesec=1;  kldtlen=10; kltmlen=8  /* KL defaults */
  468.   klsyn=0
  469.   r=0; 'extract /defprofile' ; prof=defprofile.1
  470.   if pos(':\',prof)\=0 then do
  471.      c=lastpos('\',prof); prof = left(prof,c) || 'KLPROF.KL'
  472.      'kedit' prof '(NOMSG NOPROFILE'; 'zone 1 1' ; 'set wrap off'
  473.      do forever
  474.         'locate ~/;/' ; if rc\=0 then leave
  475.         'extract /curline'; parse var curline.3 hdr data;hdr=upper(hdr)
  476.         if      hdr='KLTMP' then do
  477.                               parse value strip(data) with 2 cln +1 1 kltmp .
  478.                               if cln\=':' then kltmp=dosenv(kltmp)
  479.                               if right(kltmp,1)\='\' then kltmp=kltmp'\'
  480.                             end
  481.         else if hdr='FNLEN'    then klfnlen =strip(data)
  482.         else if hdr='FELEN'    then klfelen =strip(data)
  483.         else if hdr='YEAR2000' then year2k  =strip(data)
  484.         else if hdr='TIMESEC'  then timesec =strip(data)
  485.         else if hdr='BUFLEN'   then klcmdmax=strip(data)
  486.         else if hdr='XMODE'    then klxmode =strip(data)
  487.         else if hdr='INITEXIT' then klexiti =strip(data)
  488.         else if hdr='KLCMD'    then do
  489.                                  parse value strip(data) with syn cmd
  490.                                  'editv setl KLSYN.'syn cmd
  491.                                  klsyn =1
  492.                                end
  493.         else if hdr='RSVLINE'  then do;r=r+1;klrsvln.r =strip(data);end
  494.      end
  495.      klrsvln.0 = r; klsyn.0 = s
  496.      'QQUIT'
  497.   end
  498.   if year2k=0 then kldtlen=8; if timesec=0 then kltmlen=5;
  499.   'editv PUT klfnlen klfelen klcmdmax klxmode klexiti klsyn kltmp kldtlen kltmlen'
  500.    do i=0 to r; 'editv PUT klrsvln.'i ;end
  501. Return klfnlen klfelen klrsvln.0 kldtlen kltmlen
  502.