/*rexx*/ Address "ISREDIT"; "MACRO (SORTF,SORTX,FLOW,COLL,SORT)" /* TITLE: Reformat and SORT names Users: SCRIPT users or ISPF EDIT users Entry: Used as an EDIT macro within ISPF EDIT ===> SORTEM Contributed: 1985/10/30 David McRitchie "The REXX Macros Toolbox", Converted to REXX based on a previously converted SORTCR macro, some function with label may have been lost. D.McRitchie Options: FLOW option default is 70 e.g. ===> SORTEM 70 Options: length options default 10 e.g. ===> SORTEM 70 10 Requirements: defined area must begin with at least one blank, each line within area must begin the same number of blanks as the first line of the area. .SORTF label required at beginning of a contiguous word list section .SORTX label immediately after end of the contiguous word list section. If label not supplied it will be created based on a later line with data at an earlier starting column The reason that .SORTX must be below the last line is to be able to identify when there is only one line to be processed -- a possible alternative might have been to pass names of the line labels when invoking this edit macro, but I think the method used is better than the alternative. The CC-range would have worked but cannot be redone. Internally: .SORTV Temporary label used, will be created/removed *******************************************************************/ "line_before .zf = noteline """time('n') , " ===> SORTEM" sortf sortx flow coll sort"""" D = substr(SORTF,1,1)||substr(SORTX,1,1) IF D \= '..' then do sort = flow;coll=sortx;flow=sortf; sortf = '.sortf' sortx = '.sortx' END else do "label" sortf "= .sortf 0" "label" sortx "= .sortx 0" sortf = '.sortf' sortx = '.sortx' end sortf = translate(sortf) "(sortfno) = linenum" sortf if rc > 0 then do zedsmsg = SORTF "MISSING" zedlmsg = "A" SORTF "label to designate first involved line", "is(/was) not in the file" Address "ISPEXEC" "SETMSG MSG(ISRZ000)" "LABEL .ZFIRST = .SORTF" /* modified on pc-side*/ "find P'^' 1" exit 12 /* could comment this out if testing */ END "(SORTXNO) = LINENUM" SORTX IF rc > 0 THEN DO zedsmsg = SORTX "missing" zedlmsg = "A .SORTX label (at the line after the last" , "'.du add ' line) is not in the file" Address "ISPEXEC" "SETMSG MSG(ISRZ000)" /* EXIT 12*/ "find first .sortf .sortf p' ^'" /* modified on pc-side */ "(rowz,colz) = cursor" "find next 1" colz "p'^'" if rc = 0 then "label .zcsr = .sortx 0" else exit 12 END IF FLOW = '' THEN FLOW = 70 ELSE IF datatype(FLOW) \= "NUM" then do zedsmsg = "Bad Parameter" zedlmsg = FLOW "is an unknown parameter. Use a column number." Address "ISPEXEC" "SETMSG MSG(ISRZ000)" exit 12 END IF COLL \= '' then IF datatype(COLL) \= 'NUM' THEN DO zedsmsg = "Bad Parameter" zedlmsg = COLL "2ND PARAMETER IS INVALID LENGTH" Address "ISPEXEC" "SETMSG MSG(ISRZ000)" exit 12 END "(LBOUND,RBOUND) = BOUNDS" "(DWIDTH) = DATA_WIDTH" IF FLOW = '' then nop ELSE IF FLOW < 8 THEN DO zedsmsg = "Parameter too small" zedlmsg = "The parameter must be at least 10." Address "ISPEXEC" "SETMSG MSG(ISRZ000)" exit 12 END IF FLOW = '' then nop ELSE IF flow > RBOUND THEN DO zedsmsg = "Parameter too large" zedlmsg = "The parameter must be smaller than or equal to" , RBOUND", the right-bound." Address "ISPEXEC" "SETMSG MSG(ISRZ000)" exit 12 END IF RBOUND < DWIDTH THEN DO "SEEK .SORTF .SORTL P'^'" value(RBOUND+1) DWIDTH IF rc = 0 THEN DO zedsmsg = "Data Outside Bounds" zedlmsg = "Non-blank characters exist outside" , "of the edit bounds" Address "ISPEXEC" "SETMSG MSG(ISRZ000)" exit 12 /* Will not attempt to PROCESS, if there is data beyond the right bound */ END END "(SORTXNO) = LINENUM" SORTX SORTLNO = SORTXNO - 1 SORTXNO = SORTXNO + 0 IF value(SORTFNO) = value(SORTLNO) THEN DO "LINE_AFTER" SORTF "= DATALINE LINE" SORTF /* TO EFFECT A..*/ "(SORTXNO) = LINENUM" SORTX END "LABEL" value(SORTXNO - 1 ) "= .SORTL 0" /* ************ ADDED D.MCR 1985/08/03 TO END ******/ IF value(SORTXNO) < value(SORTFNO) THEN DO zedsmsg = "LABEL ERR "SORTF"/X" zedlmsg = SORTF "must appear earlier than" SORTX Address "ISPEXEC" "SETMSG MSG(ISRZ000)" exit 12 END "SEEK" .SORTF .SORTL " 1 ';.' ALL" "(SEEK1,SEEK2) = SEEK_COUNTS" IF value(SEEK2) \= value(0) THEN DO zedsmsg = "One Command per line" zedlmsg = "CAN ONLY HANDLE '.du add ' COMMANDS AND ", "THEY MUST BEGIN IN COL 1" Address "ISPEXEC" "SETMSG MSG(ISRZ000)" exit 12 END "SEEK .SORTF .SORTL P'^' FIRST" "(SEEK1,SEEK2) = SEEK_COUNTS" IF value(SEEK2) = 0 then do zedsmsg = "No Data Found" zedlmsg = ".SORTF .SORTL area appears to be blank" Address "ISPEXEC" "SETMSG MSG(ISRZ000)" exit 12 END "(CUR1,COLB) = CURSOR" COLBM1 = value(COLB - 1) "SEEK .SORTF .SORTL P'^' 1" COLBM1 "(SEEK1,SEEK2) = SEEK_COUNTS" IF value(SEEK2) \= value(0) THEN DO if colbm1 = 0 then colbm1 = 1 /* make message look okay*/ zedsmsg = "NON-BLANK" COLBM1 zedlmsg = sortf "thru .SORTL NOT CLEAR IN COLUMNS 1-"colbm1 Address "ISPEXEC" "SETMSG MSG(ISRZ000)" exit 12 END "SEEK .SORTF .SORTL ' '" COLB if rc = 0 then do zedsmsg = "uneven" colb zedlmsg = SORTF .SORTL "All Data in range must", "begin at column" colb Address "ISPEXEC" "SETMSG MSG(ISRZ000)" exit 12 END /********** ALL VERIFICATION HAS BEEN COMPLETED ABOVE -- NOW SETTING UP TO CHANGE DATA*/ "(sortvn) = linenum .sortx" "line_before .sortx = dataline "".*v""" "label" sortvn " = .sortv 0" "find first p'^' .sortf .sortf" "(row,col) = cursor" col = col + 1 "TFLOW .sortf" col /* letters precede numbers in EBCDIC on MVS -- ASCII is opposite*/ if x2c('41') = "A" then do; /* ascii like EBCDIC*/ /* attempt to make sort look more ebcdic like */ "change all x'30' x'f0' .sortf .sortv" "change all x'31' x'f1' .sortf .sortv" "change all x'32' x'f2' .sortf .sortv" "change all x'33' x'f3' .sortf .sortv" "change all x'34' x'f4' .sortf .sortv" "change all x'35' x'f5' .sortf .sortv" "change all x'36' x'f6' .sortf .sortv" "change all x'37' x'f7' .sortf .sortv" "change all x'38' x'f8' .sortf .sortv" "change all x'39' x'f9' .sortf .sortv" end "SORT .sortf .sortv" /*sort */ if x2c('41') = "A" then do; /* ascii like EBCDIC*/ /* restore normal ascii chars */ "change all x'f0' x'30' .sortf .sortv" "change all x'f1' x'31' .sortf .sortv" "change all x'f2' x'32' .sortf .sortv" "change all x'f3' x'33' .sortf .sortv" "change all x'f4' x'34' .sortf .sortv" "change all x'f5' x'35' .sortf .sortv" "change all x'f6' x'36' .sortf .sortv" "change all x'f7' x'37' .sortf .sortv" "change all x'f8' x'38' .sortf .sortv" "change all x'f9' x'39' .sortf .sortv" end /* *********** remove any duplicates *****************/ /* sortf to .sortv (sortv itself never a duplicate) */ "(sortfn) = linenum .sortf" "(sortvn) = linenum .sortv" prevline = " " l=0 sortvv = sortvn - 2 do i = sortvv to sortfn by -1 /* could make line = substr(line,1,50)translate(line,1,20)) */ /* and sort 51 70 1 50 */ "(line) = line" i line=strip(line,'T') if line = prevline then "delete" i+1 else prevline = line ll=length(line) if ll > l then l = ll end /* use requested length (coll) if > required length (collx) */ if coll \= "" then do collx = l - colbm1 if coll < collx then do zedsmsg = coll "too small" zedlmsg = zedsmsg", using entity width of" collx Address "ISPEXEC" "SETMSG MSG(ISRZ000)" end if coll > collx then l = coll + colbm1 end "change all .sortf .sortv ' ' '|'" colb l "TFLOW .SORTF" flow /* flow is optional*/ "change all .sortf .sortv '|' ' '" "reset change .sortf .sortv" "delete .sortv" "(linenum) = linenum .sortl" if rc = 0 then "reset label .sortl .sortl" /*eliminate label*/ return 0