/* Reformat: rearrange columns and constant information (REXX)*/
/*********************************************************************
MACRO: Reformat lines of data
PURPOSE: Reformat data in edit
EXAMPLES:
Reformat 1 10 '..' 20 30
reformat 'line ==>' 1 50 '<===' .third .zl
reformat 0 10 '..' 20 30 ' columns 1-10 now blank'
reformat NX 50 70 1 40 .LABA .LABB
reformat test '>' x'414243' '<' 1 80 -- on OS2 with ascii
reformat test '>' x'c1c2c3' '<' 1 80 -- on TSO with ebcdic
------- additional functions added 1993/12/29 ---
reformat hex 1 1 2 50 or reformat hex 1 1 2 L
reformat unhex 1 2 3 51
reformat "find all word c'" s 1 8 "'" -- strip(name,'T')
------- additional functions added 1994/10/07 --- using .MSK label
reformat m 1 23 1 8 '.spf' m 40 63 1 8 s m 75 90 " <=="
------- additional function added 1997/05/27 -- node(n,col1,col2)
reformat node(1,1,100) ' -- ' node(2,1,100) TEST
------- additional function added 1998/02/11 -- Lowercase/Uppercase
reformat LC S 35 40 s 41 80
reformat s 35 40 s UC 41 80
***********************************************************************
REFORMAT Author: David McRitchie, created 1985/08/30 is03
"The REXX Macros Toolbox" DMcRitchie@hotmail.com
http://www.geocities.com/davemcritchie/nclist.htm
Rewritten in REXX 1993/05/14 D.McRitchie IS03
Revised 1993/07/23 compatability with SPF/2 under OS/2
Revised 1993/12/29 HEX, UNHEX options added, L option fixed
-- TSO Stats -- created(1985/08/30) initsize(171)--
*******************************************************************
Title: reformat the inclusive lines between two labels
Users: TSO ISPF edit users, and PC users using SPF/PC from CTC,
i.e. ISPF for TSO users (REXX370 comes with TSO),
SPF2 for OS2 users (REXXSAA comes with OS/2),
SPFPC with REXX/2 for DOS and windows users.
Entry: used as an edit macro within ISPF edit ===> reformat
Example(s):
===> reformat .zfirst .zlast 10 30 200 01 31 40
===> reformat .refa .refb 40 45 1 3 75 L
The second example reformats lines labeled .refa through
.refb such that the line begins with former contents of
pos. 40-45, followed by pos. 1-3 then 75 through the end
of the line
===> reformat e 'id(' 1 8 ') ' 11 30
requirements:
constants enclosed in quotes and/or column pairs
The second of a column pair can be an L for end of line.
options:
NX only do NX lines
TEST use notelines instead of changing data
x'hhhh' hex constant
test use NOTELINE instead of actually changing data
HEX will use C2X() to convert to hex, cols in next pair
UNHEX will use X2C() to convert to char, cols in next pair
LC will make cols in next pair lowercase
S will strip trailing blanks, cols in next pair
should generate noteline if left blank.
M will use .MSK line to obtain "STRING" from col-pair
N Will create name.ext from name ext in col-pair
preserving the original area of the col pair.
Of use in a DIR *.* list which separate name ext
NODE n Obtain node n from col-pair. Period define node.
Things before items like slash(/) and backslash(\)
will be ignored.
* entire (compatibility) will be substituted by ".zfirst .zlast "
* init (option dropped) will be used in an initial macro
* labels required option has been dropped 1993/05/14*
**************
Additional Functions can be added by looking at
NODE(...)
*****************************************************************/
Address 'ISREDIT'
'MACRO (argx)'; /* NOPROCESS if adding cc-range later */
linex = substr(time('n'),1,5) 'REFORMAT' argx
'LINE_BEFORE .ZFIRST = NOTELINE (linex)'
err='';labfirst='';lablast='';nx='';pair=0;string='';nulls='';
prevtoken=0;newtoken=0; hexwork=0; unhexwork=0;stripwork=0;maskwork=0;
lcwork=0;ucwork=0
nwork=0;
mask="";
if argx = '' then do
dataline = 'NOTELINE'
argx = "1 10 'Testing --' 11 72"
end
argx = argx' ' /* provide for terminating spaces during phase1 */
/* ---- parse similar to MACRO (a,b,c) But creating an INTERPRET */
/* ---- argument utilizing NUM/CHAR column pair determinations */
RESTART: /* can not s-i-g-n-a-l into a d-o contruct */
i = verify(argx,' ')
if i =0 then signal endphase1
argx = substr(argx,i)
argxC = translate(argx)
if substr(argxC,1,5) = "NODE(" then do
parse var argx "node(" node ")" argx
parse var node n1 "," c1 "," c2
nn = n1||c1||c2
if (datatype(nn,"n") == 0) then err="node(nodes,col1,col2) invalid"
string = string'||node('node')'
signal restart
end
x = substr(argx,1,1)
if substr(argx,1,2) = "x'" then do /* match single quote '*/
if pair = 1 then err = 'unpaired column before hex constant'
j=pos('''',substr(argx,3));
if j \= 0 then do
token = 'X2C('||substr(argx,2,j)''')'
/* When in ascii ABC is x'414243' */
string = string'||'token;
argx = substr(argx,3+j)
minor = '' /*terminate any pair column started*/
pair = 0;
if argx = '' then signal endphase1
end
else exit
end;
else if x = '''' then do
if pair = 1 then err = 'unpaired column before literal'
j=pos('''',substr(argx,2));
if j \= 0 then do
token = substr(argx,2,j-1);
string = string'||'''token'''';
argx = substr(argx,2+j)
minor = '' /*terminate any pair column started*/
pair = 0;
if argx = '' then signal endphase1
end
else exit
end;
else if x = """" then do
if pair = 1 then err = "unpaired column before literal"
j=pos("""",substr(argx,2));
if j \= 0 then do
token = substr(argx,2,j-1);
string = string"||"""token"""";
argx = substr(argx,2+j)
minor = "" /*terminate any pair column started*/
pair = 0;
if argx = "" then signal endphase1
end
else exit
end;
else do;
j = pos(' ',argx)
token = substr(argx,1,j-1);
argx = substr(argx,j)
xx = translate(token)
if xx = 'HEX' then hexwork = 1
else if xx = 'UNHEX' then unhexwork = 1;
else if xx = 'NX' then NX='NX' /* limit process to NX lines */
else if xx = 'TEST' | xx ='NOTELINE' then dataline='NOTELINE'
else if xx = 'LC' then lcwork = 1
else if xx = 'UC' then ucwork = 1
else if xx = 'S' then stripwork = 1
else if xx = 'N' then nwork = 1
else if xx = 'M' then do; /*slightly redundant if multiple m */
'(LNOlabm) = LINENUM .MSK'
if LNOlabm = 0 then do
ZEDSMSG = '.MSK missing'
ZEDLMSG = 'M option requires MASK line at label .MSK'
/*Address*/ "ISPEXEC" "SETMSG MSG(ISRZ000)"
return 1
end
'(MASK) = LINE .MSK'; maskwork = 1;
MASKLC = translate(mask,"abcdefghijklmnopqrstuvwxyz",,
"ABCDEFGHIJKLMNOPQRSTUVWXYZ")
MASKUC = translate(mask,"ABCDEFGHIJKLMNOPQRSTUVWXYZ",,
"abcdefghijklmnopqrstuvwxyz")
end;
else if xx = 'ENTIRE' then do
if labfirst \= '' then err='...too many labels'
labfirst='.ZFIRST'; lablast='.ZLAST';
end
else if xx = 'INIT' then err='INIT option dropped 1993/05/14'
/* check for label before assuming a constant */
else if (substr(token,1,1)='.') & length(token) < 7 ,
& datatype(substr(token,2),'A') then do
if labfirst='' then labfirst=token
else if lablast='' then lablast=token
else err='.... too many labels .....'
'(TTT) = linenum' token
if ttt = 0 then err = 'Label' token 'is missing'
end
else do
if pair = 0 then do
CURRx = "CURR";
if maskwork =1 then do
if lcwork = 1 then Currx = "MASKLC"
else if ucwork = 1 then Currx = "MASKUC"
else CURRx = "MASK";
ucwork=0; lcwork=0
end
else do
if lcwork =1 then do; CURRx = "CURRLC"; lcwork=0;end;
if ucwork =1 then do; CURRx = "CURRUC"; ucwork=0;end;
end
if token = 0 then minor = '||substr(nulls,1';
else minor = '||substr('CURRx','token;
if stripwork = 1 then minor='||strip(substr('CURRx','token;
if nwork = 1 then minor='||name('CURRx','token;
if hexwork = 1 then minor='||C2X(substr('CURRx','token;
if unhexwork = 1 then minor='||X2C(substr('CURRx','token;
prevtoken = token; /* will have to be subtracted*/
pair = 1;
end
else do /* PROCESS second column in col-pair */
if xx \= 'L' then do;
if prevtoken = 0 then newtoken = token /*nulls -- 0 5 */
else newtoken = token + 1 - prevtoken
string = string||minor||','||newtoken||')'
if stripwork = 1 then
do; string = string||",'T')"; stripwork=0; end;
if nwork = 1 then
do; nwork=0; end;
end;
else do
if unhexwork = 1 then
err= "Use of L with UNHEX not permitted"
string = string||minor||')'
end
if hexwork = 1 then
do; hexwork=0; string=string||')';end;
if unhexwork = 1 then do;
ttt = newtoken // 2
if ttt \= 0 then err = "The UNHEX column-pair did",
"not address an even number of columns"
unhexwork=0; string=string||')'
end;
pair = 0;
maskwork=0;
end
end;
if argx = '' then signal endphase1
end
SIGNAL RESTART
/* ---------------------------------------------------------*/
endphase1: string = substr(string,3)
if pair = 1 then do
"line_before .zf = Noteline 'Unpaired pairs -- reenter with pairs'"
ZEDSMSG = 'Pairs?'
ZEDLMSG = 'Unpaired column range(s) -- see noteline and REENTER'
/*Address*/ "ISPEXEC" "SETMSG MSG(ISRZ000)"
return 12
end
if labfirst = ' ' then do; labfirst='.ZFIRST'; lablast='.ZLAST';end;
if lablast = '' then err = 'second label missing'
else do
'(SNO) = linenum' labfirst
'(LNO) = linenum' lablast
if sno = 0 then sno = 1
end
if lno = 0 then err = "One or more labels specified are missing"
if dataline = 'NOTELINE' then
"line_before" sno "= NOTELINE ""NOTELINES are in use with TEST"""
if err \= '' then do
say err '<--- err'
"(caps) = caps"
"caps off"
'line_before .zfirst = noteline (err)'
ZEDSMSG = " "
ZEDLMSG = "See Noteline --" err
/*Address*/ "ISPEXEC" "SETMSG MSG(ISRZ000)"
"caps" caps
exit 12
end
do i = sno to lno;
doit = 1
if nx = 'NX' then do; /* x only is not available */
'(XSTATUS) = XSTATUS' i;
if XSTATUS \= 'NX' then doit = 0
end
if doit = 1 then do
'(CURR) = line' i
CURRLC = translate(curr,"abcdefghijklmnopqrstuvwxyz",,
"ABCDEFGHIJKLMNOPQRSTUVWXYZ")
CURRUC = translate(curr,"ABCDEFGHIJKLMNOPQRSTUVWXYZ",,
"abcdefghijklmnopqrstuvwxyz")
line =''
/* "LINE_BEFORE .zf = INFOLINE """string"""" */
interpret 'LINE = ' string
if dataline = 'NOTELINE' then
'LINE_BEFORE' i '= NOTELINE (LINE)' /*(LINE) must be caps*/
else 'LINE' i '= (LINE)'
end
end;
if warnstrip = 1 then "line_before .zf = noteline",
"""REFORMAT use of Strip option(S) has resulted in some nulls"""
exit
name: procedure; /* N -- nwork */
/* reconstruct name.ext from dir listing name ext */
/* preserving original area occupied by column pair */
arg str1,from,length
FL = length - from + 1
B=0
str1 = strip(substr(str1,from,length),"b")
nstr1=""
do i = 1 to length(str1)
if substr(str1,i,1) <> " " then do;
b=0
nstr1 = nstr1||substr(str1,i,1)
end
else do
if b = 0 then nstr1 = nstr1"."
b=b+1
end
end
nstr = left(nstr1,length)
return nstr
node: procedure expose CURR; /* NODE(node,col1,col2)*/
/* created may 27, 1997 this code will be changing over time*/
arg node1,from,two
str1 = strip(substr(CURR,from,two-from+1),"b")
p = pos("",str1)
if p /= 0 then str1 = left(str1,p-1)
nstr1=translate(str1,"/","\:=("); /*restart on any of these*/
do forever /*restart string */
p = pos("/",nstr1)
if p = 0 then leave
nstr1 = substr(nstr1,P+1)
end
nstr1=translate(nstr1,' ','.,<>()"')
wordx = word(nstr1,node1)
return wordx
/* A scale like the following in a different dataset ideal for testi--
1...5...10...15...20...25...30...35...40...45...50...55...60...65...70
0000000001111111112222222222233333333334444444444555555555566666666667
1234567890123456789012345678901234567890123456789012345678901234567890
AAAAAAAAAaBBBBBBBBBbCCCCCCCCCcDDDDDDDDDdEEEEEEEEEeFFFFFFFFFfGGGGGGGGGg
..?rexx02tso/modell.txt
internal.library.text(member1)
c:\internal\library\text\member1.txt
*********************************************************************/