Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
Colored Source Code
- Thread starter sritzel
- Start date
RedMage1967
Programmer
There are some third party software that does it. Or change the color in the client access setup screen. Otherwise, I don't know.
RedMage1967
IBM Certifed - RPG IV Progammer
RedMage1967
IBM Certifed - RPG IV Progammer
iSeriesCodePoet
Programmer
We change the colors through Client Acess. I don't remember how to do it off the top of my head, but if you search google for 'Client Access Colors' it should come up with something.
iSeriesCodePoet
iSeries Programmer/Lawson Software Administrator
![[pc2]](/data/assets/smilies/pc2.gif "[pc2] [pc2]")
See my progress to converting to linux.
iSeriesCodePoet
iSeries Programmer/Lawson Software Administrator
See my progress to converting to linux.
- Thread starter
- #4
RedMage1967
Programmer
Same thing, (I my messed up mind).
Have you looked at Code/400? WebSphere Development Studio Client of iSeries? It color codes some of the code for you.
RedMage1967
IBM Certifed - RPG IV Progammer
Have you looked at Code/400? WebSphere Development Studio Client of iSeries? It color codes some of the code for you.
RedMage1967
IBM Certifed - RPG IV Progammer
- Thread starter
- #6
Took me forever to find this on the 'net:
Works like a charm, hope this is helpful.
Works like a charm, hope this is helpful.
RedMage1967
Programmer
sritzel, it doesn't work for me.
RedMage1967
IBM Certifed - RPG IV Progammer
RedMage1967
IBM Certifed - RPG IV Progammer
iSeriesCodePoet
Programmer
Here is a copy of my as400.kmp file
The 'apl XX' does the colors. I have it mapped so you do Alt-W for white Alt-B for blue ext... I don't have green currently mapped. I lost my old keymap that had them all. :-(
iSeriesCodePoet
iSeries Programmer/Lawson Software Administrator
See my progress to converting to linux.
Code:
[Profile]
ID=KMP
Version=5
[KEYBOARD]
A-KEY18=apl 22
A-KEY20=apl 28
A-KEY21=apl 30
A-KEY22=apl 30
A-KEY23=apl 24
A-KEY26=apl 38
KEY43=[enter]
S-KEY43=[enter]
C-KEY46=[edit-undo]
C-KEY47=[edit-cut]
C-KEY48=[edit-copy]
C-KEY49=[edit-paste]
A-KEY50=apl 3a
KEY64=[field exit]
S-KEY64=[field exit]
KEY108=[enter]
S-KEY108=[enter]The 'apl XX' does the colors. I have it mapped so you do Alt-W for white Alt-B for blue ext... I don't have green currently mapped. I lost my old keymap that had them all. :-(
iSeriesCodePoet
iSeries Programmer/Lawson Software Administrator
See my progress to converting to linux.
iSeriesCodePoet
Programmer
Here is a website that talks about it.
iSeriesCodePoet
iSeries Programmer/Lawson Software Administrator
See my progress to converting to linux.
iSeriesCodePoet
iSeries Programmer/Lawson Software Administrator
See my progress to converting to linux.
Hi, Don't come here often enough, so I hope I'm not too late.
Why not change the source itself? I wrote a program 10 years ago (Hence for RPG and not RPGLE) that will do just what you need.
Here are some source listings. - My programs change the following:
Full lines of Asterisks ******************
are coloured white
On a line with '* Some Text *'
The *'s are white, text in between is blue
BEGSR and ENDSR are Pink
Underlines for BEGSR and ENDSR are also pink
Source types (F, C etc) are removed for comments.
Four parts are required
RPG Program GSU903R does the work
CLP Program GSU903C is the controller
CMD TX is the command
CLP Program GSU400C displays a 'completed' Bar
LISTINGS
[tt]
---------------------------------------------
H 1 D
*****************************************************************
* *
* SYSTEM NAME..: GPS Utilities *
* *
* PROGRAM......: GSU903R *
* *
* AUTHOR.......: G. P. Skelton *
* *
* DATE.........: August 1994. *
* *
* TITLE........: Put Text Marks into an RPG Source File Member *
* *
*****************************************************************
* MODIFICATION CONTROL *
* ~~~~~~~~~~~~~~~~~~~~ *
* MOD NO. BY DATE DESCRIPTION *
* ~~~~~~~~~ ~~~ ~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ *
* *
*****************************************************************
/EJECT
*****************************************************************
* INDICATORS USED *
* ~~~~~~~~~~~~~~~ *
* *
* 99 - Read Through RPG Source member *
*****************************************************************
/EJECT
*****************************************************************
* FILE SPECIFICATIONS *
*****************************************************************
FQRPGSRC UF E DISK
F QRPGSRC KRENAMEQRPG3SRC
* RPG Source File
*
*****************************************************************
/EJECT
*****************************************************************
* INPUT SPECIFICATIONS *
*****************************************************************
*
* Define Source Data record *
I DS
I 1 80 SRCDTA
I 6 6 SRCTYP
I 7 11 BIGAST
I 7 7 ASTRIX
I 5 5 WHITE
I 70 70 WHITE2
I 8 8 BLUE
I 28 32 OPCDE
I 60 62 ULESR
*****************************************************************
/EJECT
*****************************************************************
* MAIN PROCESSSING LOOP *
*****************************************************************
*
* Entry list - No of records in member for completion display
C *ENTRY PLIST
C PARM RCD 100
*
* Calculate 5% of total records
C RCD DIV 20 PCT5 100
*
* Read through the Source member
B01 C *IN99 DOUEQ'1'
C READ QRPGSRC 99
*
* For each record found...
B02 C *IN99 IFEQ '0'
*
* Add 1 to the total count of records processed
C ADD 1 TOTCNT 100
*
* Add 1 to a smaller count
C ADD 1 CNT 100
*
* If we've done a block of 5%, send a completed so far graphical
* message to the user
B03 C CNT IFEQ PCT5
C TOTCNT DIV RCD DIV 155
C DIV MULT 100 PCT 30
C Z-ADD*ZEROS CNT
C CALL 'GSU400C'
C PARM PCT
E03 C ENDIF
*
* If this line is a comment...
B03 C ASTRIX IFEQ '*'
*
* Make the asterisk white
C MOVELX'22' WHITE
*
* If this isn't an unbroken line of asterisks, make the rest of
* the comment blue
B04 C BLUE IFNE '*'
C MOVELX'3A' BLUE
E04 C ENDIF
*
* If the end of the comment is an asterisk, make that one white
B04 C WHITE2 IFEQ ' '
C MOVELX'22' WHITE2
E04 C ENDIF
*
* If this is an unbroken line of asterisks, make the rest of
* the comment white
B04 C BIGAST IFEQ '**** '
C MOVELX'22' WHITE
E04 C ENDIF
*
* If this is an underline for BEGSR or ENDSR, make the comment
* pink
B04 C OPCDE IFEQ '-----'
C ULESR OREQ '---'
C MOVELX'38' WHITE
C MOVELX'38' BLUE
E04 C ENDIF
*
* As this is a comment, we don't need the source type
C MOVEL' ' SRCTYP
*
* Update the Record
C UPDATQRPG3SRC
*
* If this is NOT a comment line...
X03 C ELSE
*
* If the opcode is BEGSR or ENDSR, make the line pink
B04 C OPCDE IFEQ 'BEGSR'
C OPCDE OREQ 'ENDSR'
C MOVELX'38' WHITE
*
* Update the record
C UPDATQRPG3SRC
*
E04 C ENDIF
*
E03 C ENDIF
*
E02 C ENDIF
*
E01 C ENDDO
*
* End the program
C SETON LRRT
C RETRN
---------------------------------------------
/* ***************************************************************** */
/* * * */
/* * SYSTEM NAME..: GPS Utilitiess * */
/* * * */
/* * PROGRAM......: GSU902C * */
/* * * */
/* * AUTHOR.......: G. P. Skelton * */
/* * * */
/* * DATE.........: August 1994. * */
/* * * */
/* * TITLE........: Text Marks For RPG * */
/* * * */
/* ***************************************************************** */
/* * MODIFICATION CONTROL * */
/* * * */
/* * MOD NO. BY DATE DESCRIPTION * */
/* * * */
/* * * */
/* * * */
/* ***************************************************************** */
PGM PARM(&FULLFILE &MBR)
/* ***************************************************************** */
/* Declare Program Variables * */
/* ***************************************************************** */
DCL &FULLFILE *CHAR LEN(20)
DCL &MBR *CHAR LEN(10)
DCL &FILE *CHAR LEN(10)
DCL &LIB *CHAR LEN(10)
DCL &rcd *dec LEN(10 0)
DCL &ERRORSW *LGL
DCL &MSGID *CHAR LEN(7)
DCL &MSGDTA *CHAR LEN(100)
DCL &MSGF *CHAR LEN(10)
DCL &MSGFLIB *CHAR LEN(10)
DCL &KEYVAR *CHAR LEN(4)
MONMSG MSGID(CPF0000) EXEC(GOTO STDERR1)
/* ***************************************************************** */
/* Main Processing * */
/* ***************************************************************** */
/* Extract the Library & File Name */
CHGVAR &FILE %SST(&FULLFILE 1 10)
CHGVAR &LIB %SST(&FULLFILE 11 10)
/* Check the Library & File Name exist */
CHKOBJ OBJ(&LIB/&FILE) OBJTYPE(*FILE) MBR(&MBR)
/* Override the file for processing */
OVRDBF FILE(QRPGSRC) TOFILE(&LIB/&FILE) MBR(&MBR)
RTVMBRD FILE(&LIB/&FILE) MBR(&MBR) NBRCURRCD(&RCD)
/* Call the Text insertion program */
CALL GSU903R parm(&rcd)
/* Delete the override */
DLTOVR QRPGSRC
/* End of Program */
RETURN
/* ***************************************************************** */
/* Error Handling * */
/* ***************************************************************** */
STDERR1: /* Standard error handling routine */
IF &ERRORSW SNDPGMMSG MSGID(CPF9999) +
MSGF(QCPFMSG) MSGTYPE(*ESCAPE) /* Func chk */
CHGVAR &ERRORSW '1' /* Set to fail if error occurs */
STDERR2: RCVMSG MSGTYPE(*DIAG) RMV(*NO) KEYVAR(&KEYVAR) +
MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
SNDMSGFLIB(&MSGFLIB)
IF (&KEYVAR *EQ ' ') GOTO STDERR3
RMVMSG MSGKEY(&KEYVAR)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
GOTO STDERR2 /* Loop back for addl diagnostics */
STDERR3: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
ENDPGM
---------------------------------------------
CMD PROMPT('Text Mark RPG Program')
PARM KWD(SRCFILE) TYPE(QUAL1) +
PROMPT('CL source file name')
PARM KWD(MBR) TYPE(*NAME) LEN(10) MIN(1) +
EXPR(*YES) +
PROMPT('Member')
QUAL1: QUAL TYPE(*NAME) LEN(10) EXPR(*YES) DFT(QRPGSRC)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) SPCVAL(*LIBL) +
EXPR(*YES) PROMPT('Library name')
---------------------------------------------
/* ***************************************************************** */
/* * * */
/* * SYSTEM NAME..: GPS Utilitiess * */
/* * * */
/* * PROGRAM......: GSU400C * */
/* * * */
/* * AUTHOR.......: G. P. Skelton * */
/* * * */
/* * DATE.........: March 1995. * */
/* * * */
/* * TITLE........: Report Job Progress (RPTJOBPRG) * */
/* * * */
/* ***************************************************************** */
/* * MODIFICATION CONTROL * */
/* * * */
/* * MOD NO. BY DATE DESCRIPTION * */
/* * * */
/* * * */
/* * * */
/* ***************************************************************** */
PGM PARM(&PERCENT)
/* ***************************************************************** */
/* Declare Error Handling Variables * */
/* ***************************************************************** */
DCL VAR(&MSGID) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(50)
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&RECUR) TYPE(*LGL) LEN(1)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
DCL VAR(&TYP) TYPE(*CHAR) LEN(1)
DCL VAR(&PERCENT) TYPE(*DEC) LEN(3)
DCL VAR(&BLANK) TYPE(*CHAR) LEN(2) VALUE(' ')
DCL VAR(&LENGTH) TYPE(*DEC) LEN(3)
DCL VAR(&NORMAL) TYPE(*CHAR) LEN(2) VALUE(X'20')
DCL VAR(&PERCENT_C) TYPE(*CHAR) LEN(3)
DCL VAR(&REMAIN) TYPE(*DEC) LEN(3)
DCL VAR(&REVERSE) TYPE(*CHAR) LEN(2) VALUE(X'29')
DCL VAR(&BAR) TYPE(*CHAR) LEN(52)
/* Monitor for All Errors */
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
/* ***************************************************************** */
/* Main Processing * */
/* ***************************************************************** */
CHGVAR &PERCENT_C &PERCENT
IF (&PERCENT<0) DO
CHGVAR &PERCENT_C ' 0'
ENDDO
ELSE IF (&PERCENT<10) DO
CHGVAR %SST(&PERCENT_C 1 2) &BLANK
ENDDO
ELSE IF (&PERCENT<100) DO
CHGVAR %SST(&PERCENT_C 1 1) &BLANK
ENDDO
ELSE IF (&PERCENT>100) DO
CHGVAR &PERCENT_C 100
ENDDO
CHGVAR %SST(&BAR 1 1) &REVERSE
CHGVAR &LENGTH (&PERCENT / 2 + 2)
CHGVAR %SST(&BAR &LENGTH 1) &NORMAL
CHGVAR &REMAIN (52-&LENGTH)
IF (&REMAIN>0) DO
CHGVAR &LENGTH (&LENGTH+1)
CHGVAR %SST(&BAR &LENGTH &REMAIN) &BLANK
ENDDO
SNDPGMMSG MSGID(CPF9897) MSGF(QSYS/QCPFMSG) +
MSGDTA(&PERCENT_C *CAT '% complete.' +
*BCAT &BAR) TOPGMQ(*EXT) MSGTYPE(*STATUS)
RETURN
/* ***************************************************************** */
/* Error Handling * */
/* ***************************************************************** */
/* Retrieve the job type (1=Interactive) */
ERROR: RTVJOBA USER(&USER) TYPE(&TYP)
RCVMSG MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
MSGFLIB(&MSGFLIB)
/* Send message(s) according to job type */
IF COND(&TYP *EQ '1') THEN(DO) /* I-active Job */
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA)
ENDDO
ELSE CMD(DO) /* Batch Job */
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) TOMSGQ(*LIBL/&USER)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
ENDDO
ENDPGM
[/tt]
Hope this is useful
Gaz
Why not change the source itself? I wrote a program 10 years ago (Hence for RPG and not RPGLE) that will do just what you need.
Here are some source listings. - My programs change the following:
Full lines of Asterisks ******************
are coloured white
On a line with '* Some Text *'
The *'s are white, text in between is blue
BEGSR and ENDSR are Pink
Underlines for BEGSR and ENDSR are also pink
Source types (F, C etc) are removed for comments.
Four parts are required
RPG Program GSU903R does the work
CLP Program GSU903C is the controller
CMD TX is the command
CLP Program GSU400C displays a 'completed' Bar
LISTINGS
[tt]
---------------------------------------------
H 1 D
*****************************************************************
* *
* SYSTEM NAME..: GPS Utilities *
* *
* PROGRAM......: GSU903R *
* *
* AUTHOR.......: G. P. Skelton *
* *
* DATE.........: August 1994. *
* *
* TITLE........: Put Text Marks into an RPG Source File Member *
* *
*****************************************************************
* MODIFICATION CONTROL *
* ~~~~~~~~~~~~~~~~~~~~ *
* MOD NO. BY DATE DESCRIPTION *
* ~~~~~~~~~ ~~~ ~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ *
* *
*****************************************************************
/EJECT
*****************************************************************
* INDICATORS USED *
* ~~~~~~~~~~~~~~~ *
* *
* 99 - Read Through RPG Source member *
*****************************************************************
/EJECT
*****************************************************************
* FILE SPECIFICATIONS *
*****************************************************************
FQRPGSRC UF E DISK
F QRPGSRC KRENAMEQRPG3SRC
* RPG Source File
*
*****************************************************************
/EJECT
*****************************************************************
* INPUT SPECIFICATIONS *
*****************************************************************
*
* Define Source Data record *
I DS
I 1 80 SRCDTA
I 6 6 SRCTYP
I 7 11 BIGAST
I 7 7 ASTRIX
I 5 5 WHITE
I 70 70 WHITE2
I 8 8 BLUE
I 28 32 OPCDE
I 60 62 ULESR
*****************************************************************
/EJECT
*****************************************************************
* MAIN PROCESSSING LOOP *
*****************************************************************
*
* Entry list - No of records in member for completion display
C *ENTRY PLIST
C PARM RCD 100
*
* Calculate 5% of total records
C RCD DIV 20 PCT5 100
*
* Read through the Source member
B01 C *IN99 DOUEQ'1'
C READ QRPGSRC 99
*
* For each record found...
B02 C *IN99 IFEQ '0'
*
* Add 1 to the total count of records processed
C ADD 1 TOTCNT 100
*
* Add 1 to a smaller count
C ADD 1 CNT 100
*
* If we've done a block of 5%, send a completed so far graphical
* message to the user
B03 C CNT IFEQ PCT5
C TOTCNT DIV RCD DIV 155
C DIV MULT 100 PCT 30
C Z-ADD*ZEROS CNT
C CALL 'GSU400C'
C PARM PCT
E03 C ENDIF
*
* If this line is a comment...
B03 C ASTRIX IFEQ '*'
*
* Make the asterisk white
C MOVELX'22' WHITE
*
* If this isn't an unbroken line of asterisks, make the rest of
* the comment blue
B04 C BLUE IFNE '*'
C MOVELX'3A' BLUE
E04 C ENDIF
*
* If the end of the comment is an asterisk, make that one white
B04 C WHITE2 IFEQ ' '
C MOVELX'22' WHITE2
E04 C ENDIF
*
* If this is an unbroken line of asterisks, make the rest of
* the comment white
B04 C BIGAST IFEQ '**** '
C MOVELX'22' WHITE
E04 C ENDIF
*
* If this is an underline for BEGSR or ENDSR, make the comment
* pink
B04 C OPCDE IFEQ '-----'
C ULESR OREQ '---'
C MOVELX'38' WHITE
C MOVELX'38' BLUE
E04 C ENDIF
*
* As this is a comment, we don't need the source type
C MOVEL' ' SRCTYP
*
* Update the Record
C UPDATQRPG3SRC
*
* If this is NOT a comment line...
X03 C ELSE
*
* If the opcode is BEGSR or ENDSR, make the line pink
B04 C OPCDE IFEQ 'BEGSR'
C OPCDE OREQ 'ENDSR'
C MOVELX'38' WHITE
*
* Update the record
C UPDATQRPG3SRC
*
E04 C ENDIF
*
E03 C ENDIF
*
E02 C ENDIF
*
E01 C ENDDO
*
* End the program
C SETON LRRT
C RETRN
---------------------------------------------
/* ***************************************************************** */
/* * * */
/* * SYSTEM NAME..: GPS Utilitiess * */
/* * * */
/* * PROGRAM......: GSU902C * */
/* * * */
/* * AUTHOR.......: G. P. Skelton * */
/* * * */
/* * DATE.........: August 1994. * */
/* * * */
/* * TITLE........: Text Marks For RPG * */
/* * * */
/* ***************************************************************** */
/* * MODIFICATION CONTROL * */
/* * * */
/* * MOD NO. BY DATE DESCRIPTION * */
/* * * */
/* * * */
/* * * */
/* ***************************************************************** */
PGM PARM(&FULLFILE &MBR)
/* ***************************************************************** */
/* Declare Program Variables * */
/* ***************************************************************** */
DCL &FULLFILE *CHAR LEN(20)
DCL &MBR *CHAR LEN(10)
DCL &FILE *CHAR LEN(10)
DCL &LIB *CHAR LEN(10)
DCL &rcd *dec LEN(10 0)
DCL &ERRORSW *LGL
DCL &MSGID *CHAR LEN(7)
DCL &MSGDTA *CHAR LEN(100)
DCL &MSGF *CHAR LEN(10)
DCL &MSGFLIB *CHAR LEN(10)
DCL &KEYVAR *CHAR LEN(4)
MONMSG MSGID(CPF0000) EXEC(GOTO STDERR1)
/* ***************************************************************** */
/* Main Processing * */
/* ***************************************************************** */
/* Extract the Library & File Name */
CHGVAR &FILE %SST(&FULLFILE 1 10)
CHGVAR &LIB %SST(&FULLFILE 11 10)
/* Check the Library & File Name exist */
CHKOBJ OBJ(&LIB/&FILE) OBJTYPE(*FILE) MBR(&MBR)
/* Override the file for processing */
OVRDBF FILE(QRPGSRC) TOFILE(&LIB/&FILE) MBR(&MBR)
RTVMBRD FILE(&LIB/&FILE) MBR(&MBR) NBRCURRCD(&RCD)
/* Call the Text insertion program */
CALL GSU903R parm(&rcd)
/* Delete the override */
DLTOVR QRPGSRC
/* End of Program */
RETURN
/* ***************************************************************** */
/* Error Handling * */
/* ***************************************************************** */
STDERR1: /* Standard error handling routine */
IF &ERRORSW SNDPGMMSG MSGID(CPF9999) +
MSGF(QCPFMSG) MSGTYPE(*ESCAPE) /* Func chk */
CHGVAR &ERRORSW '1' /* Set to fail if error occurs */
STDERR2: RCVMSG MSGTYPE(*DIAG) RMV(*NO) KEYVAR(&KEYVAR) +
MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
SNDMSGFLIB(&MSGFLIB)
IF (&KEYVAR *EQ ' ') GOTO STDERR3
RMVMSG MSGKEY(&KEYVAR)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
GOTO STDERR2 /* Loop back for addl diagnostics */
STDERR3: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
ENDPGM
---------------------------------------------
CMD PROMPT('Text Mark RPG Program')
PARM KWD(SRCFILE) TYPE(QUAL1) +
PROMPT('CL source file name')
PARM KWD(MBR) TYPE(*NAME) LEN(10) MIN(1) +
EXPR(*YES) +
PROMPT('Member')
QUAL1: QUAL TYPE(*NAME) LEN(10) EXPR(*YES) DFT(QRPGSRC)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) SPCVAL(*LIBL) +
EXPR(*YES) PROMPT('Library name')
---------------------------------------------
/* ***************************************************************** */
/* * * */
/* * SYSTEM NAME..: GPS Utilitiess * */
/* * * */
/* * PROGRAM......: GSU400C * */
/* * * */
/* * AUTHOR.......: G. P. Skelton * */
/* * * */
/* * DATE.........: March 1995. * */
/* * * */
/* * TITLE........: Report Job Progress (RPTJOBPRG) * */
/* * * */
/* ***************************************************************** */
/* * MODIFICATION CONTROL * */
/* * * */
/* * MOD NO. BY DATE DESCRIPTION * */
/* * * */
/* * * */
/* * * */
/* ***************************************************************** */
PGM PARM(&PERCENT)
/* ***************************************************************** */
/* Declare Error Handling Variables * */
/* ***************************************************************** */
DCL VAR(&MSGID) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(50)
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&RECUR) TYPE(*LGL) LEN(1)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
DCL VAR(&TYP) TYPE(*CHAR) LEN(1)
DCL VAR(&PERCENT) TYPE(*DEC) LEN(3)
DCL VAR(&BLANK) TYPE(*CHAR) LEN(2) VALUE(' ')
DCL VAR(&LENGTH) TYPE(*DEC) LEN(3)
DCL VAR(&NORMAL) TYPE(*CHAR) LEN(2) VALUE(X'20')
DCL VAR(&PERCENT_C) TYPE(*CHAR) LEN(3)
DCL VAR(&REMAIN) TYPE(*DEC) LEN(3)
DCL VAR(&REVERSE) TYPE(*CHAR) LEN(2) VALUE(X'29')
DCL VAR(&BAR) TYPE(*CHAR) LEN(52)
/* Monitor for All Errors */
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
/* ***************************************************************** */
/* Main Processing * */
/* ***************************************************************** */
CHGVAR &PERCENT_C &PERCENT
IF (&PERCENT<0) DO
CHGVAR &PERCENT_C ' 0'
ENDDO
ELSE IF (&PERCENT<10) DO
CHGVAR %SST(&PERCENT_C 1 2) &BLANK
ENDDO
ELSE IF (&PERCENT<100) DO
CHGVAR %SST(&PERCENT_C 1 1) &BLANK
ENDDO
ELSE IF (&PERCENT>100) DO
CHGVAR &PERCENT_C 100
ENDDO
CHGVAR %SST(&BAR 1 1) &REVERSE
CHGVAR &LENGTH (&PERCENT / 2 + 2)
CHGVAR %SST(&BAR &LENGTH 1) &NORMAL
CHGVAR &REMAIN (52-&LENGTH)
IF (&REMAIN>0) DO
CHGVAR &LENGTH (&LENGTH+1)
CHGVAR %SST(&BAR &LENGTH &REMAIN) &BLANK
ENDDO
SNDPGMMSG MSGID(CPF9897) MSGF(QSYS/QCPFMSG) +
MSGDTA(&PERCENT_C *CAT '% complete.' +
*BCAT &BAR) TOPGMQ(*EXT) MSGTYPE(*STATUS)
RETURN
/* ***************************************************************** */
/* Error Handling * */
/* ***************************************************************** */
/* Retrieve the job type (1=Interactive) */
ERROR: RTVJOBA USER(&USER) TYPE(&TYP)
RCVMSG MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
MSGFLIB(&MSGFLIB)
/* Send message(s) according to job type */
IF COND(&TYP *EQ '1') THEN(DO) /* I-active Job */
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA)
ENDDO
ELSE CMD(DO) /* Batch Job */
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) TOMSGQ(*LIBL/&USER)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
ENDDO
ENDPGM
[/tt]
Hope this is useful
Gaz
PART TWO!
GSU400C Repeated!
[tt]
/* ***************************************************************** */
/* * * */
/* * SYSTEM NAME..: GPS Utilitiess * */
/* * * */
/* * PROGRAM......: GSU400C * */
/* * * */
/* * AUTHOR.......: G. P. Skelton * */
/* * * */
/* * DATE.........: March 1995. * */
/* * * */
/* * TITLE........: Report Job Progress (RPTJOBPRG) * */
/* * * */
/* ***************************************************************** */
/* * MODIFICATION CONTROL * */
/* * * */
/* * MOD NO. BY DATE DESCRIPTION * */
/* * * */
/* * * */
/* * * */
/* ***************************************************************** */
PGM PARM(&PERCENT)
/* ***************************************************************** */
/* Declare Error Handling Variables * */
/* ***************************************************************** */
DCL VAR(&MSGID) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(50)
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&RECUR) TYPE(*LGL) LEN(1)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
DCL VAR(&TYP) TYPE(*CHAR) LEN(1)
DCL VAR(&PERCENT) TYPE(*DEC) LEN(3)
DCL VAR(&BLANK) TYPE(*CHAR) LEN(2) VALUE(' ')
DCL VAR(&LENGTH) TYPE(*DEC) LEN(3)
DCL VAR(&NORMAL) TYPE(*CHAR) LEN(2) VALUE(X'20')
DCL VAR(&PERCENT_C) TYPE(*CHAR) LEN(3)
DCL VAR(&REMAIN) TYPE(*DEC) LEN(3)
DCL VAR(&REVERSE) TYPE(*CHAR) LEN(2) VALUE(X'29')
DCL VAR(&BAR) TYPE(*CHAR) LEN(52)
/* Monitor for All Errors */
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
/* ***************************************************************** */
/* Main Processing * */
/* ***************************************************************** */
CHGVAR &PERCENT_C &PERCENT
IF (&PERCENT<0) DO
CHGVAR &PERCENT_C ' 0'
ENDDO
ELSE IF (&PERCENT<10) DO
CHGVAR %SST(&PERCENT_C 1 2) &BLANK
ENDDO
ELSE IF (&PERCENT<100) DO
CHGVAR %SST(&PERCENT_C 1 1) &BLANK
ENDDO
ELSE IF (&PERCENT>100) DO
CHGVAR &PERCENT_C 100
ENDDO
CHGVAR %SST(&BAR 1 1) &REVERSE
CHGVAR &LENGTH (&PERCENT / 2 + 2)
CHGVAR %SST(&BAR &LENGTH 1) &NORMAL
CHGVAR &REMAIN (52-&LENGTH)
IF (&REMAIN>0) DO
CHGVAR &LENGTH (&LENGTH+1)
CHGVAR %SST(&BAR &LENGTH &REMAIN) &BLANK
ENDDO
SNDPGMMSG MSGID(CPF9897) MSGF(QSYS/QCPFMSG) +
MSGDTA(&PERCENT_C *CAT '% complete.' +
*BCAT &BAR) TOPGMQ(*EXT) MSGTYPE(*STATUS)
RETURN
/* ***************************************************************** */
/* Error Handling * */
/* ***************************************************************** */
/* Retrieve the job type (1=Interactive) */
ERROR: RTVJOBA USER(&USER) TYPE(&TYP)
RCVMSG MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
MSGFLIB(&MSGFLIB)
/* Send message(s) according to job type */
IF COND(&TYP *EQ '1') THEN(DO) /* I-active Job */
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA)
ENDDO
ELSE CMD(DO) /* Batch Job */
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) TOMSGQ(*LIBL/&USER)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
ENDDO
ENDPGM
[/tt]
GSU400C Repeated!
[tt]
/* ***************************************************************** */
/* * * */
/* * SYSTEM NAME..: GPS Utilitiess * */
/* * * */
/* * PROGRAM......: GSU400C * */
/* * * */
/* * AUTHOR.......: G. P. Skelton * */
/* * * */
/* * DATE.........: March 1995. * */
/* * * */
/* * TITLE........: Report Job Progress (RPTJOBPRG) * */
/* * * */
/* ***************************************************************** */
/* * MODIFICATION CONTROL * */
/* * * */
/* * MOD NO. BY DATE DESCRIPTION * */
/* * * */
/* * * */
/* * * */
/* ***************************************************************** */
PGM PARM(&PERCENT)
/* ***************************************************************** */
/* Declare Error Handling Variables * */
/* ***************************************************************** */
DCL VAR(&MSGID) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(50)
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&RECUR) TYPE(*LGL) LEN(1)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
DCL VAR(&TYP) TYPE(*CHAR) LEN(1)
DCL VAR(&PERCENT) TYPE(*DEC) LEN(3)
DCL VAR(&BLANK) TYPE(*CHAR) LEN(2) VALUE(' ')
DCL VAR(&LENGTH) TYPE(*DEC) LEN(3)
DCL VAR(&NORMAL) TYPE(*CHAR) LEN(2) VALUE(X'20')
DCL VAR(&PERCENT_C) TYPE(*CHAR) LEN(3)
DCL VAR(&REMAIN) TYPE(*DEC) LEN(3)
DCL VAR(&REVERSE) TYPE(*CHAR) LEN(2) VALUE(X'29')
DCL VAR(&BAR) TYPE(*CHAR) LEN(52)
/* Monitor for All Errors */
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
/* ***************************************************************** */
/* Main Processing * */
/* ***************************************************************** */
CHGVAR &PERCENT_C &PERCENT
IF (&PERCENT<0) DO
CHGVAR &PERCENT_C ' 0'
ENDDO
ELSE IF (&PERCENT<10) DO
CHGVAR %SST(&PERCENT_C 1 2) &BLANK
ENDDO
ELSE IF (&PERCENT<100) DO
CHGVAR %SST(&PERCENT_C 1 1) &BLANK
ENDDO
ELSE IF (&PERCENT>100) DO
CHGVAR &PERCENT_C 100
ENDDO
CHGVAR %SST(&BAR 1 1) &REVERSE
CHGVAR &LENGTH (&PERCENT / 2 + 2)
CHGVAR %SST(&BAR &LENGTH 1) &NORMAL
CHGVAR &REMAIN (52-&LENGTH)
IF (&REMAIN>0) DO
CHGVAR &LENGTH (&LENGTH+1)
CHGVAR %SST(&BAR &LENGTH &REMAIN) &BLANK
ENDDO
SNDPGMMSG MSGID(CPF9897) MSGF(QSYS/QCPFMSG) +
MSGDTA(&PERCENT_C *CAT '% complete.' +
*BCAT &BAR) TOPGMQ(*EXT) MSGTYPE(*STATUS)
RETURN
/* ***************************************************************** */
/* Error Handling * */
/* ***************************************************************** */
/* Retrieve the job type (1=Interactive) */
ERROR: RTVJOBA USER(&USER) TYPE(&TYP)
RCVMSG MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
MSGFLIB(&MSGFLIB)
/* Send message(s) according to job type */
IF COND(&TYP *EQ '1') THEN(DO) /* I-active Job */
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA)
ENDDO
ELSE CMD(DO) /* Batch Job */
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) TOMSGQ(*LIBL/&USER)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
ENDDO
ENDPGM
[/tt]
iSeriesCodePoet
Programmer
That is how I do my coloring now.
iSeriesCodePoet
iSeries Programmer/Lawson Software Administrator
See my progress to converting to linux.
iSeriesCodePoet
iSeries Programmer/Lawson Software Administrator
See my progress to converting to linux.
Hi Y'all
That's great, but not an option for many programmers. Once changed using my method, the source files will be colour coded on ANY system (As long as you have a colour session![[thumbsup]](/data/assets/smilies/thumbsup.gif "[thumbsup] [thumbsup]")
. So you can port your code and still have that look available. I now use the colours as a visual aid to read through my source and know that it will look the same wherever!
Give the program a try - I'm confident you won't look back
![[bigglasses]](/data/assets/smilies/bigglasses.gif "[bigglasses] [bigglasses]")
![[peace]](/data/assets/smilies/peace.gif "[peace] [peace]")
Gaz
That's great, but not an option for many programmers. Once changed using my method, the source files will be colour coded on ANY system (As long as you have a colour session
. So you can port your code and still have that look available. I now use the colours as a visual aid to read through my source and know that it will look the same wherever!Give the program a try - I'm confident you won't look back
Gaz
- Status
Similar threads
- Locked
- Question