Coloring source lines with COBOL and using a shortcut from within PDM

Search400.com reader Yoni Tehan was inspired by our tip Using SQL on System i to color source code and inline comments and translated the SQL to COBOL+CL to share with fellow AS/400 users.

Search400 reader Yoni Tehan read Nerandra Devireddy's tip Using SQL on System i to color source code and inline comments and was inspired to translate the SQL to COBOL+CL and share it with fellow AS/400 users here.

I saw the tip that explained coloring source lines using SQL. I took the liberty to translate it into COBOL+CL programs and call it from within the PDM environement. Here, you can color the remarks line in source with white color or change it as you like.


CL CHGATTRCL:

PGM PARM(&LIB &SRC &TYP)
DCL VAR(&LIB) TYPE(*CHAR) LEN(10)
DCL VAR(&SRC) TYPE(*CHAR) LEN(10)
DCL VAR(&TYP) TYPE(*CHAR) LEN(10)
DCL VAR(&PARM) TYPE(*CHAR) LEN(380)
IF COND(&TYP *NE 'CBL') THEN(GOTO CMDLBL(END))
OVRDBF FILE(PFILE) TOFILE(&LIB/QLBLSRC) MBR(&SRC)
CALL PGM(CHGATTR)
END: ENDPGM

cbl chgattr:
PROCESS APOST.
IDENTIFICATION DIVISION.
Ö°******************************************************************
Ö°*
SOURCE š⠙⠰ â " *
Ö°*****************************************************************
PROGRAM-ID. CHGATTR.
´ AUTHOR. YONI.
Ö°******************************************************
ENVIRONMENT DIVISION.
Ö°******************************************************
CONFIGURATION SECTION.
Ö°******************************************************
SOURCE-COMPUTER. IBM-AS400.
OBJECT-COMPUTER. IBM-AS400.
SPECIAL-NAMES. LOCAL-DATA IS LOCALS
I-O-FEEDBACK IS IOFEEDBACK.
Ö°******************************************************
001800 INPUT-OUTPUT SECTION.
Ö°******************************************************
001900 FILE-CONTROL.
002400 SELECT PFILE ASSIGN TO DATABASE-PFILE.
Ö°******************************************************************
DATA DIVISION.
Ö°******************************************************************
FILE SECTION.
Ö°******************************************************************
FD PFILE.
01 PFILE-REC.
03 PFILE-LINE.
05 FILLER PIC X(06).
05 FILLER PIC X(06).
05 FILLER PIC X(05).
05 ATTR PIC X(01).
05 REM PIC X.
05 AUTH PIC X(07).
05 FILLER PIC X(50).
05 FILLER PIC XX.
05 FILLER PIC X(14).
00740Ö°******************************************************************
007500 WORKING-STORAGE SECTION.
00760Ö°******************************************************************
01 LD-AREA.
03 FILLER PIC X(300).
03 LD-GILAYON PIC XX.
Ö°*
01 WA-CMD-GR.
03 WA-CMD1.
05 FILLER PIC X(40) VALUE
'OVRDBF FILE(LFILE) TOFILE(QS36F/QDDSSRC)'.
05 FILLER PIC X(31) VALUE
' MBR(PKXX.AVX) POSITION(*RRN 2)'.
03 WA-LEN1 PIC 9(10)V9(5) COMP-3
VALUE 71.
03 WA-CMD2.
05 FILLER PIC X(40) VALUE
'OVRDBF FILE(LFILE) TOFILE(QS36F/QDDSSRC)'.
05 FILLER PIC X(31) VALUE
' MBR(PKXX.TNX) POSITION(*RRN 2)'.
03 WA-LEN2 PIC 9(10)V9(5) COMP-3
VALUE 71.
01 SW-AREA.
03 SW-EOF PIC X.
88 SW-EOF-ON VALUE '1'.
04650Ö°******************************************************************
046400 PROCEDURE DIVISION.
04650Ö°******************************************************************
046600 START-PROGRAM SECTION.
046700 ST-PROG.
046800 PERFORM X100-HACHANAT-AVODA.
047000 PERFORM A100-MAIN UNTIL SW-EOF-ON.
047200 PERFORM Z100-SOF-AVODA.
047400 ST-PROG-EX.
EXIT PROGRAM.
047400 ST-PROG-EX1.
STOP RUN.
04760Ö°*****************************************************************
04770Ö°* M A I N
04780Ö°*****************************************************************
047900 A100-MAIN SECTION.
048000 A100.
IF REM = '*' MOVE X'22' TO ATTR.
IF AUTH = 'AUTHOR.' MOVE X'28' TO ATTR.
REWRITE PFILE-REC.
READ PFILE AT END MOVE '1' TO SW-EOF.
018500 A100-EX.
018600 EXIT.
04760Ö°*****************************************************************
04770Ö°*
04780Ö°*****************************************************************
047900 X100-HACHANAT-AVODA SECTION.
048000 X100.
ACCEPT LD-AREA FROM LOCALS.
122400 OPEN I-O PFILE.
INITIALIZE SW-AREA.
READ PFILE AT END MOVE '1' TO SW-EOF
GO TO X100-EX.
018500 X100-EX.
018600 EXIT.
04760Ö°*****************************************************************
04770Ö°*
04780Ö°*****************************************************************
047900 Z100-SOF-AVODA SECTION.
048000 Z100.
DISPLAY LD-AREA UPON LOCALS.
122400 CLOSE PFILE.
018500 Z100-EX.
018600 EXIT.

Next go to PDM (STRPDM) and choose option 9 (user options+enter) F6 to create new. Then name it AT or anything you like. The command:

CALL PGM(CHGATTRCL) PARM(&L &N &S)

Then, when you type AT near COBOL source, all the remarks lines will be highlighted.

More colors:
Hex Color
20 Green
21 Green, reverse image
22 White
23 White, reverse image
24 Green, underscore
25 Green, underscore, reverse image
26 White, underscore
27 Nondisplay
28 Red
29 Red, reverse image
2A Red, high intensity
2B Red, high intensity, reverse image
2C Red, underscore
2D Red, underscore, reverse image
2E Red, underscore, blink
2F Nondisplay
30 Turquoise, column separator
31 Turquoise, column separator, reverse image
32 Yellow, column separator
33 White, reverse image, column separator
34 Turquoise, underscore, column separator
35 Turquoise, underscore, reverse image, column separator
36 Yellow, underscore, column separator
37 Nondisplay
38 Pink
39 Pink, reverse image
3A Blue
3B Blue, reverse image
3C Pink, underscore
3D Pink, underscore, reverse image
3E Blue, underscore
3F Nondisplay

ABOUT THE AUTHOR: Yoni Tehan is iSeries Administrator at Ashtrom Group Ltd.

This was first published in July 2008

Dig deeper on iSeries COBOL programming

0 comments

Oldest 

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

-ADS BY GOOGLE

SearchEnterpriseLinux

SearchDataCenter

Close