Return to the RPG Tips
Colorizing RPG code for viewing in SEU
filename="Colorsrc.rpg"
1.00 990614 Fqrpglesrc up e disk rename(qrpglesrc:record)
1.01 990609 D data DS 100
1.02 990609 D attr 1 1
1.03 990615 d arrdfn 1 2
1.04 990806 D spec 6 6
1.05 990609 D comment 7 7
1.06 990609 d opcode 26 31
1.07 990615 d done S N
1.08 990609 Dup c 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
1.09 990609 Dlo c 'abcdefghijklmnopqrstuvwxyz'
1.10 990609 *
1.11 990609 C MOVEL srcdta data
1.12 990615 c IF arrdfn = '**'
1.13 990615 c EVAL done = *on
1.14 990615 c ENDIF
1.15 990609 *
1.16 990615 *
1.17 990615 c IF not done
1.18 990615 *
1.19 991025 c IF comment <> '*' and comment <> '/' and
1.20 991025 C (spec = 'C' or spec = 'c')
1.21 990609 c MOVE opcode string 6
1.22 990609 c lo:up XLATE string opcode
1.23 990615 c ENDIF
1.24 991029 *
1.25 991029 c MOVE spec specx 1
1.26 991029 c lo:up XLATE specx spec
1.27 990609 *
1.28 990609 c SELECT
1.29 990609 *
6.00 990609 C WHEN comment = '*'
6.01 990609 C EVAL attr = x'28'
6.02 990609 *
6.03 990609 C WHEN opcode = 'BEGSR' or opcode = 'ENDSR' or
6.04 990609 c opcode = 'GOTO' or opcode = 'TAG' or
6.06 990609 c %subst(opcode:1:3) = 'CAS' or
6.07 990609 c %subst(opcode:1:3) = 'CAB'
6.08 990609 C EVAL attr = x'3A'
6.09 990609 *
6.10 990609 c WHEN %subst(opcode:1:2) = 'IF' or
6.11 990609 C %subst(opcode:1:2) = 'DO' or
6.12 991025 C %subst(opcode:1:2) = 'OR' or
6.13 990614 C %subst(opcode:1:3) = 'AND' or
6.14 990609 C %subst(opcode:1:3) = 'END' or
6.15 991025 C %subst(opcode:1:4) = 'WHEN' or
6.16 991025 C %subst(opcode:1:4) = 'ELSE' or
6.18 990609 C opcode = 'SELECT'
6.20 990609 c EVAL attr = x'38'
6.21 990609 c ENDSL
6.22 990609 c MOVE data srcdta
8.00 990609 C UPDATE record
8.01 990615 c ENDIF
9.00 990614 *
10.00 990614 C *pssr BEGSR
11.00 990614 c MOVEL '*CANCL' exitpt 6
12.00 990614 c ENDSR exitpt
filename="COLORSRCO.RPG"
1.00 990614 Fqrpgsrc up e disk rename(qrpgsrc:record)
1.01 990610 D data DS 80
1.02 990615 D attr 1 1
1.03 990615 D arrdfn 1 2
1.04 990609 D comment 7 7
1.05 990610 d opcode 28 32
1.06 990609 Dup c 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
1.07 990609 Dlo c 'abcdefghijklmnopqrstuvwxyz'
1.08 990615 ddone s n
1.09 990609 *
1.10 990609 C MOVEL srcdta data
1.11 990615 *
1.12 990615 c if arrdfn = '**'
1.13 990615 c eval done = *on
1.14 990615 c endif
1.15 990615 *
1.16 990615 c IF not done
1.17 990609 *
1.18 990610 c* MOVEL opcode string 5
1.19 990610 c* lo:up XLATE string opcode
1.20 990609 *
1.21 990609 c SELECT
1.22 990609 *
6.00 990609 C WHEN comment = '*'
6.01 990609 C EVAL attr = x'28'
6.02 990609 *
6.03 990609 C WHEN opcode = 'BEGSR' or opcode = 'ENDSR' or
6.04 990609 c opcode = 'GOTO' or opcode = 'TAG' or
6.06 990609 c %subst(opcode:1:3) = 'CAS' or
6.07 990609 c %subst(opcode:1:3) = 'CAB'
6.08 990609 C EVAL attr = x'3A'
6.09 990609 *
6.10 990609 c WHEN %subst(opcode:1:2) = 'IF' or
6.11 990609 C %subst(opcode:1:2) = 'DO' or
6.12 990614 C %subst(opcode:1:3) = 'AND' or
6.13 990609 C %subst(opcode:1:3) = 'END' or
6.14 990610 C %subst(opcode:1:2) = 'WH' or
6.18 990610 C opcode = 'SELEC'
6.20 990609 c EVAL attr = x'38'
6.21 990609 c ENDSL
6.22 990609 c MOVE data srcdta
8.00 990609 C UPDATE record
8.01 990615 c ENDif
9.00 990614 *
10.00 990614 C *pssr begsr
11.00 990614 c movel '*CANCL' exitpt 6
12.00 990614 c endsr exitpt
filename="Editsrc.clp"
1.00 PGM PARM(&lib &file &mbr)
2.00 DCL VAR(&lib) TYPE(*CHAR) LEN(10)
3.00 DCL VAR(&file) TYPE(*CHAR) LEN(10)
4.00 DCL VAR(&mbr) TYPE(*CHAR) LEN(10)
4.01
4.02 IF COND(&file = 'QRPGLESRC') THEN(DO)
4.03
4.04 SNDPGMMSG MSGID(CPF9898) MSGF(Qcpfmsg) TOPGMQ(*EXT) MSGTYPE(*STATUS) +
4.05 MSGDTA('Formatting source member ' || &mbr |< ' in file ' +
4.06 || &lib |< '/' || &file |< '.')
4.07 OVRDBF FILE(QRPGLESRC) TOFILE(&lib/&file) MBR(&mbr) secure(*yes)
4.08 CALL PGM(MWLIB/COLORSRC)
4.09 monmsg msgid(Cpf0000)
4.10 RCLRSC
4.11 enddo
5.00
6.00 STRSEU SRCFILE(&LIB/&FILE) SRCMBR(&MBR) TYPE(*SAME) +
7.00 OPTION(2)
7.01
7.02 IF COND(&file = 'QRPGLESRC') THEN(DO)
7.03
7.04 SNDPGMMSG MSGID(CPF9898) MSGF(Qcpfmsg) TOPGMQ(*EXT) MSGTYPE(*STATUS) +
7.05 MSGDTA('Formatting source member ' || &mbr |< ' in file ' +
7.06 || &lib |< '/' || &file |< '.')
8.00 OVRDBF FILE(QRPGLESRC) TOFILE(&lib/&file) MBR(&mbr) secure(*yes)
9.00 CALL PGM(MWLIB/COLORSRC)
9.01 monmsg msgid(Cpf0000)
10.00 RCLRSC
10.01 enddo
10.02
10.03 IF COND(&file =3D 'QRPGSRC') THEN(DO)
10.04
10.05 SNDPGMMSG MSGID(CPF9898) MSGF(Qcpfmsg) TOPGMQ(*EXT) MSGTYPE(*STATUS) +
10.06 MSGDTA('Formatting source member ' || &mbr |< ' in file ' +
10.07 || &lib |< '/' || &file |< '.')
10.08 OVRDBF FILE(QRPGSRC) TOFILE(&lib/&file) MBR(&mbr) secure(*yes)
10.09 CALL PGM(MWLIB/COLORSRCO)
10.10 monmsg msgid(Cpf0000)
10.11 RCLRSC
10.12 ENDDO
11.00 ENDPGM
[report a broken link by clicking here]