Tip

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

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

There are Comments. Add yours.

 
TIP: Want to include a code block in your comment? Use <pre> or <code> tags around the desired text. Ex: <code>insert code</code>

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy
Sort by: OldestNewest

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:

Disclaimer: Our Tips Exchange is a forum for you to share technical advice and expertise with your peers and to learn from other enterprise IT professionals. TechTarget provides the infrastructure to facilitate this sharing of information. However, we cannot guarantee the accuracy or validity of the material submitted. You agree that your use of the Ask The Expert services and your reliance on any questions, answers, information or other materials received through this Web site is at your own risk.