home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / kl.zip / KL140L.ZIP / KL.KEX < prev    next >
Text File  |  1997-03-16  |  14KB  |  427 lines
  1. *******************************************************************************
  2. *  CAUTION!!!                                                                 *
  3. *      This is a KL.KEX macro for users with KEDIT v5.00P1 or earlier, and    *
  4. *      will not be maintained in future.                                      *
  5. *******************************************************************************
  6. **         KL (KEDIT FileList) macro     (Version 1.4)
  7. *
  8. *   Function: List files and directory names that match a specified path
  9. *
  10. *   Author: Shintaroh Hori                     ( Yamato Lab. IBM JAPAN )
  11. */
  12. trace off
  13.    parse arg filespec  1 hdr +1 1 word1 parm
  14.    if hdr ='/' then do
  15.       'EDITV GETF KLIND'
  16.       if klind\=1 then Exit 0 /* Nop for normal file (i.e. Non KL FileList) */
  17.       parse upper var word1 slaopt
  18.       if slaopt ='/ENTER'   then rc=ENTER()
  19.       else if slaopt ='/EX' then do
  20.          if command() then Exit 0 /* Nop */
  21.          saverc=FLEXE(parm)
  22.          'EDITV GETF KLEDIT'
  23.          if kledit \='' then do;'EDITV SETFL KLEDIT';'kedit "'kledit'"';end
  24.          rc=saverc
  25.       end
  26.       else if slaopt ='/GETCMD' then do
  27.          if command() then Exit 0  /* Nop */
  28.          call GetAdjCmd parm
  29.       end
  30.       else rc = LfSla(slaopt)  /* real slash command */
  31.    end
  32.    else rc = FileList(filespec)
  33. Exit 1
  34. /*--------------------------------------------------------------------------*/
  35. /*       Process /ENTER Action                                              */
  36. /*--------------------------------------------------------------------------*/
  37. Enter: procedure
  38.   'sos saveline current'
  39.   'extract /cmdline/cursor/'
  40.   if cmdline.3 \='' then do; 'sos doprefix execute'; Return 1 ; end
  41.   curl = cursor.3
  42.   proc? =0
  43.  
  44.   'top';'sos topedge leftedge'
  45.   do forever
  46.      'nomsg locate altered' ; if rc \=0 then leave /* no more changed lines */
  47.      parse value ReadCmdStr() with cmdstr 1 cm1 +1
  48.      call ClrLineFlg
  49.      if cmdstr ='' | cm1 ='*' then iterate
  50.      proc?=1
  51.      if cmdstr ='='   then quit? = LfRep()
  52.      else if cm1 ='?' then quit? = LfRtr(cmdstr)
  53.      else if cm1 ='/' then quit? = LfSla(word(cmdstr,1))
  54.                       else quit? = LfCmd(cmdstr)
  55.      if quit? then leave
  56.   end
  57.  
  58.   'sos tabcmd' ; 'locate :'curl; 'sos restoreline leftedge'
  59.   if proc?  then do
  60.     'EDITV GETF KLEDIT'
  61.     if kledit \='' then do; 'EDITV SETFL KLEDIT'; 'kedit "'kledit'"'; end
  62.   end
  63.   else 'sos tabcmd doprefix'  /* No Cmd processed */
  64. Return 1 /* Process Comp */
  65.  
  66. ReadCmdStr: procedure
  67.   'EDITV GETF KLLFLEN'
  68.   'extract /curline/'
  69.   list =left(curline.3,kllflen)
  70.   hide =substr(curline.3,kllflen+1,kllflen)
  71.   dl = compare(list,hide)
  72.   if dl=0 then return '' /* no cmd entered */
  73.   'sos firstcol'
  74.   'text' strip(hide,'T')
  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='/F' then call LsRngFile opt
  104.   else if cmd='/L' then call LsRngList opt
  105.   else if cmd='/R' then call LsRefresh
  106.   else if cmd='/Q' then call LsQuit
  107.   else 'MSG Invalid slash command:' arg(1)
  108. Return 1  /* Quit */
  109.  
  110. GetAdjCmd: procedure
  111.   arg n .
  112.   'EDITV GETF KLCMDB KLCMD.0 KLLFLEN'
  113.   if klcmdb = '' then do; 'msg No KL command retrieved.'; Return; end
  114.   if n='+' then klcmdb= klcmdb + 1
  115.            else klcmdb= klcmdb - 1
  116.   if klcmdb =0 then klcmdb = klcmd.0
  117.   if klcmdb > klcmd.0 then klcmdb = 1
  118.   'EDITV GETF klcmd.'klcmdb
  119.   'EDITV PUTF klcmdb'
  120.   'extract /curline/'
  121.   hide =substr(curline.3,kllflen+1,kllflen)
  122.   'sos firstcol'
  123.   'text' strip(hide,'T')
  124.   'sos firstcol'
  125.   call PutRsp klcmd.klcmdb
  126. Return
  127.  
  128. LfCmd: procedure
  129.   call PutCmd arg(1)
  130.   call FLEXE arg(1)
  131. Return 0
  132.  
  133. GetCmd: procedure
  134.   arg n
  135.   'EDITV GETF klcmdl klcmd.0'
  136.   if n > klcmd.0 then Return ''
  137.   n=klcmdl-(n-1)
  138.   if n <= 0 then do; 'EDITV GET KLCMDMAX'; n=klcmdmax+n ;end
  139.   'EDITV GETF klcmd.'n
  140. Return klcmd.n
  141.  
  142. PutCmd: procedure
  143.   parse arg cmd
  144.   'EDITV GETF klcmdnr klcmdl klcmd.0'
  145.   if klcmdnr =1 then do; 'EDITV SETFL KLCMDNR'; return; end
  146.   'EDITV GET  klcmdmax'
  147.   klcmdl = klcmdl  +1
  148.   klcmd.0= klcmd.0 +1
  149.   if klcmdl > klcmdmax then klcmdl=1
  150.   if klcmd.0 <= klcmdmax then 'EDITV PUTF KLCMD.0'
  151.   'EDITV PUTF  KLCMDL'
  152.   'EDITV SETFL KLCMD.'klcmdl cmd
  153.   'EDITV SETFL KLCMDB' klcmdl+1
  154. Return
  155.  
  156. LsSort: procedure
  157.   arg opts  1 sign +1
  158.   'EDITV GETF KLFLDS'
  159.   w=1 ; srt='Ascending'
  160.   if sign  = '-' then do;w=2;srt='Descending';end
  161.   else if sign = '+' then w=2
  162.   do i=w to length(opts)
  163.      fld=substr(opts,i,1)
  164.      parse var klflds dmy (fld) s b .
  165.      if b='' then do;'MSG Invalid Sort Field character('fld') specified.';Return;end
  166.      srt = srt s b
  167.   end
  168.   'extract /case/'
  169.   if case.2 ='RESPECT' then do
  170.      oc= case.1 case.2 case.3
  171.      'set case M I R'
  172.   end
  173.   ':0';'SORT *' srt
  174.   if rc=0 then 'set lineflag nonew nochange all'
  175.   if case.2 ='RESPECT' then 'set case' oc
  176.   call TopList
  177. Return
  178.  
  179. LsRngFile: procedure
  180.   arg d
  181.   if d='+' then d=''
  182.   if d='' | d='-' then do
  183.      'extract /fileid/' ; fid=fileid.1
  184.      do until fileid.1=fid
  185.        'kedit' d
  186.        'EDITV GETF KLIND' ; if klind \=1 then Return /* Target found */
  187.        'extract /fileid/'
  188.      end
  189.      'MSG No files open except KL FileList'
  190.   end
  191.   else 'MSG Invalid Slash command(/F'd') specified.'
  192. Return
  193.  
  194. LsRngList: procedure
  195.   arg d
  196.   if d='+' then d=''
  197.   if d='' | d='-' then do
  198.      'extract /fileid/' ; fid=fileid.1
  199.      do until fileid.1=fid
  200.        'kedit' d
  201.        'editv getf klind' ; if klind =1 then Return /* Target found */
  202.        'extract /fileid/'
  203.      end
  204.      'MSG No other KL FileList'
  205.   end
  206.   else 'MSG Invalid Slash command(/L'd') specified.'
  207. Return
  208.  
  209. LsRefresh: procedure
  210.   'EDITV GETF KLSPEC.0' ; 'EDITV SETFL KLSPEC.0'
  211.   'top' ; 'DELETE *'
  212.    do i=1 to klspec.0
  213.      'EDITV GETF KLSPEC.'i
  214.       call FileList klspec.i '/ADD'
  215.    end
  216. Return
  217.  
  218. LsQuit: procedure
  219. * 'editv get klln'
  220. * klln=klln-1;if klln < 0 then klln=0
  221. * 'editv put klln'
  222.   'qquit'
  223. Return
  224. /*--------------------------------------------------------------------------*/
  225. /*                                                                          */
  226. /*--------------------------------------------------------------------------*/
  227. FileList: procedure
  228.   parse arg spec '/' opt
  229.   'EDITV GETF KLIND'
  230.   opt = '/' || translate(opt)
  231.   new?=1 ; lvl=0
  232.   if pos('/D',opt)\=0 then do
  233.      parse var opt . '/D' lvl .
  234.      if lvl = '' then lvl=1
  235.      else if datatype(lvl,'W')=0 then do;'MSG Number must follow /D.';return 2;end
  236.   end
  237.   if wordpos('/ADD',opt)\=0 & klind=1 then new?=0
  238.   if new? then call OpenList /* for a new FileList */ ; else ':*'
  239.  
  240.   'macro KLDIR' new? lvl spec
  241. Return 0
  242.  
  243. OpenList: procedure
  244.   'EDITV GET KLLN KLDIR'
  245.   if klln='' then do /* Initialize KL variables */
  246.      klln=0
  247.      kldir = directory.1()
  248.      if right(kldir,1) \='\' then kldir=kldir'\'
  249.      'EDITV PUT KLLN KLDIR'
  250.      parse value ReadProf() with klfnlen klfelen klrsvln.0
  251.   end
  252.   else 'editv get klfnlen klfelen klrsvln.0'
  253.   klln  = klln+1
  254.   klfid = kldir'_D_I_R_.'klln
  255.   'KEDIT' klfid '(NOMSG NEW' ;'set msgmode on'; 'set wrap off'
  256.   'set cmdline on'; 'set idline  off'; 'set prefix  off'; 'set inputmode off'
  257.   do i=1 to klrsvln.0; 'editv get klrsvln.'i;'set reserved' klrsvln.i;end
  258.   'extract /pscreen'
  259.   klind = 1
  260.   kllid = klln
  261.   kllflen = 2 * pscreen.2    /* List Field length */
  262.   a0= 10+klfnlen-1; a1= a0 +2;a2= a1 +klfelen
  263.   klflds='N 10' a0 'E' a1 a2-1 'A' a2+1 a2+1+(5-1) 'S' a2+7 a2+7+(9-1) 'D' a2+17 a2+17+(14-1) 'I' a2+32 a2+32+(2-1) 'R' a2+35 kllflen
  264.   'EDITV PUT  KLLN'
  265.   'EDITV PUTF KLIND KLLID KLFNLEN KLFELEN KLLFLEN KLFLDS KLFID'
  266.   'EDITV SETF KLCMDL 0 KLCMD.0 0'
  267. Return
  268.  
  269. TopList: procedure
  270.   'EDITV GETF KLSPEC.0'
  271.   'sos tabcmd' ; 'top'
  272.   'extract /curline/'
  273.   dn = curline.2 - klspec.0 -2 ; if dn \=0 then 'down' dn
  274. Return
  275.  
  276. ClrLineFlg: procedure
  277.   'extract /curline/cursor/'
  278.   diff = curline.2 - cursor.1
  279.   'sos tabcmd'
  280.   'locate :'cursor.3
  281.   'set lineflag nochange' /* This command only worked at cmd line. -> Bug ? */
  282.   if diff > 0 then 'down' diff ; else if diff\=0 then 'up' (-diff)
  283.   'cursor home'
  284. Return
  285.  
  286. PutRsp: procedure
  287.   parse arg rsp,msg
  288.   'sos firstcol'
  289.   'text' rsp
  290.   if msg \='' then do
  291.      'EDITV GETF KLFLDS'
  292.      parse var klflds . 'A' col .
  293.      'sos firstcol'
  294.      'cursor =' col
  295.      'text' msg
  296.   end
  297.   'sos firstcol'
  298. Return
  299. /*--------------------------------------------------------------------------*/
  300. /*       Process /EX function from KL FileList                              */
  301. /*--------------------------------------------------------------------------*/
  302. FLEXE: procedure
  303.   parse arg str
  304.   parse value SlaSubs(str) with dir? svdrv svpath'/'cmd str
  305.   cmd = translate(cmd) /* upper case */
  306.   str = strip(str)
  307.   msg =''
  308.   if wordpos(cmd,'X KL K XEDIT KEDIT') \=0 then rc=Edit(dir?,cmd,str)
  309.   else if wordpos(cmd,'DEL ERASE')  \=0 then parse value Erase(dir?,cmd,str) with rc msg
  310.   else if wordpos(cmd,'R REN')      \=0 then parse value Ren(str) with rc msg
  311.   else if wordpos(cmd,'DOS DOSN DOSQ') \=0 then ''cmd str
  312.   else if wordpos(cmd,'MAC MACRO') \=0 then '' str
  313.   else do; 'editv get klxmode'; ''klxmode cmd str;end
  314.  
  315.   if rc=0 then rsp='*'; else rsp='*'rc
  316.   if left(svpath,1) \='"' & pos(' ',svpath) \=0 then svpath='"'svpath'"'
  317.   'CHDIR' svpath ; 'CHDRIVE' svdrv      /* restore path & drv  */
  318.   call PutRsp rsp,msg
  319.   call ClrLineFlg
  320. Return 1
  321. /*---------------------------------------------------------*/
  322. /*                                                         */
  323. /*---------------------------------------------------------*/
  324. SlaSubs: procedure
  325.   'extract /curline/directory'
  326.   'editv getf klflds'
  327.   parse var klflds . ns ne . es ee . as ae . ss se . ds de . is ie . rs re .
  328.   fn=strip(substr(curline.3,ns,ne-ns+1),'T')
  329.   fe=strip(substr(curline.3,es,ee-es+1),'T')
  330.   at=substr(curline.3,as,ae-as+1);if pos('<dir>',at)=0 then dir?=0;else dir?=1
  331.   id=substr(curline.3,is,ie-is+1)
  332.   rpath= strip(substr(curline.3,rs,re-rs+1))
  333.   sid = substr(id,2)
  334.   'EDITV GETF KLSPEC.'sid 'KLSPEC.'sid'.D  KLSPEC.'sid'.P'
  335.   drv  =KLSPEC.sid.D
  336.   hpath=KLSPEC.sid.P  ; path = hpath || rpath
  337.   if fe='' then fnfe= fn ; else fnfe =fn'.'fe
  338.   fulfid = drv || path || fnfe
  339.   slacmd = '/F /N /O /P /H /R /E /D //'
  340.  
  341.   parse arg str
  342.   if pos('/',str)=0 then str = str '/'
  343.   cmd =''
  344.   do forever
  345.      pos = pos('/',str) ;if pos=0 then do; cmd = cmd||str; leave; end
  346.      sla = translate(substr(str,pos,2))  /* upper case */
  347.      if wordpos(sla,slacmd)=0 then do;len=1; sub=fulfid; end
  348.      else do
  349.         len=2
  350.         if      sla='/F' then sub=fnfe  ; else if sla='/N' then sub=fn
  351.         else if sla='/O' then sub=''    ; else if sla='/P' then sub=path
  352.         else if sla='/H' then sub=hpath ; else if sla='/R' then sub=rpath
  353.         else if sla='/E' then sub=fe    ; else if sla='/D' then sub=drv
  354.                          else sub='/'
  355.      end
  356.      pre =  substr(str,1,pos-1)
  357.      str =  substr(str,pos+len)
  358.      cmd = cmd || pre || sub
  359.      if sla = '/O' then do; cmd=cmd || str; leave; end
  360.   end
  361.   svdrv = left(directory.1,2)
  362.   if svdrv \= drv then do
  363.      'ChDrive' drv
  364.      'extract /directory'
  365.   end
  366.   svpath=substr(directory.1,3)
  367.   if path \= '\' then path= left(path,length(path)-1)
  368.   if left(path,1) \='"' & pos(' ',path) \=0 then path='"'path'"'
  369.   'ChDir' path   /* chg cur dir */
  370.   drop sub.
  371. Return dir? svdrv svpath || '/' || cmd
  372. /*---------------------------------------------------------*/
  373. /*                                                         */
  374. /*---------------------------------------------------------*/
  375. Edit: procedure
  376.   parse arg dir?,cmd,fileid
  377.   'EDITV GETF KLFID'
  378.   if dir? | cmd='KL' then rc = FileList(fileid)
  379.                      else 'kedit "'fileid'"'
  380.  
  381.   retc=rc ; if rc=0 then open = fileid.1(); else open=''
  382.   'kedit' klfid; 'cursor home' /* get back to original KL FileList */
  383.   'EDITV SETFL KLEDIT' open   /* indicate file(s) opened */
  384. Return retc
  385.  
  386. Erase: procedure
  387.   parse arg dir?,cmd,str
  388.   if dir? then do
  389.     'DOSQ RD "'str'"'
  390.     if rc=0 then rsp='*** Directory Erased'; else rsp=''
  391.   end
  392.   else do
  393.     'DOSQ ERASE "'str'"'
  394.     if rc=0 then rsp='*** File Erased '; else rsp=''
  395.   end
  396. Return rc rsp
  397.  
  398. Ren: procedure
  399.   parse arg str
  400.   'DOSQ REN' str
  401.   if rc=0 then rsp='*** File Renamed'; else rsp=''
  402. Return rc rsp
  403. /*---------------------------------------------------------*/
  404. /*                                                         */
  405. /*---------------------------------------------------------*/
  406. ReadProf: procedure
  407.   klxmode='DOSN';klfnlen=20;klfelen=8;klcmdmax=20;klrsvln.0=0 /* KL defaults */
  408.   r=0 ; 'extract /defprofile' ; prof=defprofile.1
  409.   if pos(':\',prof)\=0 then do
  410.      c=lastpos('\',prof); prof = left(prof,c) || 'KLPROF.KL'
  411.      'kedit' prof '(NOMSG NOPROFILE'; 'zone 1 1'
  412.      do forever
  413.         'locate ~/;/' ; if rc\=0 then leave
  414.         'extract /curline'; parse var curline.3 hdr data;hdr=upper(hdr)
  415.         if      hdr='RSVLINE'  then do;r=r+1;klrsvln.r= strip(data);end
  416.         else if hdr='FNLEN'    then klfnlen =strip(data)
  417.         else if hdr='FELEN'    then klfelen =strip(data)
  418.         else if hdr='BUFLEN'   then klcmdmax=strip(data)
  419.         else if hdr='XMODE'    then klxmode =strip(data)
  420.      end
  421.      klrsvln.0 = r
  422.      'QQUIT'
  423.   end
  424.   'editv PUT klfnlen klfelen klcmdmax klxmode'
  425.    do i=0 to r; 'editv PUT klrsvln.'i ;end
  426. Return klfnlen klfelen klrsvln.0
  427.