home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 5 Edit
/
05-Edit.zip
/
kl.zip
/
KL140L.ZIP
/
KL.KEX
< prev
next >
Wrap
Text File
|
1997-03-16
|
14KB
|
427 lines
*******************************************************************************
* CAUTION!!! *
* This is a KL.KEX macro for users with KEDIT v5.00P1 or earlier, and *
* will not be maintained in future. *
*******************************************************************************
** KL (KEDIT FileList) macro (Version 1.4)
*
* Function: List files and directory names that match a specified path
*
* Author: Shintaroh Hori ( Yamato Lab. IBM JAPAN )
*/
trace off
parse arg filespec 1 hdr +1 1 word1 parm
if hdr ='/' then do
'EDITV GETF KLIND'
if klind\=1 then Exit 0 /* Nop for normal file (i.e. Non KL FileList) */
parse upper var word1 slaopt
if slaopt ='/ENTER' then rc=ENTER()
else if slaopt ='/EX' then do
if command() then Exit 0 /* Nop */
saverc=FLEXE(parm)
'EDITV GETF KLEDIT'
if kledit \='' then do;'EDITV SETFL KLEDIT';'kedit "'kledit'"';end
rc=saverc
end
else if slaopt ='/GETCMD' then do
if command() then Exit 0 /* Nop */
call GetAdjCmd parm
end
else rc = LfSla(slaopt) /* real slash command */
end
else rc = FileList(filespec)
Exit 1
/*--------------------------------------------------------------------------*/
/* Process /ENTER Action */
/*--------------------------------------------------------------------------*/
Enter: procedure
'sos saveline current'
'extract /cmdline/cursor/'
if cmdline.3 \='' then do; 'sos doprefix execute'; Return 1 ; end
curl = cursor.3
proc? =0
'top';'sos topedge leftedge'
do forever
'nomsg locate altered' ; if rc \=0 then leave /* no more changed lines */
parse value ReadCmdStr() with cmdstr 1 cm1 +1
call ClrLineFlg
if cmdstr ='' | cm1 ='*' then iterate
proc?=1
if cmdstr ='=' then quit? = LfRep()
else if cm1 ='?' then quit? = LfRtr(cmdstr)
else if cm1 ='/' then quit? = LfSla(word(cmdstr,1))
else quit? = LfCmd(cmdstr)
if quit? then leave
end
'sos tabcmd' ; 'locate :'curl; 'sos restoreline leftedge'
if proc? then do
'EDITV GETF KLEDIT'
if kledit \='' then do; 'EDITV SETFL KLEDIT'; 'kedit "'kledit'"'; end
end
else 'sos tabcmd doprefix' /* No Cmd processed */
Return 1 /* Process Comp */
ReadCmdStr: procedure
'EDITV GETF KLLFLEN'
'extract /curline/'
list =left(curline.3,kllflen)
hide =substr(curline.3,kllflen+1,kllflen)
dl = compare(list,hide)
if dl=0 then return '' /* no cmd entered */
'sos firstcol'
'text' strip(hide,'T')
'sos firstcol'
dh = compare(reverse(list),reverse(hide))
len = kllflen - (dl-1) -(dh-1)
cmdstr=substr(list,dl,len)
Return strip(cmdstr)
LfRep: procedure
lcmd = GetCmd(1)
if lcmd='' then do; 'MSG No previous commands.'; return 1; end
call PutRsp lcmd' '
'sos cup' /* move cursor one line up */
'EDITV SETFL KLCMDNR 1' /* indicate No Cmd Recording */
Return 0
LfRtr: procedure
parse arg +1 n .
if n='' then n=1
if datatype(n,'W')=0 then do;'MSG' n 'just after ? should be number';return 1;end
lcmd = GetCmd(n)
if lcmd='' then do; 'MSG No commands' n 'times before'; return 1; end
call PutRsp lcmd' '
Return 0
LfSla: procedure
arg cmd +2 opt .
if cmd='/N' then do; call LfCmd arg(1) ; Return 0 /* No Quit */ ;end
call PutCmd cmd || opt
if cmd='/S' then call LsSort opt
else if cmd='/F' then call LsRngFile opt
else if cmd='/L' then call LsRngList opt
else if cmd='/R' then call LsRefresh
else if cmd='/Q' then call LsQuit
else 'MSG Invalid slash command:' arg(1)
Return 1 /* Quit */
GetAdjCmd: procedure
arg n .
'EDITV GETF KLCMDB KLCMD.0 KLLFLEN'
if klcmdb = '' then do; 'msg No KL command retrieved.'; Return; end
if n='+' then klcmdb= klcmdb + 1
else klcmdb= klcmdb - 1
if klcmdb =0 then klcmdb = klcmd.0
if klcmdb > klcmd.0 then klcmdb = 1
'EDITV GETF klcmd.'klcmdb
'EDITV PUTF klcmdb'
'extract /curline/'
hide =substr(curline.3,kllflen+1,kllflen)
'sos firstcol'
'text' strip(hide,'T')
'sos firstcol'
call PutRsp klcmd.klcmdb
Return
LfCmd: procedure
call PutCmd arg(1)
call FLEXE arg(1)
Return 0
GetCmd: procedure
arg n
'EDITV GETF klcmdl klcmd.0'
if n > klcmd.0 then Return ''
n=klcmdl-(n-1)
if n <= 0 then do; 'EDITV GET KLCMDMAX'; n=klcmdmax+n ;end
'EDITV GETF klcmd.'n
Return klcmd.n
PutCmd: procedure
parse arg cmd
'EDITV GETF klcmdnr klcmdl klcmd.0'
if klcmdnr =1 then do; 'EDITV SETFL KLCMDNR'; return; end
'EDITV GET klcmdmax'
klcmdl = klcmdl +1
klcmd.0= klcmd.0 +1
if klcmdl > klcmdmax then klcmdl=1
if klcmd.0 <= klcmdmax then 'EDITV PUTF KLCMD.0'
'EDITV PUTF KLCMDL'
'EDITV SETFL KLCMD.'klcmdl cmd
'EDITV SETFL KLCMDB' klcmdl+1
Return
LsSort: procedure
arg opts 1 sign +1
'EDITV GETF KLFLDS'
w=1 ; srt='Ascending'
if sign = '-' then do;w=2;srt='Descending';end
else if sign = '+' then w=2
do i=w to length(opts)
fld=substr(opts,i,1)
parse var klflds dmy (fld) s b .
if b='' then do;'MSG Invalid Sort Field character('fld') specified.';Return;end
srt = srt s b
end
'extract /case/'
if case.2 ='RESPECT' then do
oc= case.1 case.2 case.3
'set case M I R'
end
':0';'SORT *' srt
if rc=0 then 'set lineflag nonew nochange all'
if case.2 ='RESPECT' then 'set case' oc
call TopList
Return
LsRngFile: procedure
arg d
if d='+' then d=''
if d='' | d='-' then do
'extract /fileid/' ; fid=fileid.1
do until fileid.1=fid
'kedit' d
'EDITV GETF KLIND' ; if klind \=1 then Return /* Target found */
'extract /fileid/'
end
'MSG No files open except KL FileList'
end
else 'MSG Invalid Slash command(/F'd') specified.'
Return
LsRngList: procedure
arg d
if d='+' then d=''
if d='' | d='-' then do
'extract /fileid/' ; fid=fileid.1
do until fileid.1=fid
'kedit' d
'editv getf klind' ; if klind =1 then Return /* Target found */
'extract /fileid/'
end
'MSG No other KL FileList'
end
else 'MSG Invalid Slash command(/L'd') specified.'
Return
LsRefresh: procedure
'EDITV GETF KLSPEC.0' ; 'EDITV SETFL KLSPEC.0'
'top' ; 'DELETE *'
do i=1 to klspec.0
'EDITV GETF KLSPEC.'i
call FileList klspec.i '/ADD'
end
Return
LsQuit: procedure
* 'editv get klln'
* klln=klln-1;if klln < 0 then klln=0
* 'editv put klln'
'qquit'
Return
/*--------------------------------------------------------------------------*/
/* */
/*--------------------------------------------------------------------------*/
FileList: procedure
parse arg spec '/' opt
'EDITV GETF KLIND'
opt = '/' || translate(opt)
new?=1 ; lvl=0
if pos('/D',opt)\=0 then do
parse var opt . '/D' lvl .
if lvl = '' then lvl=1
else if datatype(lvl,'W')=0 then do;'MSG Number must follow /D.';return 2;end
end
if wordpos('/ADD',opt)\=0 & klind=1 then new?=0
if new? then call OpenList /* for a new FileList */ ; else ':*'
'macro KLDIR' new? lvl spec
Return 0
OpenList: procedure
'EDITV GET KLLN KLDIR'
if klln='' then do /* Initialize KL variables */
klln=0
kldir = directory.1()
if right(kldir,1) \='\' then kldir=kldir'\'
'EDITV PUT KLLN KLDIR'
parse value ReadProf() with klfnlen klfelen klrsvln.0
end
else 'editv get klfnlen klfelen klrsvln.0'
klln = klln+1
klfid = kldir'_D_I_R_.'klln
'KEDIT' klfid '(NOMSG NEW' ;'set msgmode on'; 'set wrap off'
'set cmdline on'; 'set idline off'; 'set prefix off'; 'set inputmode off'
do i=1 to klrsvln.0; 'editv get klrsvln.'i;'set reserved' klrsvln.i;end
'extract /pscreen'
klind = 1
kllid = klln
kllflen = 2 * pscreen.2 /* List Field length */
a0= 10+klfnlen-1; a1= a0 +2;a2= a1 +klfelen
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
'EDITV PUT KLLN'
'EDITV PUTF KLIND KLLID KLFNLEN KLFELEN KLLFLEN KLFLDS KLFID'
'EDITV SETF KLCMDL 0 KLCMD.0 0'
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
ClrLineFlg: procedure
'extract /curline/cursor/'
diff = curline.2 - cursor.1
'sos tabcmd'
'locate :'cursor.3
'set lineflag nochange' /* This command only worked at cmd line. -> Bug ? */
if diff > 0 then 'down' diff ; else if diff\=0 then 'up' (-diff)
'cursor home'
Return
PutRsp: procedure
parse arg rsp,msg
'sos firstcol'
'text' rsp
if msg \='' then do
'EDITV GETF KLFLDS'
parse var klflds . 'A' col .
'sos firstcol'
'cursor =' col
'text' msg
end
'sos firstcol'
Return
/*--------------------------------------------------------------------------*/
/* Process /EX function from KL FileList */
/*--------------------------------------------------------------------------*/
FLEXE: procedure
parse arg str
parse value SlaSubs(str) with dir? svdrv svpath'/'cmd str
cmd = translate(cmd) /* upper case */
str = strip(str)
msg =''
if wordpos(cmd,'X KL K XEDIT KEDIT') \=0 then rc=Edit(dir?,cmd,str)
else if wordpos(cmd,'DEL ERASE') \=0 then parse value Erase(dir?,cmd,str) with rc msg
else if wordpos(cmd,'R REN') \=0 then parse value Ren(str) with rc msg
else if wordpos(cmd,'DOS DOSN DOSQ') \=0 then ''cmd str
else if wordpos(cmd,'MAC MACRO') \=0 then '' str
else do; 'editv get klxmode'; ''klxmode cmd str;end
if rc=0 then rsp='*'; else rsp='*'rc
if left(svpath,1) \='"' & pos(' ',svpath) \=0 then svpath='"'svpath'"'
'CHDIR' svpath ; 'CHDRIVE' svdrv /* restore path & drv */
call PutRsp rsp,msg
call ClrLineFlg
Return 1
/*---------------------------------------------------------*/
/* */
/*---------------------------------------------------------*/
SlaSubs: procedure
'extract /curline/directory'
'editv getf klflds'
parse var klflds . ns ne . es ee . as ae . ss se . ds de . is ie . rs re .
fn=strip(substr(curline.3,ns,ne-ns+1),'T')
fe=strip(substr(curline.3,es,ee-es+1),'T')
at=substr(curline.3,as,ae-as+1);if pos('<dir>',at)=0 then dir?=0;else dir?=1
id=substr(curline.3,is,ie-is+1)
rpath= strip(substr(curline.3,rs,re-rs+1))
sid = substr(id,2)
'EDITV GETF KLSPEC.'sid 'KLSPEC.'sid'.D KLSPEC.'sid'.P'
drv =KLSPEC.sid.D
hpath=KLSPEC.sid.P ; path = hpath || rpath
if fe='' then fnfe= fn ; else fnfe =fn'.'fe
fulfid = drv || path || fnfe
slacmd = '/F /N /O /P /H /R /E /D //'
parse arg str
if pos('/',str)=0 then str = str '/'
cmd =''
do forever
pos = pos('/',str) ;if pos=0 then do; cmd = cmd||str; leave; end
sla = translate(substr(str,pos,2)) /* upper case */
if wordpos(sla,slacmd)=0 then do;len=1; sub=fulfid; end
else do
len=2
if sla='/F' then sub=fnfe ; else if sla='/N' then sub=fn
else if sla='/O' then sub='' ; else if sla='/P' then sub=path
else if sla='/H' then sub=hpath ; else if sla='/R' then sub=rpath
else if sla='/E' then sub=fe ; else if sla='/D' then sub=drv
else sub='/'
end
pre = substr(str,1,pos-1)
str = substr(str,pos+len)
cmd = cmd || pre || sub
if sla = '/O' then do; cmd=cmd || str; leave; end
end
svdrv = left(directory.1,2)
if svdrv \= drv then do
'ChDrive' drv
'extract /directory'
end
svpath=substr(directory.1,3)
if path \= '\' then path= left(path,length(path)-1)
if left(path,1) \='"' & pos(' ',path) \=0 then path='"'path'"'
'ChDir' path /* chg cur dir */
drop sub.
Return dir? svdrv svpath || '/' || cmd
/*---------------------------------------------------------*/
/* */
/*---------------------------------------------------------*/
Edit: procedure
parse arg dir?,cmd,fileid
'EDITV GETF KLFID'
if dir? | cmd='KL' then rc = FileList(fileid)
else 'kedit "'fileid'"'
retc=rc ; if rc=0 then open = fileid.1(); else open=''
'kedit' klfid; 'cursor home' /* get back to original KL FileList */
'EDITV SETFL KLEDIT' open /* indicate file(s) opened */
Return retc
Erase: procedure
parse arg dir?,cmd,str
if dir? then do
'DOSQ RD "'str'"'
if rc=0 then rsp='*** Directory Erased'; else rsp=''
end
else do
'DOSQ ERASE "'str'"'
if rc=0 then rsp='*** File Erased '; else rsp=''
end
Return rc rsp
Ren: procedure
parse arg str
'DOSQ REN' str
if rc=0 then rsp='*** File Renamed'; else rsp=''
Return rc rsp
/*---------------------------------------------------------*/
/* */
/*---------------------------------------------------------*/
ReadProf: procedure
klxmode='DOSN';klfnlen=20;klfelen=8;klcmdmax=20;klrsvln.0=0 /* KL defaults */
r=0 ; 'extract /defprofile' ; prof=defprofile.1
if pos(':\',prof)\=0 then do
c=lastpos('\',prof); prof = left(prof,c) || 'KLPROF.KL'
'kedit' prof '(NOMSG NOPROFILE'; 'zone 1 1'
do forever
'locate ~/;/' ; if rc\=0 then leave
'extract /curline'; parse var curline.3 hdr data;hdr=upper(hdr)
if hdr='RSVLINE' then do;r=r+1;klrsvln.r= strip(data);end
else if hdr='FNLEN' then klfnlen =strip(data)
else if hdr='FELEN' then klfelen =strip(data)
else if hdr='BUFLEN' then klcmdmax=strip(data)
else if hdr='XMODE' then klxmode =strip(data)
end
klrsvln.0 = r
'QQUIT'
end
'editv PUT klfnlen klfelen klcmdmax klxmode'
do i=0 to r; 'editv PUT klrsvln.'i ;end
Return klfnlen klfelen klrsvln.0